quic 0.1.8 → 0.1.9

raw patch · 97 files changed

+5505/−4531 lines, 97 filesdep +network-controldep −psqueuessetup-changed

Dependencies added: network-control

Dependencies removed: psqueues

Files

• ChangeLog.md +6/−0
• Network/QUIC.hs +69/−41
• Network/QUIC/Client.hs +27/−24
• Network/QUIC/Client/Reader.hs +38/−43
• Network/QUIC/Client/Run.hs +59/−40
• Network/QUIC/Common.hs +2/−2
• Network/QUIC/Config.hs +119/−93
• Network/QUIC/Connection.hs +12/−12
• Network/QUIC/Connection/Crypto.hs +142/−115
• Network/QUIC/Connection/Migration.hs +97/−86
• Network/QUIC/Connection/Misc.hs +41/−40
• Network/QUIC/Connection/PacketNumber.hs +4/−4
• Network/QUIC/Connection/Role.hs +60/−52
• Network/QUIC/Connection/State.hs +41/−73
• Network/QUIC/Connection/Stream.hs +43/−36
• Network/QUIC/Connection/StreamTable.hs +35/−32
• Network/QUIC/Connection/Timeout.hs +6/−6
• Network/QUIC/Connection/Types.hs +251/−212
• Network/QUIC/Connector.hs +29/−27
• Network/QUIC/Crypto.hs +6/−6
• Network/QUIC/Crypto/Fusion.hs +11/−11
• Network/QUIC/Crypto/Keys.hs +39/−36
• Network/QUIC/Crypto/Nite.hs +129/−100
• Network/QUIC/Crypto/Types.hs +26/−26
• Network/QUIC/Crypto/Utils.hs +25/−22
• Network/QUIC/Event.hs +9/−8
• Network/QUIC/Exception.hs +8/−8
• Network/QUIC/IO.hs +71/−69
• Network/QUIC/Info.hs +61/−42
• Network/QUIC/Internal.hs +17/−17
• Network/QUIC/Logger.hs +8/−8
• Network/QUIC/Packet.hs +39/−35
• Network/QUIC/Packet/Decode.hs +44/−43
• Network/QUIC/Packet/Decrypt.hs +41/−37
• Network/QUIC/Packet/Encode.hs +115/−47
• Network/QUIC/Packet/Frame.hs +109/−104
• Network/QUIC/Packet/Header.hs +42/−26
• Network/QUIC/Packet/Number.hs +7/−3
• Network/QUIC/Packet/Token.hs +27/−27
• Network/QUIC/Parameters.hs +194/−169
• Network/QUIC/QLogger.hs +5/−4
• Network/QUIC/Qlog.hs +198/−105
• Network/QUIC/Receiver.hs +212/−178
• Network/QUIC/Recovery.hs +47/−47
• Network/QUIC/Recovery/Constants.hs +1/−2
• Network/QUIC/Recovery/Detect.hs +39/−29
• Network/QUIC/Recovery/Interface.hs +6/−6
• Network/QUIC/Recovery/LossRecovery.hs +106/−89
• Network/QUIC/Recovery/Metrics.hs +66/−52
• Network/QUIC/Recovery/Misc.hs +9/−9
• Network/QUIC/Recovery/PeerPacketNumbers.hs +10/−10
• Network/QUIC/Recovery/Persistent.hs +36/−38
• Network/QUIC/Recovery/Release.hs +30/−26
• Network/QUIC/Recovery/Timer.hs +114/−111
• Network/QUIC/Recovery/Types.hs +261/−215
• Network/QUIC/Recovery/Utils.hs +25/−24
• Network/QUIC/Sender.hs +222/−198
• Network/QUIC/Server.hs +23/−21
• Network/QUIC/Server/Reader.hs +9/−13
• Network/QUIC/Stream.hs +42/−46
• Network/QUIC/Stream/Frag.hs +22/−14
• Network/QUIC/Stream/Misc.hs +32/−40
• Network/QUIC/Stream/Reass.hs +107/−97
• Network/QUIC/Stream/Skew.hs +27/−25
• Network/QUIC/Stream/Table.hs +26/−25
• Network/QUIC/Stream/Types.hs +56/−66
• Network/QUIC/TLS.hs +86/−73
• Network/QUIC/Types.hs +16/−16
• Network/QUIC/Types/Ack.hs +28/−29
• Network/QUIC/Types/CID.hs +21/−20
• Network/QUIC/Types/Error.hs +4/−1
• Network/QUIC/Types/Exception.hs +28/−26
• Network/QUIC/Types/Frame.hs +33/−25
• Network/QUIC/Types/Integer.hs +22/−21
• Network/QUIC/Types/Packet.hs +79/−60
• Network/QUIC/Types/Resumption.hs +18/−16
• Network/QUIC/Types/Time.hs +17/−17
• Network/QUIC/Utils.hs +3/−3
• Network/QUIC/Windows.hs +4/−4
• Setup.hs +1/−0
• quic.cabal +2/−2
• test/Config.hs +116/−103
• test/ErrorSpec.hs +7/−4
• test/FrameSpec.hs +1/−1
• test/HandshakeSpec.hs +57/−34
• test/IOSpec.hs +11/−6
• test/PacketSpec.hs +137/−103
• test/RecoverySpec.hs +87/−32
• test/TLSSpec.hs +78/−61
• test/TransportError.hs +276/−179
• test/TypesSpec.hs +3/−1
• util/ClientX.hs +24/−22
• util/Common.hs +19/−19
• util/H3.hs +21/−17
• util/ServerX.hs +32/−30
• util/client.hs +349/−267
• util/server.hs +85/−67

@@ -1,3 +1,9 @@+## 0.1.9++- Using the network-control package.+- Rate control for some frames.+- Announcing MaxStreams correctly.+ ## 0.1.8  - Announcing MaxStreams properly.

@@ -4,47 +4,75 @@ -- -- The -threaded option must be specified to GHC to use this library. module Network.QUIC (-  -- * Connection-    Connection-  , abortConnection-  -- * Stream-  , Stream-  , StreamId-  , streamId-  -- ** Category-  , isClientInitiatedBidirectional-  , isServerInitiatedBidirectional-  , isClientInitiatedUnidirectional-  , isServerInitiatedUnidirectional-  -- ** Opening-  , stream-  , unidirectionalStream-  , acceptStream-  -- ** Closing-  , closeStream-  , shutdownStream-  , resetStream-  , stopStream-  -- * IO-  , recvStream-  , sendStream-  , sendStreamMany-  -- * Information-  , ConnectionInfo(..)-  , getConnectionInfo-  -- * Statistics-  , ConnectionStats(..)-  , getConnectionStats-  -- * Synchronization-  , wait0RTTReady-  , wait1RTTReady-  , waitEstablished-  -- * Exceptions and Errors-  , QUICException(..)-  , TransportError(.., NoError, InternalError, ConnectionRefused, FlowControlError, StreamLimitError, StreamStateError, FinalSizeError, FrameEncodingError, TransportParameterError, ConnectionIdLimitError, ProtocolViolation, InvalidToken, ApplicationError, CryptoBufferExceeded, KeyUpdateError, AeadLimitReached, NoViablePath)-  , cryptoError-  , ApplicationProtocolError(..)-  ) where+    -- * Connection+    Connection,+    abortConnection,++    -- * Stream+    Stream,+    StreamId,+    streamId,++    -- ** Category+    isClientInitiatedBidirectional,+    isServerInitiatedBidirectional,+    isClientInitiatedUnidirectional,+    isServerInitiatedUnidirectional,++    -- ** Opening+    stream,+    unidirectionalStream,+    acceptStream,++    -- ** Closing+    closeStream,+    shutdownStream,+    resetStream,+    stopStream,++    -- * IO+    recvStream,+    sendStream,+    sendStreamMany,++    -- * Information+    ConnectionInfo (..),+    getConnectionInfo,++    -- * Statistics+    ConnectionStats (..),+    getConnectionStats,++    -- * Synchronization+    wait0RTTReady,+    wait1RTTReady,+    waitEstablished,++    -- * Exceptions and Errors+    QUICException (..),+    TransportError (+        ..,+        NoError,+        InternalError,+        ConnectionRefused,+        FlowControlError,+        StreamLimitError,+        StreamStateError,+        FinalSizeError,+        FrameEncodingError,+        TransportParameterError,+        ConnectionIdLimitError,+        ProtocolViolation,+        InvalidToken,+        ApplicationError,+        CryptoBufferExceeded,+        KeyUpdateError,+        AeadLimitReached,+        NoViablePath+    ),+    cryptoError,+    ApplicationProtocolError (..),+) where  import Network.QUIC.Connection import Network.QUIC.IO

@@ -2,30 +2,33 @@ --   When a new better network interface is up, --   migration is done automatically. module Network.QUIC.Client (-  -- * Running a QUIC client-    run-  -- * Configration-  , ClientConfig-  , defaultClientConfig-  , ccServerName-  , ccPortName-  , ccALPN-  , ccUse0RTT-  , ccResumption-  , ccCiphers-  , ccGroups-  , ccVersions---  , ccCredentials-  , ccValidate-  , ccAutoMigration-  -- * Resumption-  , ResumptionInfo-  , getResumptionInfo-  , isResumptionPossible-  , is0RTTPossible-  -- * Migration-  , migrate-  ) where+    -- * Running a QUIC client+    run,++    -- * Configration+    ClientConfig,+    defaultClientConfig,+    ccServerName,+    ccPortName,+    ccALPN,+    ccUse0RTT,+    ccResumption,+    ccCiphers,+    ccGroups,+    ccVersions,+    --  , ccCredentials+    ccValidate,+    ccAutoMigration,++    -- * Resumption+    ResumptionInfo,+    getResumptionInfo,+    isResumptionPossible,+    is0RTTPossible,++    -- * Migration+    migrate,+) where  import Network.QUIC.Client.Run import Network.QUIC.Config

@@ -1,13 +1,12 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}  module Network.QUIC.Client.Reader (-    readerClient-  , recvClient-  , ConnectionControl(..)-  , controlConnection-  ) where+    readerClient,+    recvClient,+    ConnectionControl (..),+    controlConnection,+) where  import Data.List (intersect) import Network.Socket (getSocketName)@@ -25,9 +24,6 @@ import Network.QUIC.Qlog import Network.QUIC.Recovery import Network.QUIC.Types-#if defined(mingw32_HOST_OS)-import Network.QUIC.Windows-#endif  -- | readerClient dies when the socket is closed. readerClient :: UDPSocket -> Connection -> IO ()@@ -44,32 +40,30 @@             wait     loop = do         ito <- readMinIdleTimeout conn-        mbs <- timeout ito "readeClient" $-#if defined(mingw32_HOST_OS)-          windowsThreadBlockHack $-#endif-            recv cs0+        mbs <-+            timeout ito "readeClient" $+                recv cs0         case mbs of-          Nothing -> close cs0-          Just bs -> do-            now <- getTimeMicrosecond-            pkts <- decodePackets bs-            mapM_ (putQ now) pkts-            loop+            Nothing -> close cs0+            Just bs -> do+                now <- getTimeMicrosecond+                pkts <- decodePackets bs+                mapM_ (putQ now) pkts+                loop     logAction msg = connDebugLog conn ("debug: readerClient: " <> msg)     putQ _ (PacketIB BrokenPacket) = return ()     putQ t (PacketIV pkt@(VersionNegotiationPacket dCID sCID peerVers)) = do         qlogReceived conn pkt t         myVerInfo <- getVersionInfo conn-        let myVer   = chosenVersion myVerInfo+        let myVer = chosenVersion myVerInfo             myVers0 = otherVersions myVerInfo         -- ignoring VN if the original version is included.         when (myVer `notElem` peerVers && Negotiation `notElem` peerVers) $ do             ok <- checkCIDs conn dCID (Left sCID)             let myVers = filter (not . isGreasingVersion) myVers0                 nextVerInfo = case myVers `intersect` peerVers of-                  vers@(ver:_) | ok -> VersionInfo ver vers-                  _                 -> brokenVersionInfo+                    vers@(ver : _) | ok -> VersionInfo ver vers+                    _ -> brokenVersionInfo             E.throwTo (mainThreadId conn) $ VerNego nextVerInfo     putQ t (PacketIC pkt lvl siz) = writeRecvQ (connRecvQ conn) $ mkReceivedPacket pkt t siz lvl     putQ t (PacketIR pkt@(RetryPacket ver dCID sCID token ex)) = do@@ -77,7 +71,7 @@         ok <- checkCIDs conn dCID ex         when ok $ do             resetPeerCID conn sCID-            setPeerAuthCIDs conn $ \auth -> auth { retrySrcCID  = Just sCID }+            setPeerAuthCIDs conn $ \auth -> auth{retrySrcCID = Just sCID}             initializeCoder conn InitialLevel $ initialSecrets ver sCID             setToken conn token             setRetried conn True@@ -85,12 +79,12 @@       where         put ppkt = putOutput conn $ OutRetrans ppkt -checkCIDs :: Connection -> CID -> Either CID (ByteString,ByteString) -> IO Bool+checkCIDs :: Connection -> CID -> Either CID (ByteString, ByteString) -> IO Bool checkCIDs conn dCID (Left sCID) = do     localCID <- getMyCID conn     remoteCID <- getPeerCID conn     return (dCID == localCID && sCID == remoteCID)-checkCIDs conn dCID (Right (pseudo0,tag)) = do+checkCIDs conn dCID (Right (pseudo0, tag)) = do     localCID <- getMyCID conn     remoteCID <- getPeerCID conn     ver <- getVersion conn@@ -103,30 +97,31 @@ ----------------------------------------------------------------  -- | How to control a connection.-data ConnectionControl = ChangeServerCID-                       | ChangeClientCID-                       | NATRebinding-                       | ActiveMigration-                       deriving (Eq, Show)+data ConnectionControl+    = ChangeServerCID+    | ChangeClientCID+    | NATRebinding+    | ActiveMigration+    deriving (Eq, Show)  controlConnection :: Connection -> ConnectionControl -> IO Bool controlConnection conn typ-  | isClient conn = do+    | isClient conn = do         waitEstablished conn         controlConnection' conn typ-  | otherwise     = return False+    | otherwise = return False  controlConnection' :: Connection -> ConnectionControl -> IO Bool controlConnection' conn ChangeServerCID = do     mn <- timeout (Microseconds 1000000) "controlConnection' 1" $ waitPeerCID conn -- fixme     case mn of-      Nothing              -> return False-      Just (CIDInfo n _ _) -> do-          sendFrames conn RTT1Level [RetireConnectionID n]-          return True+        Nothing -> return False+        Just (CIDInfo n _ _) -> do+            sendFrames conn RTT1Level [RetireConnectionID n]+            return True controlConnection' conn ChangeClientCID = do     cidInfo <- getNewMyCID conn-    x <- (+1) <$> getMyCIDSeqNum conn+    x <- (+ 1) <$> getMyCIDSeqNum conn     sendFrames conn RTT1Level [NewConnectionID cidInfo x]     return True controlConnection' conn NATRebinding = do@@ -135,11 +130,11 @@ controlConnection' conn ActiveMigration = do     mn <- timeout (Microseconds 1000000) "controlConnection' 2" $ waitPeerCID conn -- fixme     case mn of-      Nothing  -> return False-      mcidinfo -> do-          rebind conn $ Microseconds 5000000-          validatePath conn mcidinfo-          return True+        Nothing -> return False+        mcidinfo -> do+            rebind conn $ Microseconds 5000000+            validatePath conn mcidinfo+            return True  rebind :: Connection -> Microseconds -> IO () rebind conn microseconds = do

@@ -3,12 +3,12 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Network.QUIC.Client.Run (-    run-  , migrate-  ) where+    run,+    migrate,+) where  import qualified Network.Socket as NS-import Network.UDP (UDPSocket(..))+import Network.UDP (UDPSocket (..)) import qualified Network.UDP as UDP import UnliftIO.Async import UnliftIO.Concurrent@@ -41,50 +41,55 @@ run :: ClientConfig -> (Connection -> IO a) -> IO a -- Don't use handleLogUnit here because of a return value. run conf client = NS.withSocketsDo $ do-  let resInfo = ccResumption conf-      verInfo = case resumptionSession resInfo of-        Nothing | resumptionToken resInfo == emptyToken ->-                  let vers = ccVersions conf-                      ver = head vers-                  in VersionInfo ver vers-        _  -> let ver = resumptionVersion resInfo in VersionInfo ver [ver]-  ex <- E.try $ runClient conf client False verInfo-  case ex of-    Right v                     -> return v-    Left (NextVersion nextVerInfo)-      | verInfo == brokenVersionInfo -> E.throwIO VersionNegotiationFailed-      | otherwise                    -> runClient conf client True nextVerInfo+    let resInfo = ccResumption conf+        verInfo = case resumptionSession resInfo of+            Nothing+                | resumptionToken resInfo == emptyToken ->+                    let vers = ccVersions conf+                        ver = head vers+                     in VersionInfo ver vers+            _ -> let ver = resumptionVersion resInfo in VersionInfo ver [ver]+    ex <- E.try $ runClient conf client False verInfo+    case ex of+        Right v -> return v+        Left (NextVersion nextVerInfo)+            | verInfo == brokenVersionInfo -> E.throwIO VersionNegotiationFailed+            | otherwise -> runClient conf client True nextVerInfo  runClient :: ClientConfig -> (Connection -> IO a) -> Bool -> VersionInfo -> IO a runClient conf client0 isICVN verInfo = do     E.bracket open clse $ \(ConnRes conn myAuthCIDs reader) -> do         forkIO reader >>= addReader conn-        let conf' = conf {-                ccParameters = (ccParameters conf) {-                      versionInformation = Just verInfo+        let conf' =+                conf+                    { ccParameters =+                        (ccParameters conf)+                            { versionInformation = Just verInfo+                            }                     }-              }         setIncompatibleVN conn isICVN -- must be before handshaker         setToken conn $ resumptionToken $ ccResumption conf         handshaker <- handshakeClient conf' conn myAuthCIDs         let client = do-                if ccUse0RTT conf then-                    wait0RTTReady conn-                  else-                    wait1RTTReady conn+                if ccUse0RTT conf+                    then wait0RTTReady conn+                    else wait1RTTReady conn                 client0 conn             ldcc = connLDCC conn-            supporters = foldr1 concurrently_ [handshaker-                                              ,sender   conn-                                              ,receiver conn-                                              ,resender  ldcc-                                              ,ldccTimer ldcc-                                              ]+            supporters =+                foldr1+                    concurrently_+                    [ handshaker+                    , sender conn+                    , receiver conn+                    , resender ldcc+                    , ldccTimer ldcc+                    ]             runThreads = do                 er <- race supporters client                 case er of-                  Left () -> E.throwIO MustNotReached-                  Right r -> return r+                    Left () -> E.throwIO MustNotReached+                    Right r -> return r         ex <- E.trySyncOrAsync runThreads         sendFinal conn         closure conn ldcc ex@@ -98,23 +103,37 @@  createClientConnection :: ClientConfig -> VersionInfo -> IO ConnRes createClientConnection conf@ClientConfig{..} verInfo = do-    us@(UDPSocket _ sa _) <- UDP.clientSocket ccServerName ccPortName (not ccAutoMigration)+    us@(UDPSocket _ sa _) <-+        UDP.clientSocket ccServerName ccPortName (not ccAutoMigration)     q <- newRecvQ     sref <- newIORef us     let send = \buf siz -> do             cs <- readIORef sref             UDP.sendBuf cs buf siz         recv = recvClient q-    myCID   <- newCID+    myCID <- newCID     peerCID <- newCID     now <- getTimeMicrosecond     (qLog, qclean) <- dirQLogger ccQLog now peerCID "client"-    let debugLog msg | ccDebugLog = stdoutLogger msg-                     | otherwise  = return ()+    let debugLog msg+            | ccDebugLog = stdoutLogger msg+            | otherwise = return ()     debugLog $ "Original CID: " <> bhow peerCID-    let myAuthCIDs   = defaultAuthCIDs { initSrcCID = Just myCID }-        peerAuthCIDs = defaultAuthCIDs { initSrcCID = Just peerCID, origDstCID = Just peerCID }-    conn <- clientConnection conf verInfo myAuthCIDs peerAuthCIDs debugLog qLog ccHooks sref q send recv+    let myAuthCIDs = defaultAuthCIDs{initSrcCID = Just myCID}+        peerAuthCIDs = defaultAuthCIDs{initSrcCID = Just peerCID, origDstCID = Just peerCID}+    conn <-+        clientConnection+            conf+            verInfo+            myAuthCIDs+            peerAuthCIDs+            debugLog+            qLog+            ccHooks+            sref+            q+            send+            recv     addResource conn qclean     let ver = chosenVersion verInfo     initializeCoder conn InitialLevel $ initialSecrets ver peerCID

@@ -17,8 +17,8 @@  defaultPacketSize :: NS.SockAddr -> Int defaultPacketSize NS.SockAddrInet6{} = defaultQUICPacketSizeForIPv6-defaultPacketSize _                  = defaultQUICPacketSizeForIPv4+defaultPacketSize _ = defaultQUICPacketSizeForIPv4  maximumPacketSize :: NS.SockAddr -> Int maximumPacketSize NS.SockAddrInet6{} = 1500 - 40 - 8 -- fixme-maximumPacketSize _                  = 1500 - 20 - 8 -- fixme+maximumPacketSize _ = 1500 - 20 - 8 -- fixme

@@ -5,7 +5,7 @@  import Data.IP import Network.Socket-import Network.TLS hiding (Version, HostName, Hooks)+import Network.TLS hiding (Hooks, HostName, Version) import Network.TLS.QUIC  import Network.QUIC.Imports@@ -16,112 +16,138 @@ ----------------------------------------------------------------  -- | Hooks.-data Hooks = Hooks {-    onCloseCompleted :: IO ()-  , onPlainCreated  :: EncryptionLevel -> Plain -> Plain-  , onTransportParametersCreated :: Parameters -> Parameters-  , onTLSExtensionCreated :: [ExtensionRaw] -> [ExtensionRaw]-  , onTLSHandshakeCreated :: [(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)-  , onResetStreamReceived :: Stream -> ApplicationProtocolError -> IO ()-  , onServerReady :: IO ()-  }+data Hooks = Hooks+    { onCloseCompleted :: IO ()+    , onPlainCreated :: EncryptionLevel -> Plain -> Plain+    , onTransportParametersCreated :: Parameters -> Parameters+    , onTLSExtensionCreated :: [ExtensionRaw] -> [ExtensionRaw]+    , onTLSHandshakeCreated+        :: [(EncryptionLevel, CryptoData)]+        -> ([(EncryptionLevel, CryptoData)], Bool)+    , onResetStreamReceived :: Stream -> ApplicationProtocolError -> IO ()+    , onServerReady :: IO ()+    }  -- | Default hooks. defaultHooks :: Hooks-defaultHooks = Hooks {-    onCloseCompleted = return ()-  , onPlainCreated  = \_l p -> p-  , onTransportParametersCreated = id-  , onTLSExtensionCreated = id-  , onTLSHandshakeCreated = (, False)-  , onResetStreamReceived = \_ _ -> return ()-  , onServerReady = return ()-  }+defaultHooks =+    Hooks+        { onCloseCompleted = return ()+        , onPlainCreated = \_l p -> p+        , onTransportParametersCreated = id+        , onTLSExtensionCreated = id+        , onTLSHandshakeCreated = (,False)+        , onResetStreamReceived = \_ _ -> return ()+        , onServerReady = return ()+        }  ----------------------------------------------------------------  -- | Client configuration.-data ClientConfig = ClientConfig {-    ccVersions      :: [Version] -- ^ Compatible versions in the preferred order.-  , ccCiphers       :: [Cipher] -- ^ Cipher candidates defined in TLS 1.3.-  , ccGroups        :: [Group] -- ^ Key exchange group candidates defined in TLS 1.3.-  , ccParameters    :: Parameters-  , ccKeyLog        :: String -> IO ()-  , ccQLog          :: Maybe FilePath-  , ccCredentials   :: Credentials -- ^ TLS credentials.-  , ccHooks         :: Hooks-  , ccUse0RTT       :: Bool -- ^ Use 0-RTT on the 2nd connection if possible.-  -- client original-  , ccServerName    :: HostName -- ^ Used to create a socket and SNI for TLS.-  , ccPortName      :: ServiceName -- ^ Used to create a socket.-  , ccALPN          :: Version -> IO (Maybe [ByteString]) -- ^ An ALPN provider.-  , ccValidate      :: Bool -- ^ Authenticating a server based on its certificate.-  , ccResumption    :: ResumptionInfo  -- ^ Use resumption on the 2nd connection if possible.-  , ccPacketSize    :: Maybe Int -- ^ QUIC packet size (UDP payload size)-  , ccDebugLog      :: Bool-  , ccAutoMigration :: Bool -- ^ If 'True', use a unconnected socket for auto migration. Otherwise, use a connected socket.-  }+data ClientConfig = ClientConfig+    { ccVersions :: [Version]+    -- ^ Compatible versions in the preferred order.+    , ccCiphers :: [Cipher]+    -- ^ Cipher candidates defined in TLS 1.3.+    , ccGroups :: [Group]+    -- ^ Key exchange group candidates defined in TLS 1.3.+    , ccParameters :: Parameters+    , ccKeyLog :: String -> IO ()+    , ccQLog :: Maybe FilePath+    , ccCredentials :: Credentials+    -- ^ TLS credentials.+    , ccHooks :: Hooks+    , ccUse0RTT :: Bool+    -- ^ Use 0-RTT on the 2nd connection if possible.+    -- client original+    , ccServerName :: HostName+    -- ^ Used to create a socket and SNI for TLS.+    , ccPortName :: ServiceName+    -- ^ Used to create a socket.+    , ccALPN :: Version -> IO (Maybe [ByteString])+    -- ^ An ALPN provider.+    , ccValidate :: Bool+    -- ^ Authenticating a server based on its certificate.+    , ccResumption :: ResumptionInfo+    -- ^ Use resumption on the 2nd connection if possible.+    , ccPacketSize :: Maybe Int+    -- ^ QUIC packet size (UDP payload size)+    , ccDebugLog :: Bool+    , ccAutoMigration :: Bool+    -- ^ If 'True', use a unconnected socket for auto migration. Otherwise, use a connected socket.+    }  -- | The default value for client configuration. defaultClientConfig :: ClientConfig-defaultClientConfig = ClientConfig {-    ccVersions      = [Version2,Version1]-  , ccCiphers       = supportedCiphers defaultSupported-  , ccGroups        = supportedGroups defaultSupported-  , ccParameters    = defaultParameters-  , ccKeyLog        = \_ -> return ()-  , ccQLog          = Nothing-  , ccCredentials   = mempty-  , ccHooks         = defaultHooks-  , ccUse0RTT       = False-  -- client original-  , ccServerName    = "127.0.0.1"-  , ccPortName      = "4433"-  , ccALPN          = \_ -> return Nothing-  , ccValidate      = True-  , ccResumption    = defaultResumptionInfo-  , ccPacketSize    = Nothing-  , ccDebugLog      = False-  , ccAutoMigration = True-  }+defaultClientConfig =+    ClientConfig+        { ccVersions = [Version2, Version1]+        , ccCiphers = supportedCiphers defaultSupported+        , ccGroups = supportedGroups defaultSupported+        , ccParameters = defaultParameters+        , ccKeyLog = \_ -> return ()+        , ccQLog = Nothing+        , ccCredentials = mempty+        , ccHooks = defaultHooks+        , ccUse0RTT = False+        , -- client original+          ccServerName = "127.0.0.1"+        , ccPortName = "4433"+        , ccALPN = \_ -> return Nothing+        , ccValidate = True+        , ccResumption = defaultResumptionInfo+        , ccPacketSize = Nothing+        , ccDebugLog = False+        , ccAutoMigration = True+        }  ----------------------------------------------------------------  -- | Server configuration.-data ServerConfig = ServerConfig {-    scVersions       :: [Version] -- ^ Fully-Deployed Versions in the preferred order.-  , scCiphers        :: [Cipher] -- ^ Cipher candidates defined in TLS 1.3.-  , scGroups         :: [Group] -- ^ Key exchange group candidates defined in TLS 1.3.-  , scParameters     :: Parameters-  , scKeyLog         :: String -> IO ()-  , scQLog           :: Maybe FilePath-  , scCredentials    :: Credentials -- ^ Server certificate information.-  , scHooks          :: Hooks-  , scUse0RTT        :: Bool -- ^ Use 0-RTT on the 2nd connection if possible.-  -- server original-  , scAddresses      :: [(IP,PortNumber)] -- ^ Server addresses assigned to used network interfaces.-  , scALPN           :: Maybe (Version -> [ByteString] -> IO ByteString) -- ^ ALPN handler.-  , scRequireRetry   :: Bool -- ^ Requiring QUIC retry.-  , scSessionManager :: SessionManager -- ^ A session manager of TLS 1.3.-  , scDebugLog       :: Maybe FilePath-  }+data ServerConfig = ServerConfig+    { scVersions :: [Version]+    -- ^ Fully-Deployed Versions in the preferred order.+    , scCiphers :: [Cipher]+    -- ^ Cipher candidates defined in TLS 1.3.+    , scGroups :: [Group]+    -- ^ Key exchange group candidates defined in TLS 1.3.+    , scParameters :: Parameters+    , scKeyLog :: String -> IO ()+    , scQLog :: Maybe FilePath+    , scCredentials :: Credentials+    -- ^ Server certificate information.+    , scHooks :: Hooks+    , scUse0RTT :: Bool+    -- ^ Use 0-RTT on the 2nd connection if possible.+    -- server original+    , scAddresses :: [(IP, PortNumber)]+    -- ^ Server addresses assigned to used network interfaces.+    , scALPN :: Maybe (Version -> [ByteString] -> IO ByteString)+    -- ^ ALPN handler.+    , scRequireRetry :: Bool+    -- ^ Requiring QUIC retry.+    , scSessionManager :: SessionManager+    -- ^ A session manager of TLS 1.3.+    , scDebugLog :: Maybe FilePath+    }  -- | The default value for server configuration. defaultServerConfig :: ServerConfig-defaultServerConfig = ServerConfig {-    scVersions       = [Version2,Version1]-  , scCiphers        = supportedCiphers defaultSupported-  , scGroups         = supportedGroups defaultSupported-  , scParameters     = defaultParameters-  , scKeyLog         = \_ -> return ()-  , scQLog           = Nothing-  , scCredentials    = mempty-  , scHooks          = defaultHooks-  , scUse0RTT        = False-  -- server original-  , scAddresses      = [("0.0.0.0",4433),("::",4433)]-  , scALPN           = Nothing-  , scRequireRetry   = False-  , scSessionManager = noSessionManager-  , scDebugLog       = Nothing-  }+defaultServerConfig =+    ServerConfig+        { scVersions = [Version2, Version1]+        , scCiphers = supportedCiphers defaultSupported+        , scGroups = supportedGroups defaultSupported+        , scParameters = defaultParameters+        , scKeyLog = \_ -> return ()+        , scQLog = Nothing+        , scCredentials = mempty+        , scHooks = defaultHooks+        , scUse0RTT = False+        , -- server original+          scAddresses = [("0.0.0.0", 4433), ("::", 4433)]+        , scALPN = Nothing+        , scRequireRetry = False+        , scSessionManager = noSessionManager+        , scDebugLog = Nothing+        }

@@ -1,16 +1,16 @@ module Network.QUIC.Connection (-    module Network.QUIC.Connection.PacketNumber-  , module Network.QUIC.Connection.Crypto-  , module Network.QUIC.Connection.Migration-  , module Network.QUIC.Connection.Misc-  , module Network.QUIC.Connection.State-  , module Network.QUIC.Connection.Stream-  , module Network.QUIC.Connection.StreamTable-  , module Network.QUIC.Connection.Queue-  , module Network.QUIC.Connection.Role-  , module Network.QUIC.Connection.Timeout-  , module Network.QUIC.Connection.Types-  ) where+    module Network.QUIC.Connection.PacketNumber,+    module Network.QUIC.Connection.Crypto,+    module Network.QUIC.Connection.Migration,+    module Network.QUIC.Connection.Misc,+    module Network.QUIC.Connection.State,+    module Network.QUIC.Connection.Stream,+    module Network.QUIC.Connection.StreamTable,+    module Network.QUIC.Connection.Queue,+    module Network.QUIC.Connection.Role,+    module Network.QUIC.Connection.Timeout,+    module Network.QUIC.Connection.Types,+) where  import Network.QUIC.Connection.Crypto import Network.QUIC.Connection.Migration

@@ -1,28 +1,28 @@-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Connection.Crypto (-    setEncryptionLevel-  , waitEncryptionLevel-  , putOffCrypto-  ---  , getCipher-  , setCipher-  , getTLSMode-  , getApplicationProtocol-  , setNegotiated-  ---  , dropSecrets-  ---  , initializeCoder-  , initializeCoder1RTT-  , updateCoder1RTT-  , getCoder-  , getProtector-  ---  , getCurrentKeyPhase-  , setCurrentKeyPhase-  ) where+    setEncryptionLevel,+    waitEncryptionLevel,+    putOffCrypto,+    --+    getCipher,+    setCipher,+    getTLSMode,+    getApplicationProtocol,+    setNegotiated,+    --+    dropSecrets,+    --+    initializeCoder,+    initializeCoder1RTT,+    updateCoder1RTT,+    getCoder,+    getProtector,+    --+    getCurrentKeyPhase,+    setCurrentKeyPhase,+) where  import Network.TLS.QUIC import UnliftIO.STM@@ -49,12 +49,12 @@     atomically $ do         writeTVar (encryptionLevel connState) lvl         case lvl of-          HandshakeLevel -> do-              readTVar (pendingQ ! RTT0Level)      >>= mapM_ (prependRecvQ q)-              readTVar (pendingQ ! HandshakeLevel) >>= mapM_ (prependRecvQ q)-          RTT1Level      ->-              readTVar (pendingQ ! RTT1Level)      >>= mapM_ (prependRecvQ q)-          _              -> return ()+            HandshakeLevel -> do+                readTVar (pendingQ ! RTT0Level) >>= mapM_ (prependRecvQ q)+                readTVar (pendingQ ! HandshakeLevel) >>= mapM_ (prependRecvQ q)+            RTT1Level ->+                readTVar (pendingQ ! RTT1Level) >>= mapM_ (prependRecvQ q)+            _ -> return ()  putOffCrypto :: Connection -> EncryptionLevel -> ReceivedPacket -> IO () putOffCrypto Connection{..} lvl rpkt =@@ -81,13 +81,20 @@ getApplicationProtocol :: Connection -> IO (Maybe NegotiatedProtocol) getApplicationProtocol Connection{..} = applicationProtocol <$> readIORef negotiated -setNegotiated :: Connection -> HandshakeMode13 -> Maybe NegotiatedProtocol -> ApplicationSecretInfo -> IO ()+setNegotiated+    :: Connection+    -> HandshakeMode13+    -> Maybe NegotiatedProtocol+    -> ApplicationSecretInfo+    -> IO () setNegotiated Connection{..} mode mproto appSecInf =-    writeIORef negotiated Negotiated {-        tlsHandshakeMode = mode-      , applicationProtocol = mproto-      , applicationSecretInfo = appSecInf-      }+    writeIORef+        negotiated+        Negotiated+            { tlsHandshakeMode = mode+            , applicationProtocol = mproto+            , applicationSecretInfo = appSecInf+            }  ---------------------------------------------------------------- @@ -100,17 +107,16 @@  initializeCoder :: Connection -> EncryptionLevel -> TrafficSecrets a -> IO () initializeCoder conn lvl sec = do-    ver <- if lvl == RTT0Level then-             return $ getOriginalVersion conn-           else-             getVersion conn+    ver <-+        if lvl == RTT0Level+            then return $ getOriginalVersion conn+            else getVersion conn     cipher <- getCipher conn lvl     avail <- isFusionAvailable     (coder, protector) <--        if useFusion && avail then-            genFusionCoder (isClient conn) ver cipher sec-          else-            genNiteCoder (isClient conn) ver cipher sec+        if useFusion && avail+            then genFusionCoder (isClient conn) ver cipher sec+            else genNiteCoder (isClient conn) ver cipher sec     writeArray (coders conn) lvl coder     writeArray (protectors conn) lvl protector @@ -120,10 +126,9 @@     cipher <- getCipher conn RTT1Level     avail <- isFusionAvailable     (coder, protector) <--        if useFusion && avail then-            genFusionCoder (isClient conn) ver cipher sec-          else-            genNiteCoder (isClient conn) ver cipher sec+        if useFusion && avail+            then genFusionCoder (isClient conn) ver cipher sec+            else genNiteCoder (isClient conn) ver cipher sec     let coder1 = Coder1RTT coder sec     writeArray (coders1RTT conn) False coder1     writeArray (protectors conn) RTT1Level protector@@ -136,126 +141,148 @@     Coder1RTT coder secN <- readArray (coders1RTT conn) (not nextPhase)     let secN1 = updateSecret ver cipher secN     avail <- isFusionAvailable-    coderN1 <- if useFusion && avail then-                   genFusionCoder1RTT (isClient conn) ver cipher secN1 coder-                 else-                   genNiteCoder1RTT (isClient conn) ver cipher secN1 coder+    coderN1 <-+        if useFusion && avail+            then genFusionCoder1RTT (isClient conn) ver cipher secN1 coder+            else genNiteCoder1RTT (isClient conn) ver cipher secN1 coder     let nextCoder = Coder1RTT coderN1 secN1     writeArray (coders1RTT conn) nextPhase nextCoder -updateSecret :: Version -> Cipher -> TrafficSecrets ApplicationSecret -> TrafficSecrets ApplicationSecret+updateSecret+    :: Version+    -> Cipher+    -> TrafficSecrets ApplicationSecret+    -> TrafficSecrets ApplicationSecret updateSecret ver cipher (ClientTrafficSecret cN, ServerTrafficSecret sN) = secN1   where     Secret cN1 = nextSecret ver cipher $ Secret cN     Secret sN1 = nextSecret ver cipher $ Secret sN     secN1 = (ClientTrafficSecret cN1, ServerTrafficSecret sN1) -genFusionCoder :: Bool -> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)+genFusionCoder+    :: Bool -> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector) genFusionCoder cli ver cipher (ClientTrafficSecret c, ServerTrafficSecret s) = do     fctxt <- fusionNewContext     fctxr <- fusionNewContext     fusionSetup cipher fctxt txPayloadKey txPayloadIV     fusionSetup cipher fctxr rxPayloadKey rxPayloadIV     supp <- fusionSetupSupplement cipher txHeaderKey-    let coder = Coder {-            encrypt    = fusionEncrypt fctxt supp-          , decrypt    = fusionDecrypt fctxr-          , supplement = Just supp-          }-    let protector = Protector {-            setSample  = fusionSetSample supp-          , getMask    = fusionGetMask supp-          , unprotect = unp-          }+    let coder =+            Coder+                { encrypt = fusionEncrypt fctxt supp+                , decrypt = fusionDecrypt fctxr+                , supplement = Just supp+                }+    let protector =+            Protector+                { setSample = fusionSetSample supp+                , getMask = fusionGetMask supp+                , unprotect = unp+                }     return (coder, protector)   where-    txSecret | cli           = Secret c-             | otherwise     = Secret s-    rxSecret | cli           = Secret s-             | otherwise     = Secret c+    txSecret+        | cli = Secret c+        | otherwise = Secret s+    rxSecret+        | cli = Secret s+        | otherwise = Secret c     txPayloadKey = aeadKey ver cipher txSecret-    txPayloadIV  = initialVector ver cipher txSecret-    txHeaderKey  = headerProtectionKey ver cipher txSecret+    txPayloadIV = initialVector ver cipher txSecret+    txHeaderKey = headerProtectionKey ver cipher txSecret     rxPayloadKey = aeadKey ver cipher rxSecret-    rxPayloadIV  = initialVector ver cipher rxSecret-    rxHeaderKey  = headerProtectionKey ver cipher rxSecret+    rxPayloadIV = initialVector ver cipher rxSecret+    rxHeaderKey = headerProtectionKey ver cipher rxSecret     unp = protectionMask cipher rxHeaderKey -genNiteCoder :: Bool -> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)+genNiteCoder+    :: Bool -> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector) genNiteCoder cli ver cipher (ClientTrafficSecret c, ServerTrafficSecret s) = do     let enc = makeNiteEncrypt cipher txPayloadKey txPayloadIV         dec = makeNiteDecrypt cipher rxPayloadKey rxPayloadIV-    (set,get) <- makeNiteProtector cipher txHeaderKey-    let coder = Coder {-            encrypt    = enc-          , decrypt    = dec-          , supplement = Nothing-          }-    let protector = Protector {-            setSample  = set-          , getMask    = get-          , unprotect  = unp-          }+    (set, get) <- makeNiteProtector cipher txHeaderKey+    let coder =+            Coder+                { encrypt = enc+                , decrypt = dec+                , supplement = Nothing+                }+    let protector =+            Protector+                { setSample = set+                , getMask = get+                , unprotect = unp+                }     return (coder, protector)   where-    txSecret | cli           = Secret c-             | otherwise     = Secret s-    rxSecret | cli           = Secret s-             | otherwise     = Secret c+    txSecret+        | cli = Secret c+        | otherwise = Secret s+    rxSecret+        | cli = Secret s+        | otherwise = Secret c     txPayloadKey = aeadKey ver cipher txSecret-    txPayloadIV  = initialVector ver cipher txSecret-    txHeaderKey  = headerProtectionKey ver cipher txSecret+    txPayloadIV = initialVector ver cipher txSecret+    txHeaderKey = headerProtectionKey ver cipher txSecret     rxPayloadKey = aeadKey ver cipher rxSecret-    rxPayloadIV  = initialVector ver cipher rxSecret-    rxHeaderKey  = headerProtectionKey ver cipher rxSecret+    rxPayloadIV = initialVector ver cipher rxSecret+    rxHeaderKey = headerProtectionKey ver cipher rxSecret     unp = protectionMask cipher rxHeaderKey -genFusionCoder1RTT :: Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder+genFusionCoder1RTT+    :: Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder genFusionCoder1RTT cli ver cipher (ClientTrafficSecret c, ServerTrafficSecret s) oldcoder = do     fctxt <- fusionNewContext     fctxr <- fusionNewContext     fusionSetup cipher fctxt txPayloadKey txPayloadIV     fusionSetup cipher fctxr rxPayloadKey rxPayloadIV     let supp = fromJust $ supplement oldcoder-    let coder = Coder {-            encrypt    = fusionEncrypt fctxt supp-          , decrypt    = fusionDecrypt fctxr-          , supplement = Just supp-          }+    let coder =+            Coder+                { encrypt = fusionEncrypt fctxt supp+                , decrypt = fusionDecrypt fctxr+                , supplement = Just supp+                }     return coder   where-    txSecret | cli           = Secret c-             | otherwise     = Secret s-    rxSecret | cli           = Secret s-             | otherwise     = Secret c+    txSecret+        | cli = Secret c+        | otherwise = Secret s+    rxSecret+        | cli = Secret s+        | otherwise = Secret c     txPayloadKey = aeadKey ver cipher txSecret-    txPayloadIV  = initialVector ver cipher txSecret+    txPayloadIV = initialVector ver cipher txSecret     rxPayloadKey = aeadKey ver cipher rxSecret-    rxPayloadIV  = initialVector ver cipher rxSecret+    rxPayloadIV = initialVector ver cipher rxSecret -genNiteCoder1RTT :: Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder+genNiteCoder1RTT+    :: Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder genNiteCoder1RTT cli ver cipher (ClientTrafficSecret c, ServerTrafficSecret s) _oldcoder = do     let enc = makeNiteEncrypt cipher txPayloadKey txPayloadIV         dec = makeNiteDecrypt cipher rxPayloadKey rxPayloadIV-    let coder = Coder {-            encrypt    = enc-          , decrypt    = dec-          , supplement = Nothing-          }+    let coder =+            Coder+                { encrypt = enc+                , decrypt = dec+                , supplement = Nothing+                }     return coder   where-    txSecret | cli           = Secret c-             | otherwise     = Secret s-    rxSecret | cli           = Secret s-             | otherwise     = Secret c+    txSecret+        | cli = Secret c+        | otherwise = Secret s+    rxSecret+        | cli = Secret s+        | otherwise = Secret c     txPayloadKey = aeadKey ver cipher txSecret-    txPayloadIV  = initialVector ver cipher txSecret+    txPayloadIV = initialVector ver cipher txSecret     rxPayloadKey = aeadKey ver cipher rxSecret-    rxPayloadIV  = initialVector ver cipher rxSecret+    rxPayloadIV = initialVector ver cipher rxSecret  getCoder :: Connection -> EncryptionLevel -> Bool -> IO Coder getCoder conn RTT1Level k = coder1RTT <$> readArray (coders1RTT conn) k-getCoder conn lvl       _ = readArray (coders conn) lvl+getCoder conn lvl _ = readArray (coders conn) lvl  getProtector :: Connection -> EncryptionLevel -> IO Protector getProtector conn lvl = readArray (protectors conn) lvl

@@ -1,30 +1,30 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Connection.Migration (-    getMyCID-  , getMyCIDs-  , getPeerCID-  , isMyCID-  , myCIDsInclude-  , shouldUpdateMyCID-  , shouldUpdatePeerCID-  , resetPeerCID-  , getNewMyCID-  , getMyCIDSeqNum-  , setMyCID-  , setPeerCIDAndRetireCIDs-  , retirePeerCID-  , retireMyCID-  , addPeerCID-  , waitPeerCID-  , choosePeerCIDForPrivacy-  , setPeerStatelessResetToken-  , isStatelessRestTokenValid-  , setMigrationStarted-  , isPathValidating-  , checkResponse-  , validatePath-  ) where+    getMyCID,+    getMyCIDs,+    getPeerCID,+    isMyCID,+    myCIDsInclude,+    shouldUpdateMyCID,+    shouldUpdatePeerCID,+    resetPeerCID,+    getNewMyCID,+    getMyCIDSeqNum,+    setMyCID,+    setPeerCIDAndRetireCIDs,+    retirePeerCID,+    retireMyCID,+    addPeerCID,+    waitPeerCID,+    choosePeerCIDForPrivacy,+    setPeerStatelessResetToken,+    isStatelessRestTokenValid,+    setMigrationStarted,+    isPathValidating,+    checkResponse,+    validatePath,+) where  import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map@@ -85,8 +85,8 @@ addPeerCID Connection{..} cidInfo = atomically $ do     db <- readTVar peerCIDDB     case Map.lookup (cidInfoCID cidInfo) (revInfos db) of-      Nothing -> modifyTVar' peerCIDDB $ add cidInfo-      Just _  -> return ()+        Nothing -> modifyTVar' peerCIDDB $ add cidInfo+        Just _ -> return ()  shouldUpdatePeerCID :: Connection -> IO Bool shouldUpdatePeerCID Connection{..} =@@ -98,14 +98,14 @@     mr <- atomically $ do         mncid <- pickPeerCID conn         case mncid of-          Nothing   -> return ()-          Just ncid -> do-              setPeerCID conn ncid False-              return ()+            Nothing -> return ()+            Just ncid -> do+                setPeerCID conn ncid False+                return ()         return mncid     case mr of-      Nothing   -> return ()-      Just ncid -> qlogCIDUpdate conn $ Remote $ cidInfoCID ncid+        Nothing -> return ()+        Just ncid -> qlogCIDUpdate conn $ Remote $ cidInfoCID ncid  -- | Only for the internal "migration" API waitPeerCID :: Connection -> IO CIDInfo@@ -151,18 +151,20 @@ arrange n db@CIDDB{..} = (db', dropSeqnums)   where     (toDrops, cidInfos') = IntMap.partitionWithKey (\k _ -> k < n) cidInfos-    dropSeqnums = IntMap.foldrWithKey (\k _ ks -> k:ks) [] toDrops+    dropSeqnums = IntMap.foldrWithKey (\k _ ks -> k : ks) [] toDrops     dropCIDs = IntMap.foldr (\c r -> cidInfoCID c : r) [] toDrops     -- IntMap.findMin is a partial function.     -- But receiver guarantees that there is at least one cidinfo.-    usedCIDInfo' | cidInfoSeq usedCIDInfo >= n = usedCIDInfo-                 | otherwise            = snd $ IntMap.findMin cidInfos'+    usedCIDInfo'+        | cidInfoSeq usedCIDInfo >= n = usedCIDInfo+        | otherwise = snd $ IntMap.findMin cidInfos'     revInfos' = foldr Map.delete revInfos dropCIDs-    db' = db {-        usedCIDInfo = usedCIDInfo'-      , cidInfos    = cidInfos'-      , revInfos    = revInfos'-      }+    db' =+        db+            { usedCIDInfo = usedCIDInfo'+            , cidInfos = cidInfos'+            , revInfos = revInfos'+            }  ---------------------------------------------------------------- @@ -173,12 +175,12 @@     when r $ qlogCIDUpdate conn $ Local ncid   where     findSet db@CIDDB{..}-      | cidInfoCID usedCIDInfo == ncid = (db, False)-      | otherwise = case Map.lookup ncid revInfos of-          Nothing -> (db, False)-          Just n -> case IntMap.lookup n cidInfos of+        | cidInfoCID usedCIDInfo == ncid = (db, False)+        | otherwise = case Map.lookup ncid revInfos of             Nothing -> (db, False)-            Just ncidinfo -> (set ncidinfo False db, True)+            Just n -> case IntMap.lookup n cidInfos of+                Nothing -> (db, False)+                Just ncidinfo -> (set ncidinfo False db, True)  -- | Receiving RetireConnectionID retireMyCID :: Connection -> Int -> IO (Maybe CIDInfo)@@ -189,49 +191,54 @@ set :: CIDInfo -> Bool -> CIDDB -> CIDDB set cidInfo pri db = db'   where-    db' = db {-        usedCIDInfo = cidInfo-      , triggeredByMe = pri-      }+    db' =+        db+            { usedCIDInfo = cidInfo+            , triggeredByMe = pri+            }  add :: CIDInfo -> CIDDB -> CIDDB add cidInfo@CIDInfo{..} db@CIDDB{..} = db'   where-    db' = db {-        cidInfos = IntMap.insert cidInfoSeq cidInfo cidInfos-      , revInfos = Map.insert cidInfoCID cidInfoSeq revInfos-      }+    db' =+        db+            { cidInfos = IntMap.insert cidInfoSeq cidInfo cidInfos+            , revInfos = Map.insert cidInfoCID cidInfoSeq revInfos+            }  new :: CID -> StatelessResetToken -> CIDDB -> (CIDDB, CIDInfo) new cid srt db@CIDDB{..} = (db', cidInfo)   where-   cidInfo = CIDInfo nextSeqNum cid srt-   db' = db {-       nextSeqNum = nextSeqNum + 1-     , cidInfos = IntMap.insert nextSeqNum cidInfo cidInfos-     , revInfos = Map.insert cid nextSeqNum revInfos-     }+    cidInfo = CIDInfo nextSeqNum cid srt+    db' =+        db+            { nextSeqNum = nextSeqNum + 1+            , cidInfos = IntMap.insert nextSeqNum cidInfo cidInfos+            , revInfos = Map.insert cid nextSeqNum revInfos+            }  del :: Int -> CIDDB -> CIDDB del n db@CIDDB{..} = db'   where     db' = case IntMap.lookup n cidInfos of-      Nothing -> db-      Just cidInfo -> db {-          cidInfos = IntMap.delete n cidInfos-        , revInfos = Map.delete (cidInfoCID cidInfo) revInfos-        }+        Nothing -> db+        Just cidInfo ->+            db+                { cidInfos = IntMap.delete n cidInfos+                , revInfos = Map.delete (cidInfoCID cidInfo) revInfos+                }  del' :: Int -> CIDDB -> (CIDDB, Maybe CIDInfo) del' n db@CIDDB{..} = (db', mcidInfo)   where     mcidInfo = IntMap.lookup n cidInfos     db' = case mcidInfo of-      Nothing -> db-      Just cidInfo -> db {-          cidInfos = IntMap.delete n cidInfos-        , revInfos = Map.delete (cidInfoCID cidInfo) revInfos-        }+        Nothing -> db+        Just cidInfo ->+            db+                { cidInfos = IntMap.delete n cidInfos+                , revInfos = Map.delete (cidInfoCID cidInfo) revInfos+                }  ---------------------------------------------------------------- @@ -242,22 +249,24 @@     adjust db@CIDDB{..} = db'       where         db' = case IntMap.lookup 0 cidInfos of-          Nothing      -> db-          Just cidinfo -> let cidinfo' = cidinfo { cidInfoSRT = srt }-                          in db {-                               cidInfos = IntMap.insert 0 cidinfo'-                                        $ IntMap.delete 0 cidInfos-                             , usedCIDInfo = cidinfo'-                             }+            Nothing -> db+            Just cidinfo ->+                let cidinfo' = cidinfo{cidInfoSRT = srt}+                 in db+                        { cidInfos =+                            IntMap.insert 0 cidinfo' $+                                IntMap.delete 0 cidInfos+                        , usedCIDInfo = cidinfo'+                        }  isStatelessRestTokenValid :: Connection -> CID -> StatelessResetToken -> IO Bool isStatelessRestTokenValid Connection{..} cid srt = srtCheck <$> readTVarIO peerCIDDB   where     srtCheck CIDDB{..} = case Map.lookup cid revInfos of-      Nothing -> False-      Just n  -> case IntMap.lookup n cidInfos of         Nothing -> False-        Just (CIDInfo _ _ srt0) -> srt == srt0+        Just n -> case IntMap.lookup n cidInfos of+            Nothing -> False+            Just (CIDInfo _ _ srt0) -> srt == srt0  ---------------------------------------------------------------- @@ -270,7 +279,9 @@ validatePath conn (Just (CIDInfo retiredSeqNum _ _)) = do     pdat <- newPathData     setChallenges conn [pdat]-    putOutput conn $ OutControl RTT1Level [PathChallenge pdat, RetireConnectionID retiredSeqNum] $ return ()+    putOutput conn $+        OutControl RTT1Level [PathChallenge pdat, RetireConnectionID retiredSeqNum] $+            return ()     waitResponse conn     retirePeerCID conn retiredSeqNum @@ -286,9 +297,9 @@ isPathValidating Connection{..} = do     s <- readTVarIO migrationState     case s of-      SendChallenge _  -> return True-      MigrationStarted -> return True-      _                -> return False+        SendChallenge _ -> return True+        MigrationStarted -> return True+        _ -> return False  waitResponse :: Connection -> IO () waitResponse Connection{..} = atomically $ do@@ -300,6 +311,6 @@ checkResponse Connection{..} pdat = do     state <- readTVarIO migrationState     case state of-      SendChallenge pdats-        | pdat `elem` pdats -> atomically $ writeTVar migrationState RecvResponse-      _ -> return ()+        SendChallenge pdats+            | pdat `elem` pdats -> atomically $ writeTVar migrationState RecvResponse+        _ -> return ()

@@ -2,33 +2,33 @@ {-# LANGUAGE TupleSections #-}  module Network.QUIC.Connection.Misc (-    setVersionInfo-  , getVersionInfo-  , setVersion-  , getVersion-  , getOriginalVersion-  , getSocket-  , setSocket-  , clearSocket-  , getPeerAuthCIDs-  , setPeerAuthCIDs-  , getClientDstCID-  , getMyParameters-  , getPeerParameters-  , setPeerParameters-  , delayedAck-  , resetDealyedAck-  , setMaxPacketSize-  , addReader-  , killReaders-  , addResource-  , freeResources-  , readMinIdleTimeout-  , setMinIdleTimeout-  , sendFrames-  , closeConnection-  , abortConnection-  ) where+    setVersionInfo,+    getVersionInfo,+    setVersion,+    getVersion,+    getOriginalVersion,+    getSocket,+    setSocket,+    clearSocket,+    getPeerAuthCIDs,+    setPeerAuthCIDs,+    getClientDstCID,+    getMyParameters,+    getPeerParameters,+    setPeerParameters,+    delayedAck,+    resetDealyedAck,+    setMaxPacketSize,+    addReader,+    killReaders,+    addResource,+    freeResources,+    readMinIdleTimeout,+    setMinIdleTimeout,+    sendFrames,+    closeConnection,+    abortConnection,+) where  import Network.UDP import System.Mem.Weak@@ -53,7 +53,7 @@  setVersion :: Connection -> Version -> IO () setVersion Connection{..} ver = atomicModifyIORef'' quicVersionInfo $ \vi ->-  vi { chosenVersion = ver }+    vi{chosenVersion = ver}  getVersion :: Connection -> IO Version getVersion conn = chosenVersion <$> getVersionInfo conn@@ -86,13 +86,13 @@  getClientDstCID :: Connection -> IO CID getClientDstCID conn = do-    cids <- if isClient conn then-              getPeerAuthCIDs conn-            else-              getMyAuthCIDs conn+    cids <-+        if isClient conn+            then getPeerAuthCIDs conn+            else getMyAuthCIDs conn     return $ case retrySrcCID cids of-      Nothing   -> fromJust $ origDstCID cids-      Just dcid -> dcid+        Nothing -> fromJust $ origDstCID cids+        Just dcid -> dcid  ---------------------------------------------------------------- @@ -111,7 +111,7 @@  delayedAck :: Connection -> IO () delayedAck conn@Connection{..} = do-    (oldcnt,send_) <- atomicModifyIORef' delayedAckCount check+    (oldcnt, send_) <- atomicModifyIORef' delayedAckCount check     when (oldcnt == 0) $ do         new <- cfire conn (Microseconds 20000) sendAck         join $ atomicModifyIORef' delayedAckCancel (new,)@@ -121,8 +121,8 @@         sendAck   where     sendAck = putOutput conn $ OutControl RTT1Level [] $ return ()-    check 1 = (0,   (1,  True))-    check n = (n+1, (n, False))+    check 1 = (0, (1, True))+    check n = (n + 1, (n, False))  resetDealyedAck :: Connection -> IO () resetDealyedAck Connection{..} = do@@ -165,8 +165,8 @@  setMinIdleTimeout :: Connection -> Microseconds -> IO () setMinIdleTimeout Connection{..} us-  | us == Microseconds 0 = return ()-  | otherwise            = atomicModifyIORef'' minIdleTimeout modify+    | us == Microseconds 0 = return ()+    | otherwise = atomicModifyIORef'' minIdleTimeout modify   where     modify us0 = min us us0 @@ -183,5 +183,6 @@     quicexc = TransportErrorIsSent err desc  -- | Closing a connection with an application protocol error.-abortConnection :: Connection -> ApplicationProtocolError -> ReasonPhrase -> IO ()+abortConnection+    :: Connection -> ApplicationProtocolError -> ReasonPhrase -> IO () abortConnection conn err desc = E.throwTo (mainThreadId conn) $ Abort err desc

@@ -1,10 +1,10 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Connection.PacketNumber (-    nextPacketNumber-  , setPeerPacketNumber-  , getPeerPacketNumber-  ) where+    nextPacketNumber,+    setPeerPacketNumber,+    getPeerPacketNumber,+) where  import Network.QUIC.Connection.Types import Network.QUIC.Connector

@@ -2,25 +2,25 @@ {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}  module Network.QUIC.Connection.Role (-    setToken-  , getToken-  , getResumptionInfo-  , setRetried-  , getRetried-  , setIncompatibleVN-  , getIncompatibleVN-  , setResumptionSession-  , setNewToken-  , setRegister-  , getRegister-  , getUnregister-  , setTokenManager-  , getTokenManager-  , setBaseThreadId-  , getBaseThreadId-  , setCertificateChain-  , getCertificateChain-  ) where+    setToken,+    getToken,+    getResumptionInfo,+    setRetried,+    getRetried,+    setIncompatibleVN,+    getIncompatibleVN,+    setResumptionSession,+    setNewToken,+    setRegister,+    getRegister,+    getUnregister,+    setTokenManager,+    getTokenManager,+    setBaseThreadId,+    getBaseThreadId,+    setCertificateChain,+    getCertificateChain,+) where  import qualified Crypto.Token as CT import Data.X509 (CertificateChain)@@ -36,12 +36,12 @@  setToken :: Connection -> Token -> IO () setToken Connection{..} token = atomicModifyIORef'' roleInfo $-    \ci -> ci { clientInitialToken = token }+    \ci -> ci{clientInitialToken = token}  getToken :: Connection -> IO Token getToken conn@Connection{..}-  | isClient conn = clientInitialToken <$> readIORef roleInfo-  | otherwise     = return emptyToken+    | isClient conn = clientInitialToken <$> readIORef roleInfo+    | otherwise = return emptyToken  ---------------------------------------------------------------- @@ -53,59 +53,67 @@  setRetried :: Connection -> Bool -> IO () setRetried conn@Connection{..} r-  | isClient conn = atomicModifyIORef'' roleInfo $ \ci -> ci {-        resumptionInfo = (resumptionInfo ci) { resumptionRetry = r}-        }-  | otherwise     = atomicModifyIORef'' roleInfo $ \si -> si { askRetry = r }+    | isClient conn = atomicModifyIORef'' roleInfo $ \ci ->+        ci+            { resumptionInfo = (resumptionInfo ci){resumptionRetry = r}+            }+    | otherwise = atomicModifyIORef'' roleInfo $ \si -> si{askRetry = r}  getRetried :: Connection -> IO Bool getRetried conn@Connection{..}-  | isClient conn = resumptionRetry . resumptionInfo <$> readIORef roleInfo-  | otherwise     = askRetry <$> readIORef roleInfo+    | isClient conn = resumptionRetry . resumptionInfo <$> readIORef roleInfo+    | otherwise = askRetry <$> readIORef roleInfo  ----------------------------------------------------------------  setIncompatibleVN :: Connection -> Bool -> IO () setIncompatibleVN conn@Connection{..} icvn-  | isClient conn = atomicModifyIORef'' roleInfo $ \ci -> ci {-        incompatibleVN = icvn-      }-  | otherwise     = return ()+    | isClient conn = atomicModifyIORef'' roleInfo $ \ci ->+        ci+            { incompatibleVN = icvn+            }+    | otherwise = return ()  getIncompatibleVN :: Connection -> IO Bool getIncompatibleVN conn@Connection{..}-  | isClient conn = incompatibleVN <$> readIORef roleInfo-  | otherwise     = return False+    | isClient conn = incompatibleVN <$> readIORef roleInfo+    | otherwise = return False  ----------------------------------------------------------------  setResumptionSession :: Connection -> SessionEstablish setResumptionSession conn@Connection{..} si sd = do     ver <- getVersion conn-    atomicModifyIORef'' roleInfo $ \ci -> ci {-        resumptionInfo = (resumptionInfo ci) {-              resumptionVersion = ver-            , resumptionSession = Just (si,sd)+    atomicModifyIORef'' roleInfo $ \ci ->+        ci+            { resumptionInfo =+                (resumptionInfo ci)+                    { resumptionVersion = ver+                    , resumptionSession = Just (si, sd)+                    }             }-      }  setNewToken :: Connection -> Token -> IO () setNewToken conn@Connection{..} token = do     ver <- getVersion conn-    atomicModifyIORef'' roleInfo $ \ci -> ci {-        resumptionInfo = (resumptionInfo ci) {-              resumptionVersion = ver-            , resumptionToken = token+    atomicModifyIORef'' roleInfo $ \ci ->+        ci+            { resumptionInfo =+                (resumptionInfo ci)+                    { resumptionVersion = ver+                    , resumptionToken = token+                    }             }-      }  ---------------------------------------------------------------- -setRegister :: Connection -> (CID -> Connection -> IO ()) -> (CID -> IO ()) -> IO ()-setRegister Connection{..} regisrer unregister = atomicModifyIORef'' roleInfo $ \si -> si {-    registerCID = regisrer-  , unregisterCID = unregister-  }+setRegister+    :: Connection -> (CID -> Connection -> IO ()) -> (CID -> IO ()) -> IO ()+setRegister Connection{..} regisrer unregister = atomicModifyIORef'' roleInfo $ \si ->+    si+        { registerCID = regisrer+        , unregisterCID = unregister+        }  getRegister :: Connection -> IO (CID -> Connection -> IO ()) getRegister Connection{..} = registerCID <$> readIORef roleInfo@@ -117,7 +125,7 @@  setTokenManager :: Connection -> CT.TokenManager -> IO () setTokenManager Connection{..} mgr = atomicModifyIORef'' roleInfo $-    \si -> si { tokenManager = mgr }+    \si -> si{tokenManager = mgr}  getTokenManager :: Connection -> IO CT.TokenManager getTokenManager Connection{..} = tokenManager <$> readIORef roleInfo@@ -126,7 +134,7 @@  setBaseThreadId :: Connection -> ThreadId -> IO () setBaseThreadId Connection{..} tid = atomicModifyIORef'' roleInfo $-    \si -> si { baseThreadId = tid }+    \si -> si{baseThreadId = tid}  getBaseThreadId :: Connection -> IO ThreadId getBaseThreadId Connection{..} = baseThreadId <$> readIORef roleInfo@@ -135,7 +143,7 @@  setCertificateChain :: Connection -> Maybe CertificateChain -> IO () setCertificateChain Connection{..} mcc = atomicModifyIORef'' roleInfo $-    \si -> si { certChain = mcc }+    \si -> si{certChain = mcc}  getCertificateChain :: Connection -> IO (Maybe CertificateChain) getCertificateChain Connection{..} = certChain <$> readIORef roleInfo

@@ -1,41 +1,36 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Connection.State (-    setConnection0RTTReady-  , isConnection1RTTReady-  , setConnection1RTTReady-  , isConnectionEstablished-  , setConnectionEstablished-  , wait0RTTReady-  , wait1RTTReady-  , waitEstablished-  , readConnectionFlowTx-  , addTxData-  , getTxData-  , setTxMaxData-  , getTxMaxData-  , addRxData-  , getRxData-  , addRxMaxData-  , getRxMaxData-  , getRxDataWindow-  , checkRxMaxData-  , addTxBytes-  , getTxBytes-  , addRxBytes-  , getRxBytes-  , setAddressValidated-  , waitAntiAmplificationFree-  , checkAntiAmplificationFree-  ) where+    setConnection0RTTReady,+    isConnection1RTTReady,+    setConnection1RTTReady,+    isConnectionEstablished,+    setConnectionEstablished,+    wait0RTTReady,+    wait1RTTReady,+    waitEstablished,+    readConnectionFlowTx,+    addTxData,+    setTxMaxData,+    getRxMaxData,+    updateFlowRx,+    checkRxMaxData,+    addTxBytes,+    getTxBytes,+    addRxBytes,+    getRxBytes,+    setAddressValidated,+    waitAntiAmplificationFree,+    checkAntiAmplificationFree,+) where +import Network.Control import UnliftIO.STM  import Network.QUIC.Connection.Types import Network.QUIC.Connector import Network.QUIC.Imports import Network.QUIC.Recovery-import Network.QUIC.Stream  ---------------------------------------------------------------- @@ -84,7 +79,7 @@  ---------------------------------------------------------------- -readConnectionFlowTx :: Connection -> STM Flow+readConnectionFlowTx :: Connection -> STM TxFlow readConnectionFlowTx Connection{..} = readTVar flowTx  ----------------------------------------------------------------@@ -92,55 +87,27 @@ addTxData :: Connection -> Int -> STM () addTxData Connection{..} n = modifyTVar' flowTx add   where-    add flow = flow { flowData = flowData flow + n }--getTxData :: Connection -> IO Int-getTxData Connection{..} = atomically $ flowData <$> readTVar flowTx+    add flow = flow{txfSent = txfSent flow + n}  setTxMaxData :: Connection -> Int -> IO () setTxMaxData Connection{..} n = atomically $ modifyTVar' flowTx set   where     set flow-      | flowMaxData flow < n = flow { flowMaxData = n }-      | otherwise            = flow--getTxMaxData :: Connection -> STM Int-getTxMaxData Connection{..} = flowMaxData <$> readTVar flowTx+        | txfLimit flow < n = flow{txfLimit = n}+        | otherwise = flow  ---------------------------------------------------------------- -addRxData :: Connection -> Int -> IO ()-addRxData Connection{..} n = atomicModifyIORef'' flowRx add-  where-    add flow = flow { flowData = flowData flow + n }--getRxData :: Connection -> IO Int-getRxData Connection{..} = flowData <$> readIORef flowRx--addRxMaxData :: Connection -> Int -> IO Int-addRxMaxData Connection{..} n = atomicModifyIORef' flowRx add-  where-    add flow = (flow { flowMaxData = m }, m)-      where-        m = flowMaxData flow + n- getRxMaxData :: Connection -> IO Int-getRxMaxData Connection{..} = flowMaxData <$> readIORef flowRx--getRxDataWindow :: Connection -> IO Int-getRxDataWindow Connection{..} = flowWindow <$> readIORef flowRx+getRxMaxData Connection{..} = rxfLimit <$> readIORef flowRx -----------------------------------------------------------------+updateFlowRx :: Connection -> Int -> IO (Maybe Int)+updateFlowRx Connection{..} consumed =+    atomicModifyIORef' flowRx $ maybeOpenRxWindow consumed FCTMaxData  checkRxMaxData :: Connection -> Int -> IO Bool-checkRxMaxData Connection{..} len = do-    received <- readIORef flowBytesRx-    maxData <- flowMaxData <$> readIORef flowRx-    if received + len < maxData then do-        modifyIORef' flowBytesRx (+ len)-        return True-      else-        return False+checkRxMaxData Connection{..} len =+    atomicModifyIORef' flowRx $ checkRxLimit len  ---------------------------------------------------------------- @@ -168,17 +135,18 @@     unless ok $ do         beforeAntiAmp connLDCC         atomically (checkAntiAmplificationFreeSTM conn siz >>= checkSTM)-        -- setLossDetectionTimer is called eventually. +-- setLossDetectionTimer is called eventually.+ checkAntiAmplificationFreeSTM :: Connection -> Int -> STM Bool checkAntiAmplificationFreeSTM Connection{..} siz = do     validated <- readTVar addressValidated-    if validated then-        return True-      else do-        tx <- readTVar bytesTx-        rx <- readTVar bytesRx-        return (tx + siz <= 3 * rx)+    if validated+        then return True+        else do+            tx <- readTVar bytesTx+            rx <- readTVar bytesRx+            return (tx + siz <= 3 * rx)  checkAntiAmplificationFree :: Connection -> Int -> IO Bool checkAntiAmplificationFree conn siz =

@@ -3,15 +3,15 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Connection.Stream (-    getMyStreamId-  , waitMyNewStreamId-  , waitMyNewUniStreamId-  , setTxMaxStreams-  , setTxUniMaxStreams-  , checkRxMaxStreams-  , updatePeerStreamId-  , checkStreamIdRoom-  ) where+    getMyStreamId,+    waitMyNewStreamId,+    waitMyNewUniStreamId,+    setTxMaxStreams,+    setTxUniMaxStreams,+    checkRxMaxStreams,+    updatePeerStreamId,+    checkStreamIdRoom,+) where  import UnliftIO.STM @@ -40,7 +40,7 @@         StreamIdBase base = maxStreams     checkSTM (currentStream < base * 4 + streamType)     let currentStream' = currentStream + 4-    writeTVar tvar conc { currentStream = currentStream' }+    writeTVar tvar conc{currentStream = currentStream'}     return currentStream  -- From "Peer", but set it to "My".@@ -52,20 +52,26 @@ setTxUniMaxStreams Connection{..} = set myUniStreamId  set :: TVar Concurrency -> Int -> IO ()-set tvar mx = atomically $ modifyTVar tvar $ \c -> c { maxStreams = StreamIdBase mx }+set tvar mx = atomically $ modifyTVar tvar $ \c -> c{maxStreams = StreamIdBase mx}  updatePeerStreamId :: Connection -> StreamId -> IO () updatePeerStreamId conn sid = do-    when ((isClient conn && isServerInitiatedBidirectional sid)-       || (isServer conn && isClientInitiatedBidirectional sid)) $ do-        atomicModifyIORef'' (peerStreamId conn) check-    when ((isClient conn && isServerInitiatedUnidirectional sid)-       || (isServer conn && isClientInitiatedUnidirectional sid)) $ do-        atomicModifyIORef'' (peerUniStreamId conn) check+    when+        ( (isClient conn && isServerInitiatedBidirectional sid)+            || (isServer conn && isClientInitiatedBidirectional sid)+        )+        $ do+            atomicModifyIORef'' (peerStreamId conn) check+    when+        ( (isClient conn && isServerInitiatedUnidirectional sid)+            || (isServer conn && isClientInitiatedUnidirectional sid)+        )+        $ do+            atomicModifyIORef'' (peerUniStreamId conn) check   where     check conc@Concurrency{..}-      | currentStream < sid = conc { currentStream = sid }-      | otherwise           = conc+        | currentStream < sid = conc{currentStream = sid}+        | otherwise = conc  checkRxMaxStreams :: Connection -> StreamId -> IO Bool checkRxMaxStreams conn@Connection{..} sid = do@@ -76,30 +82,31 @@   where     streamType = sid .&. 0b11     readForClient = case streamType of-      0 -> readTVarIO myStreamId-      1 -> readIORef  peerStreamId-      2 -> readTVarIO myUniStreamId-      3 -> readIORef  peerUniStreamId-      _ -> error "never reach"+        0 -> readTVarIO myStreamId+        1 -> readIORef peerStreamId+        2 -> readTVarIO myUniStreamId+        3 -> readIORef peerUniStreamId+        _ -> error "never reach"     readForServer = case streamType of-      0 -> readIORef  peerStreamId-      1 -> readTVarIO myStreamId-      2 -> readIORef  peerUniStreamId-      3 -> readTVarIO myUniStreamId-      _ -> error "never reach"+        0 -> readIORef peerStreamId+        1 -> readTVarIO myStreamId+        2 -> readIORef peerUniStreamId+        3 -> readTVarIO myUniStreamId+        _ -> error "never reach"  checkStreamIdRoom :: Connection -> Direction -> IO (Maybe Int) checkStreamIdRoom conn dir = do-    let ref | dir == Bidirectional = peerStreamId conn-            | otherwise            = peerUniStreamId conn+    let ref+            | dir == Bidirectional = peerStreamId conn+            | otherwise = peerUniStreamId conn     atomicModifyIORef' ref check   where     check conc@Concurrency{..} =         let StreamIdBase base = maxStreams             initialStreams = initialMaxStreamsBidi $ getMyParameters conn             cbase = currentStream !>>. 2-        in if (base - cbase < (initialStreams !>>. 3)) then-               let base' = base + initialStreams-               in (conc { maxStreams = StreamIdBase base' }, Just base')-           else-               (conc, Nothing)+         in if (base - cbase < (initialStreams !>>. 3))+                then+                    let base' = cbase + initialStreams+                     in (conc{maxStreams = StreamIdBase base'}, Just base')+                else (conc, Nothing)

@@ -1,15 +1,15 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Connection.StreamTable (-    createStream-  , findStream-  , addStream-  , delStream-  , initialRxMaxStreamData-  , setupCryptoStreams-  , clearCryptoStream-  , getCryptoStream-  ) where+    createStream,+    findStream,+    addStream,+    delStream,+    initialRxMaxStreamData,+    setupCryptoStreams,+    clearCryptoStream,+    getCryptoStream,+) where  import Network.QUIC.Connection.Misc import Network.QUIC.Connection.Queue@@ -22,26 +22,29 @@  createStream :: Connection -> StreamId -> IO Stream createStream conn sid = do-      strm <- addStream conn sid-      putInput conn $ InpStream strm-      return strm+    strm <- addStream conn sid+    putInput conn $ InpStream strm+    return strm  findStream :: Connection -> StreamId -> IO (Maybe Stream) findStream Connection{..} sid = lookupStream sid <$> readIORef streamTable  addStream :: Connection -> StreamId -> IO Stream addStream conn@Connection{..} sid = do-    strm <- newStream conn sid-    if isClient conn then do-         let clientParams = getMyParameters conn-         setRxMaxStreamData strm $ clientInitial sid clientParams-         serverParams <- getPeerParameters conn-         setTxMaxStreamData strm $ serverInitial sid serverParams-      else do-         let serverParams = getMyParameters conn-         setRxMaxStreamData strm $ serverInitial sid serverParams-         clientParams <- getPeerParameters conn-         setTxMaxStreamData strm $ clientInitial sid clientParams+    strm <-+        if isClient conn+            then do+                serverParams <- getPeerParameters conn+                let txLim = serverInitial sid serverParams+                let clientParams = getMyParameters conn+                    rxLim = clientInitial sid clientParams+                newStream conn sid txLim rxLim+            else do+                clientParams <- getPeerParameters conn+                let txLim = clientInitial sid clientParams+                    serverParams = getMyParameters conn+                    rxLim = serverInitial sid serverParams+                newStream conn sid txLim rxLim     atomicModifyIORef'' streamTable $ insertStream sid strm     return strm @@ -52,23 +55,23 @@ initialRxMaxStreamData :: Connection -> StreamId -> Int initialRxMaxStreamData conn sid     | isClient conn = clientInitial sid params-    | otherwise     = serverInitial sid params+    | otherwise = serverInitial sid params   where     params = getMyParameters conn  clientInitial :: StreamId -> Parameters -> Int clientInitial sid params-  | isClientInitiatedBidirectional  sid = initialMaxStreamDataBidiLocal  params-  | isServerInitiatedBidirectional  sid = initialMaxStreamDataBidiRemote params-  -- intentionally not using isServerInitiatedUnidirectional-  | otherwise                           = initialMaxStreamDataUni        params+    | isClientInitiatedBidirectional sid = initialMaxStreamDataBidiLocal params+    | isServerInitiatedBidirectional sid = initialMaxStreamDataBidiRemote params+    -- intentionally not using isServerInitiatedUnidirectional+    | otherwise = initialMaxStreamDataUni params  serverInitial :: StreamId -> Parameters -> Int serverInitial sid params-  | isServerInitiatedBidirectional  sid = initialMaxStreamDataBidiLocal  params-  | isClientInitiatedBidirectional  sid = initialMaxStreamDataBidiRemote params-  -- intentionally not using isClientInitiatedUnidirectional-  | otherwise                           = initialMaxStreamDataUni        params+    | isServerInitiatedBidirectional sid = initialMaxStreamDataBidiLocal params+    | isClientInitiatedBidirectional sid = initialMaxStreamDataBidiRemote params+    -- intentionally not using isClientInitiatedUnidirectional+    | otherwise = initialMaxStreamDataUni params  ---------------------------------------------------------------- 

@@ -1,14 +1,14 @@ module Network.QUIC.Connection.Timeout (-    timeout-  , fire-  , cfire-  , delay-  ) where+    timeout,+    fire,+    cfire,+    delay,+) where  import Network.QUIC.Event+import qualified System.Timeout as ST import UnliftIO.Concurrent import qualified UnliftIO.Exception as E-import qualified System.Timeout as ST  import Network.QUIC.Connection.Types import Network.QUIC.Connector

@@ -15,6 +15,7 @@ import Data.X509 (CertificateChain) import Foreign.Marshal.Alloc import Foreign.Ptr (nullPtr)+import Network.Control (Rate, RxFlow, TxFlow, newRate, newRxFlow, newTxFlow) import Network.TLS.QUIC import Network.UDP (UDPSocket) import UnliftIO.Concurrent@@ -38,133 +39,147 @@  ---------------------------------------------------------------- -data RoleInfo = ClientInfo { clientInitialToken :: Token -- new or retry token-                           , resumptionInfo     :: ResumptionInfo-                           , incompatibleVN     :: Bool-                           }-              | ServerInfo { tokenManager    :: ~CT.TokenManager-                           , registerCID     :: CID -> Connection -> IO ()-                           , unregisterCID   :: CID -> IO ()-                           , askRetry        :: Bool-                           , baseThreadId    :: ~ThreadId-                           , certChain       :: Maybe CertificateChain-                           }+data RoleInfo+    = ClientInfo+        { clientInitialToken :: Token -- new or retry token+        , resumptionInfo :: ResumptionInfo+        , incompatibleVN :: Bool+        }+    | ServerInfo+        { tokenManager :: ~CT.TokenManager+        , registerCID :: CID -> Connection -> IO ()+        , unregisterCID :: CID -> IO ()+        , askRetry :: Bool+        , baseThreadId :: ~ThreadId+        , certChain :: Maybe CertificateChain+        }  defaultClientRoleInfo :: RoleInfo-defaultClientRoleInfo = ClientInfo {-    clientInitialToken = emptyToken-  , resumptionInfo     = defaultResumptionInfo-  , incompatibleVN     = False-  }+defaultClientRoleInfo =+    ClientInfo+        { clientInitialToken = emptyToken+        , resumptionInfo = defaultResumptionInfo+        , incompatibleVN = False+        }  defaultServerRoleInfo :: RoleInfo-defaultServerRoleInfo = ServerInfo {-    tokenManager = undefined-  , registerCID = \_ _ -> return ()-  , unregisterCID = \_ -> return ()-  , askRetry = False-  , baseThreadId = undefined-  , certChain = Nothing-  }+defaultServerRoleInfo =+    ServerInfo+        { tokenManager = undefined+        , registerCID = \_ _ -> return ()+        , unregisterCID = \_ -> return ()+        , askRetry = False+        , baseThreadId = undefined+        , certChain = Nothing+        }  -- fixme: limitation-data CIDDB = CIDDB {-    usedCIDInfo   :: CIDInfo-  , cidInfos      :: IntMap CIDInfo-  , revInfos      :: Map CID Int-  , nextSeqNum    :: Int  -- only for mine (new)-  , triggeredByMe :: Bool -- only for peer's-  } deriving (Show)+data CIDDB = CIDDB+    { usedCIDInfo :: CIDInfo+    , cidInfos :: IntMap CIDInfo+    , revInfos :: Map CID Int+    , nextSeqNum :: Int -- only for mine (new)+    , triggeredByMe :: Bool -- only for peer's+    }+    deriving (Show)  newCIDDB :: CID -> CIDDB-newCIDDB cid = CIDDB {-    usedCIDInfo   = cidInfo-  , cidInfos      = IntMap.singleton 0 cidInfo-  , revInfos      = Map.singleton cid 0-  , nextSeqNum    = 1-  , triggeredByMe = False-  }+newCIDDB cid =+    CIDDB+        { usedCIDInfo = cidInfo+        , cidInfos = IntMap.singleton 0 cidInfo+        , revInfos = Map.singleton cid 0+        , nextSeqNum = 1+        , triggeredByMe = False+        }   where     cidInfo = CIDInfo 0 cid (StatelessResetToken "")  ---------------------------------------------------------------- -data MigrationState = NonMigration-                    | MigrationStarted-                    | SendChallenge [PathData]-                    | RecvResponse-                    deriving (Eq, Show)+data MigrationState+    = NonMigration+    | MigrationStarted+    | SendChallenge [PathData]+    | RecvResponse+    deriving (Eq, Show)  ---------------------------------------------------------------- -data Coder = Coder {-    encrypt    :: Buffer -> PlainText  -> AssDat -> PacketNumber -> IO Int-  , decrypt    :: Buffer -> CipherText -> AssDat -> PacketNumber -> IO Int-  , supplement :: Maybe Supplement-  }+data Coder = Coder+    { encrypt :: Buffer -> PlainText -> AssDat -> PacketNumber -> IO Int+    , decrypt :: Buffer -> CipherText -> AssDat -> PacketNumber -> IO Int+    , supplement :: Maybe Supplement+    }  initialCoder :: Coder-initialCoder = Coder {-    encrypt    = \_ _ _ _ -> return (-1)-  , decrypt    = \_ _ _ _ -> return (-1)-  , supplement = Nothing-  }+initialCoder =+    Coder+        { encrypt = \_ _ _ _ -> return (-1)+        , decrypt = \_ _ _ _ -> return (-1)+        , supplement = Nothing+        } -data Coder1RTT = Coder1RTT {-    coder1RTT  :: Coder-  , secretN    :: TrafficSecrets ApplicationSecret-  }+data Coder1RTT = Coder1RTT+    { coder1RTT :: Coder+    , secretN :: TrafficSecrets ApplicationSecret+    }  initialCoder1RTT :: Coder1RTT-initialCoder1RTT = Coder1RTT {-    coder1RTT  = initialCoder-  , secretN    = (ClientTrafficSecret "", ServerTrafficSecret "")-  }+initialCoder1RTT =+    Coder1RTT+        { coder1RTT = initialCoder+        , secretN = (ClientTrafficSecret "", ServerTrafficSecret "")+        } -data Protector = Protector {-    setSample  :: Buffer -> IO ()-  , getMask    :: IO Buffer-  , unprotect :: Sample -> Mask-  }+data Protector = Protector+    { setSample :: Buffer -> IO ()+    , getMask :: IO Buffer+    , unprotect :: Sample -> Mask+    }  initialProtector :: Protector-initialProtector = Protector {-    setSample  = \_ -> return ()-  , getMask    = return nullPtr-  , unprotect = \_ -> Mask ""-  }+initialProtector =+    Protector+        { setSample = \_ -> return ()+        , getMask = return nullPtr+        , unprotect = \_ -> Mask ""+        }  ---------------------------------------------------------------- -data Negotiated = Negotiated {-      tlsHandshakeMode :: HandshakeMode13+data Negotiated = Negotiated+    { tlsHandshakeMode :: HandshakeMode13     , applicationProtocol :: Maybe NegotiatedProtocol     , applicationSecretInfo :: ApplicationSecretInfo     }  initialNegotiated :: Negotiated-initialNegotiated = Negotiated {-      tlsHandshakeMode = FullHandshake-    , applicationProtocol = Nothing-    , applicationSecretInfo = ApplicationSecretInfo defaultTrafficSecrets-    }+initialNegotiated =+    Negotiated+        { tlsHandshakeMode = FullHandshake+        , applicationProtocol = Nothing+        , applicationSecretInfo = ApplicationSecretInfo defaultTrafficSecrets+        }  ---------------------------------------------------------------- -newtype StreamIdBase = StreamIdBase { fromStreamIdBase :: Int }+newtype StreamIdBase = StreamIdBase {fromStreamIdBase :: Int}     deriving (Eq, Show) -data Concurrency = Concurrency {-    currentStream :: StreamId-  , maxStreams    :: StreamIdBase-  }+data Concurrency = Concurrency+    { currentStream :: StreamId+    , maxStreams :: StreamIdBase+    }+    deriving (Show)  newConcurrency :: Role -> Direction -> Int -> Concurrency newConcurrency rl dir n = Concurrency ini $ StreamIdBase n- where-   bidi = dir == Bidirectional-   ini | rl == Client = if bidi then 0 else 2-       | otherwise    = if bidi then 1 else 3+  where+    bidi = dir == Bidirectional+    ini+        | rl == Client = if bidi then 0 else 2+        | otherwise = if bidi then 1 else 3  ---------------------------------------------------------------- @@ -174,81 +189,82 @@ ----------------------------------------------------------------  -- | A quic connection to carry multiple streams.-data Connection = Connection {-    connState         :: ConnState-  -- Actions-  , connDebugLog      :: DebugLogger -- ^ A logger for debugging.-  , connQLog          :: QLogger-  , connHooks         :: Hooks-  , connSend          :: ~Send -- ~ for testing-  , connRecv          :: ~Recv -- ~ for testing-  -- Manage-  , connRecvQ         :: RecvQ-  , udpSocket         :: ~(IORef UDPSocket)-  , readers           :: IORef (IO ())-  , mainThreadId      :: ThreadId-  -- Info-  , roleInfo          :: IORef RoleInfo-  , quicVersionInfo   :: IORef VersionInfo-  , origVersionInfo   :: VersionInfo -- chosenVersion is client's ver in Initial-  -- Mine-  , myParameters      :: Parameters-  , myCIDDB           :: IORef CIDDB-  -- Peer-  , peerParameters    :: IORef Parameters-  , peerCIDDB         :: TVar CIDDB-  -- Queues-  , inputQ            :: InputQ-  , cryptoQ           :: CryptoQ-  , outputQ           :: OutputQ-  , migrationQ        :: MigrationQ-  , shared            :: Shared-  , delayedAckCount   :: IORef Int-  , delayedAckCancel  :: IORef (IO ())-  -- State-  , peerPacketNumber  :: IORef PacketNumber      -- for RTT1-  , streamTable       :: IORef StreamTable-  , myStreamId        :: TVar Concurrency  -- C:0 S:1-  , myUniStreamId     :: TVar Concurrency  -- C:2 S:3-  , peerStreamId      :: IORef Concurrency -- C:1 S:0-  , peerUniStreamId   :: IORef Concurrency -- C:3 S:2-  , flowTx            :: TVar Flow-  , flowRx            :: IORef Flow-  , flowBytesRx       :: IORef Int-  , migrationState    :: TVar MigrationState-  , minIdleTimeout    :: IORef Microseconds-  , bytesTx           :: TVar Int -- TVar for anti amplification-  , bytesRx           :: TVar Int -- TVar for anti amplification-  , addressValidated  :: TVar Bool-  -- TLS-  , pendingQ          :: Array   EncryptionLevel (TVar [ReceivedPacket])-  , ciphers           :: IOArray EncryptionLevel Cipher-  , coders            :: IOArray EncryptionLevel Coder-  , coders1RTT        :: IOArray Bool            Coder1RTT-  , protectors        :: IOArray EncryptionLevel Protector-  , currentKeyPhase   :: IORef (Bool, PacketNumber)-  , negotiated        :: IORef Negotiated-  , connMyAuthCIDs    :: IORef AuthCIDs-  , connPeerAuthCIDs  :: IORef AuthCIDs-  -- Resources-  , connResources     :: IORef (IO ())-  , encodeBuf         :: Buffer-  , encryptRes        :: SizedBuffer-  , decryptBuf        :: Buffer-  -- Recovery-  , connLDCC          :: LDCC-  }+data Connection = Connection+    { connState :: ConnState+    , -- Actions+      connDebugLog :: DebugLogger+    -- ^ A logger for debugging.+    , connQLog :: QLogger+    , connHooks :: Hooks+    , connSend :: ~Send -- ~ for testing+    , connRecv :: ~Recv -- ~ for testing+    -- Manage+    , connRecvQ :: RecvQ+    , udpSocket :: ~(IORef UDPSocket)+    , readers :: IORef (IO ())+    , mainThreadId :: ThreadId+    , controlRate :: Rate+    , -- Info+      roleInfo :: IORef RoleInfo+    , quicVersionInfo :: IORef VersionInfo+    , origVersionInfo :: VersionInfo -- chosenVersion is client's ver in Initial+    -- Mine+    , myParameters :: Parameters+    , myCIDDB :: IORef CIDDB+    , -- Peer+      peerParameters :: IORef Parameters+    , peerCIDDB :: TVar CIDDB+    , -- Queues+      inputQ :: InputQ+    , cryptoQ :: CryptoQ+    , outputQ :: OutputQ+    , migrationQ :: MigrationQ+    , shared :: Shared+    , delayedAckCount :: IORef Int+    , delayedAckCancel :: IORef (IO ())+    , -- State+      peerPacketNumber :: IORef PacketNumber -- for RTT1+    , streamTable :: IORef StreamTable+    , myStreamId :: TVar Concurrency -- C:0 S:1+    , myUniStreamId :: TVar Concurrency -- C:2 S:3+    , peerStreamId :: IORef Concurrency -- C:1 S:0+    , peerUniStreamId :: IORef Concurrency -- C:3 S:2+    , flowTx :: TVar TxFlow+    , flowRx :: IORef RxFlow+    , migrationState :: TVar MigrationState+    , minIdleTimeout :: IORef Microseconds+    , bytesTx :: TVar Int -- TVar for anti amplification+    , bytesRx :: TVar Int -- TVar for anti amplification+    , addressValidated :: TVar Bool+    , -- TLS+      pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])+    , ciphers :: IOArray EncryptionLevel Cipher+    , coders :: IOArray EncryptionLevel Coder+    , coders1RTT :: IOArray Bool Coder1RTT+    , protectors :: IOArray EncryptionLevel Protector+    , currentKeyPhase :: IORef (Bool, PacketNumber)+    , negotiated :: IORef Negotiated+    , connMyAuthCIDs :: IORef AuthCIDs+    , connPeerAuthCIDs :: IORef AuthCIDs+    , -- Resources+      connResources :: IORef (IO ())+    , encodeBuf :: Buffer+    , encryptRes :: SizedBuffer+    , decryptBuf :: Buffer+    , -- Recovery+      connLDCC :: LDCC+    }  instance KeepQlog Connection where     keepQlog conn = connQLog conn  instance Connector Connection where-    getRole            = role . connState+    getRole = role . connState     getEncryptionLevel = readTVarIO . encryptionLevel . connState-    getMaxPacketSize   = readIORef  . maxPacketSize   . connState+    getMaxPacketSize = readIORef . maxPacketSize . connState     getConnectionState = readTVarIO . connectionState . connState-    getPacketNumber    = readIORef  . packetNumber    . connState-    getAlive           = readIORef  . connectionAlive . connState+    getPacketNumber = readIORef . packetNumber . connState+    getAlive = readIORef . connectionAlive . connState  setDead :: Connection -> IO () setDead conn = writeIORef (connectionAlive $ connState conn) False@@ -258,30 +274,36 @@     q1 <- newTVarIO []     q2 <- newTVarIO []     q3 <- newTVarIO []-    let lst = [(RTT0Level,q1),(HandshakeLevel,q2),(RTT1Level,q3)]-        arr = array (RTT0Level,RTT1Level) lst+    let lst = [(RTT0Level, q1), (HandshakeLevel, q2), (RTT1Level, q3)]+        arr = array (RTT0Level, RTT1Level) lst     return arr -newConnection :: Role-              -> Parameters-              -> VersionInfo -> AuthCIDs -> AuthCIDs-              -> DebugLogger -> QLogger -> Hooks-              -> IORef UDPSocket-              -> RecvQ-              -> Send-              -> Recv-              -> IO Connection+newConnection+    :: Role+    -> Parameters+    -> VersionInfo+    -> AuthCIDs+    -> AuthCIDs+    -> DebugLogger+    -> QLogger+    -> Hooks+    -> IORef UDPSocket+    -> RecvQ+    -> Send+    -> Recv+    -> IO Connection newConnection rl myparams verInfo myAuthCIDs peerAuthCIDs debugLog qLog hooks sref recvQ ~send ~recv = do     outQ <- newTQueueIO     let put x = atomically $ writeTQueue outQ $ OutRetrans x     connstate <- newConnState rl     let bufsiz = maximumUdpPayloadSize-    encBuf   <- mallocBytes bufsiz+    encBuf <- mallocBytes bufsiz     ecrptBuf <- mallocBytes bufsiz     dcrptBuf <- mallocBytes bufsiz     Connection connstate debugLog qLog hooks send recv recvQ sref         <$> newIORef (return ())         <*> myThreadId+        <*> newRate         -- Info         <*> newIORef initialRoleInfo         <*> newIORef verInfo@@ -303,13 +325,12 @@         -- State         <*> newIORef 0         <*> newIORef emptyStreamTable-        <*> newTVarIO (newConcurrency rl Bidirectional  0)+        <*> newTVarIO (newConcurrency rl Bidirectional 0)         <*> newTVarIO (newConcurrency rl Unidirectional 0)-        <*> newIORef  peerConcurrency-        <*> newIORef  peerUniConcurrency-        <*> newTVarIO defaultFlow-        <*> newIORef defaultFlow { flowMaxData = initialMaxData myparams }-        <*> newIORef 0+        <*> newIORef peerConcurrency+        <*> newIORef peerUniConcurrency+        <*> newTVarIO (newTxFlow 0) -- limit is set in Handshake+        <*> newIORef (newRxFlow $ initialMaxData myparams)         <*> newTVarIO NonMigration         <*> newIORef (milliToMicro $ maxIdleTimeout myparams)         <*> newTVarIO 0@@ -317,17 +338,17 @@         <*> newTVarIO False         -- TLS         <*> makePendingQ-        <*> newArray (InitialLevel,RTT1Level) defaultCipher-        <*> newArray (InitialLevel,HandshakeLevel) initialCoder-        <*> newArray (False,True) initialCoder1RTT-        <*> newArray (InitialLevel,RTT1Level) initialProtector-        <*> newIORef (False,0)+        <*> newArray (InitialLevel, RTT1Level) defaultCipher+        <*> newArray (InitialLevel, HandshakeLevel) initialCoder+        <*> newArray (False, True) initialCoder1RTT+        <*> newArray (InitialLevel, RTT1Level) initialProtector+        <*> newIORef (False, 0)         <*> newIORef initialNegotiated         <*> newIORef myAuthCIDs         <*> newIORef peerAuthCIDs         -- Resources         <*> newIORef (free encBuf >> free ecrptBuf >> free dcrptBuf)-        <*> return encBuf   -- used sender or closere+        <*> return encBuf -- used sender or closere         <*> return (SizedBuffer ecrptBuf bufsiz) -- used sender         <*> return dcrptBuf -- used receiver         -- Recovery@@ -335,12 +356,13 @@   where     isclient = rl == Client     initialRoleInfo-      | isclient  = defaultClientRoleInfo-      | otherwise = defaultServerRoleInfo-    myCID   = fromJust $ initSrcCID myAuthCIDs+        | isclient = defaultClientRoleInfo+        | otherwise = defaultServerRoleInfo+    myCID = fromJust $ initSrcCID myAuthCIDs     peerCID = fromJust $ initSrcCID peerAuthCIDs-    peer | isclient  = Server-         | otherwise = Client+    peer+        | isclient = Server+        | otherwise = Client     peerConcurrency = newConcurrency peer Bidirectional (initialMaxStreamsBidi myparams)     peerUniConcurrency = newConcurrency peer Unidirectional (initialMaxStreamsUni myparams) @@ -349,34 +371,49 @@  ---------------------------------------------------------------- -clientConnection :: ClientConfig-                 -> VersionInfo -> AuthCIDs -> AuthCIDs-                 -> DebugLogger -> QLogger -> Hooks-                 -> IORef UDPSocket-                 -> RecvQ -> Send -> Recv-                 -> IO Connection+clientConnection+    :: ClientConfig+    -> VersionInfo+    -> AuthCIDs+    -> AuthCIDs+    -> DebugLogger+    -> QLogger+    -> Hooks+    -> IORef UDPSocket+    -> RecvQ+    -> Send+    -> Recv+    -> IO Connection clientConnection ClientConfig{..} verInfo myAuthCIDs peerAuthCIDs =     newConnection Client ccParameters verInfo myAuthCIDs peerAuthCIDs -serverConnection :: ServerConfig-                 -> VersionInfo -> AuthCIDs -> AuthCIDs-                 -> DebugLogger -> QLogger -> Hooks-                 -> IORef UDPSocket-                 -> RecvQ -> Send -> Recv-                 -> IO Connection+serverConnection+    :: ServerConfig+    -> VersionInfo+    -> AuthCIDs+    -> AuthCIDs+    -> DebugLogger+    -> QLogger+    -> Hooks+    -> IORef UDPSocket+    -> RecvQ+    -> Send+    -> Recv+    -> IO Connection serverConnection ServerConfig{..} verInfo myAuthCIDs peerAuthCIDs =     newConnection Server scParameters verInfo myAuthCIDs peerAuthCIDs  ---------------------------------------------------------------- -newtype Input = InpStream Stream deriving Show-data   Crypto = InpHandshake EncryptionLevel ByteString deriving Show+newtype Input = InpStream Stream deriving (Show)+data Crypto = InpHandshake EncryptionLevel ByteString deriving (Show) -data Output = OutControl   EncryptionLevel [Frame] (IO ())-            | OutHandshake [(EncryptionLevel,ByteString)]-            | OutRetrans   PlainPacket+data Output+    = OutControl EncryptionLevel [Frame] (IO ())+    | OutHandshake [(EncryptionLevel, ByteString)]+    | OutRetrans PlainPacket -type InputQ  = TQueue Input+type InputQ = TQueue Input type CryptoQ = TQueue Crypto type OutputQ = TQueue Output type MigrationQ = TQueue ReceivedPacket@@ -385,15 +422,17 @@  type SendStreamQ = TQueue TxStreamData -data Shared = Shared {-    sharedCloseSent     :: IORef Bool-  , sharedCloseReceived :: IORef Bool-  , shared1RTTReady     :: IORef Bool-  , sharedSendStreamQ   :: SendStreamQ-  }+data Shared = Shared+    { sharedCloseSent :: IORef Bool+    , sharedCloseReceived :: IORef Bool+    , shared1RTTReady :: IORef Bool+    , sharedSendStreamQ :: SendStreamQ+    }  newShared :: IO Shared-newShared = Shared <$> newIORef False-                   <*> newIORef False-                   <*> newIORef False-                   <*> newTQueueIO+newShared =+    Shared+        <$> newIORef False+        <*> newIORef False+        <*> newIORef False+        <*> newTQueueIO

@@ -5,34 +5,35 @@ import UnliftIO.STM  class Connector a where-    getRole            :: a -> Role+    getRole :: a -> Role     getEncryptionLevel :: a -> IO EncryptionLevel-    getMaxPacketSize   :: a -> IO Int+    getMaxPacketSize :: a -> IO Int     getConnectionState :: a -> IO ConnectionState-    getPacketNumber    :: a -> IO PacketNumber-    getAlive           :: a -> IO Bool+    getPacketNumber :: a -> IO PacketNumber+    getAlive :: a -> IO Bool  ---------------------------------------------------------------- -data ConnState = ConnState {-    role            :: Role-  , connectionState :: TVar ConnectionState-  , packetNumber    :: IORef PacketNumber   -- squeezing three to one-  , encryptionLevel :: TVar EncryptionLevel -- to synchronize-  , maxPacketSize   :: IORef Int-  -- Explicitly separated from 'ConnectionState'-  -- It seems that STM triggers a dead-lock if-  -- it is used in the close function of bracket.-  , connectionAlive :: IORef Bool-  }+data ConnState = ConnState+    { role :: Role+    , connectionState :: TVar ConnectionState+    , packetNumber :: IORef PacketNumber -- squeezing three to one+    , encryptionLevel :: TVar EncryptionLevel -- to synchronize+    , maxPacketSize :: IORef Int+    , -- Explicitly separated from 'ConnectionState'+      -- It seems that STM triggers a dead-lock if+      -- it is used in the close function of bracket.+      connectionAlive :: IORef Bool+    }  newConnState :: Role -> IO ConnState newConnState rl =-    ConnState rl <$> newTVarIO Handshaking-                 <*> newIORef 0-                 <*> newTVarIO InitialLevel-                 <*> newIORef defaultQUICPacketSize-                 <*> newIORef True+    ConnState rl+        <$> newTVarIO Handshaking+        <*> newIORef 0+        <*> newTVarIO InitialLevel+        <*> newIORef defaultQUICPacketSize+        <*> newIORef True  ---------------------------------------------------------------- @@ -46,15 +47,16 @@  ---------------------------------------------------------------- -data ConnectionState = Handshaking-                     | ReadyFor0RTT-                     | ReadyFor1RTT-                     | Established-                     deriving (Eq, Ord, Show)+data ConnectionState+    = Handshaking+    | ReadyFor0RTT+    | ReadyFor1RTT+    | Established+    deriving (Eq, Ord, Show)  isConnectionEstablished :: Connector a => a -> IO Bool isConnectionEstablished conn = do     st <- getConnectionState conn     return $ case st of-      Established -> True-      _           -> False+        Established -> True+        _ -> False

@@ -2,12 +2,12 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.Crypto (-    module Network.QUIC.Crypto.Fusion-  , module Network.QUIC.Crypto.Nite-  , module Network.QUIC.Crypto.Types-  , module Network.QUIC.Crypto.Keys-  , module Network.QUIC.Crypto.Utils-  ) where+    module Network.QUIC.Crypto.Fusion,+    module Network.QUIC.Crypto.Nite,+    module Network.QUIC.Crypto.Types,+    module Network.QUIC.Crypto.Keys,+    module Network.QUIC.Crypto.Utils,+) where  import Network.TLS hiding (Version) import Network.TLS.QUIC

@@ -1,17 +1,17 @@ {-# LANGUAGE CPP #-}  module Network.QUIC.Crypto.Fusion (-    FusionContext-  , fusionNewContext-  , fusionSetup-  , fusionEncrypt-  , fusionDecrypt-  , Supplement-  , fusionSetupSupplement-  , fusionSetSample-  , fusionGetMask-  , isFusionAvailable-  ) where+    FusionContext,+    fusionNewContext,+    fusionSetup,+    fusionEncrypt,+    fusionDecrypt,+    Supplement,+    fusionSetupSupplement,+    fusionSetSample,+    fusionGetMask,+    isFusionAvailable,+) where  #ifdef USE_FUSION import qualified Data.ByteString as BS

@@ -2,15 +2,15 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.Crypto.Keys (-    defaultCipher-  , initialSecrets-  , clientInitialSecret-  , serverInitialSecret-  , aeadKey-  , initialVector-  , nextSecret-  , headerProtectionKey-  ) where+    defaultCipher,+    initialSecrets,+    clientInitialSecret,+    serverInitialSecret,+    aeadKey,+    initialVector,+    nextSecret,+    headerProtectionKey,+) where  import Network.TLS hiding (Version) import Network.TLS.Extra.Cipher@@ -29,9 +29,12 @@ ----------------------------------------------------------------  initialSalt :: Version -> Salt-initialSalt Draft29     = "\xaf\xbf\xec\x28\x99\x93\xd2\x4c\x9e\x97\x86\xf1\x9c\x61\x11\xe0\x43\x90\xa8\x99"-initialSalt Version1    = "\x38\x76\x2c\xf7\xf5\x59\x34\xb3\x4d\x17\x9a\xe6\xa4\xc8\x0c\xad\xcc\xbb\x7f\x0a"-initialSalt Version2    = "\x0d\xed\xe3\xde\xf7\x00\xa6\xdb\x81\x93\x81\xbe\x6e\x26\x9d\xcb\xf9\xbd\x2e\xd9"+initialSalt Draft29 =+    "\xaf\xbf\xec\x28\x99\x93\xd2\x4c\x9e\x97\x86\xf1\x9c\x61\x11\xe0\x43\x90\xa8\x99"+initialSalt Version1 =+    "\x38\x76\x2c\xf7\xf5\x59\x34\xb3\x4d\x17\x9a\xe6\xa4\xc8\x0c\xad\xcc\xbb\x7f\x0a"+initialSalt Version2 =+    "\x0d\xed\xe3\xde\xf7\x00\xa6\xdb\x81\x93\x81\xbe\x6e\x26\x9d\xcb\xf9\xbd\x2e\xd9" initialSalt (Version v) = E.impureThrow $ VersionIsUnknown v  initialSecrets :: Version -> CID -> TrafficSecrets InitialSecret@@ -44,65 +47,65 @@ serverInitialSecret v c = ServerTrafficSecret $ initialSecret v c $ Label "server in"  initialSecret :: Version -> CID -> Label -> ByteString-initialSecret Draft29  = initialSecret' $ initialSalt Draft29+initialSecret Draft29 = initialSecret' $ initialSalt Draft29 initialSecret Version1 = initialSecret' $ initialSalt Version1 initialSecret Version2 = initialSecret' $ initialSalt Version2-initialSecret _        = \_ _ -> "not supported"+initialSecret _ = \_ _ -> "not supported"  initialSecret' :: ByteString -> CID -> Label -> ByteString initialSecret' salt cid (Label label) = secret   where-    cipher    = defaultCipher-    hash      = cipherHash cipher+    cipher = defaultCipher+    hash = cipherHash cipher     iniSecret = hkdfExtract hash salt $ fromCID cid-    hashSize  = hashDigestSize hash-    secret    = hkdfExpandLabel hash iniSecret label "" hashSize+    hashSize = hashDigestSize hash+    secret = hkdfExpandLabel hash iniSecret label "" hashSize  aeadKey :: Version -> Cipher -> Secret -> Key-aeadKey Draft29  = genKey $ Label "quic key"+aeadKey Draft29 = genKey $ Label "quic key" aeadKey Version1 = genKey $ Label "quic key" aeadKey Version2 = genKey $ Label "quicv2 key"-aeadKey _        = genKey $ Label "not supported"+aeadKey _ = genKey $ Label "not supported"  headerProtectionKey :: Version -> Cipher -> Secret -> Key-headerProtectionKey Draft29  = genKey $ Label "quic hp"+headerProtectionKey Draft29 = genKey $ Label "quic hp" headerProtectionKey Version1 = genKey $ Label "quic hp" headerProtectionKey Version2 = genKey $ Label "quicv2 hp"-headerProtectionKey _        = genKey $ Label "not supported"+headerProtectionKey _ = genKey $ Label "not supported"  genKey :: Label -> Cipher -> Secret -> Key genKey (Label label) cipher (Secret secret) = Key key   where-    hash    = cipherHash cipher-    bulk    = cipherBulk cipher+    hash = cipherHash cipher+    bulk = cipherBulk cipher     keySize = bulkKeySize bulk-    key     = hkdfExpandLabel hash secret label "" keySize+    key = hkdfExpandLabel hash secret label "" keySize  initialVector :: Version -> Cipher -> Secret -> IV initialVector ver cipher (Secret secret) = IV iv   where-    label  = ivLabel ver-    hash   = cipherHash cipher-    bulk   = cipherBulk cipher+    label = ivLabel ver+    hash = cipherHash cipher+    bulk = cipherBulk cipher     ivSize = max 8 (bulkIVSize bulk + bulkExplicitIV bulk)-    iv     = hkdfExpandLabel hash secret label "" ivSize+    iv = hkdfExpandLabel hash secret label "" ivSize  ivLabel :: Version -> ByteString-ivLabel Draft29  = "quic iv"+ivLabel Draft29 = "quic iv" ivLabel Version1 = "quic iv" ivLabel Version2 = "quicv2 iv"-ivLabel _        = "not supported"+ivLabel _ = "not supported"  nextSecret :: Version -> Cipher -> Secret -> Secret nextSecret ver cipher (Secret secN) = Secret secN1   where-    label    = kuLabel ver-    hash     = cipherHash cipher+    label = kuLabel ver+    hash = cipherHash cipher     hashSize = hashDigestSize hash-    secN1    = hkdfExpandLabel hash secN label "" hashSize+    secN1 = hkdfExpandLabel hash secN label "" hashSize  kuLabel :: Version -> ByteString-kuLabel Draft29  = "quic ku"+kuLabel Draft29 = "quic ku" kuLabel Version1 = "quic ku" kuLabel Version2 = "quicv2 ku"-kuLabel _        = "not supported"+kuLabel _ = "not supported"

@@ -2,17 +2,17 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Network.QUIC.Crypto.Nite (-    niteEncrypt-  , niteEncrypt'-  , niteDecrypt-  , niteDecrypt'-  , protectionMask-  , aes128gcmEncrypt-  , makeNonce-  , makeNiteEncrypt-  , makeNiteDecrypt-  , makeNiteProtector-  ) where+    niteEncrypt,+    niteEncrypt',+    niteDecrypt,+    niteDecrypt',+    protectionMask,+    aes128gcmEncrypt,+    makeNonce,+    makeNiteEncrypt,+    makeNiteDecrypt,+    makeNiteProtector,+) where  import Crypto.Cipher.AES import Crypto.Cipher.Types hiding (Cipher, IV)@@ -20,10 +20,10 @@ import qualified Data.ByteArray as Byte (convert) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS-import Foreign.ForeignPtr (withForeignPtr, newForeignPtr_)+import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr) import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Marshal.Utils (copyBytes)-import Foreign.Ptr (Ptr, plusPtr, nullPtr)+import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Foreign.Storable (peek, poke) import Network.TLS hiding (Version) import Network.TLS.Extra.Cipher@@ -37,64 +37,70 @@ -- It would be nice to take [PlainText] and update AEAD context with -- [PlainText]. But since each PlainText is not aligned to cipher block, -- it's impossible.-cipherEncrypt :: Cipher -> Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText,CipherText)+cipherEncrypt+    :: Cipher -> Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText) cipherEncrypt cipher-  | cipher == cipher_TLS13_AES128GCM_SHA256        = aes128gcmEncrypt-  | cipher == cipher_TLS13_AES128CCM_SHA256        = error "cipher_TLS13_AES128CCM_SHA256"-  | cipher == cipher_TLS13_AES256GCM_SHA384        = aes256gcmEncrypt-  | otherwise                                      = error "cipherEncrypt"+    | cipher == cipher_TLS13_AES128GCM_SHA256 = aes128gcmEncrypt+    | cipher == cipher_TLS13_AES128CCM_SHA256 =+        error "cipher_TLS13_AES128CCM_SHA256"+    | cipher == cipher_TLS13_AES256GCM_SHA384 = aes256gcmEncrypt+    | otherwise = error "cipherEncrypt" -cipherDecrypt :: Cipher -> Key -> Nonce -> CipherText -> AssDat -> Maybe PlainText+cipherDecrypt+    :: Cipher -> Key -> Nonce -> CipherText -> AssDat -> Maybe PlainText cipherDecrypt cipher-  | cipher == cipher_TLS13_AES128GCM_SHA256        = aes128gcmDecrypt-  | cipher == cipher_TLS13_AES128CCM_SHA256        = error "cipher_TLS13_AES128CCM_SHA256"-  | cipher == cipher_TLS13_AES256GCM_SHA384        = aes256gcmDecrypt-  | otherwise                                      = error "cipherDecrypt"+    | cipher == cipher_TLS13_AES128GCM_SHA256 = aes128gcmDecrypt+    | cipher == cipher_TLS13_AES128CCM_SHA256 =+        error "cipher_TLS13_AES128CCM_SHA256"+    | cipher == cipher_TLS13_AES256GCM_SHA384 = aes256gcmDecrypt+    | otherwise = error "cipherDecrypt"  -- IMPORTANT: Using 'let' so that parameters can be memorized.-aes128gcmEncrypt :: Key -> (Nonce -> PlainText -> AssDat -> Maybe (CipherText,CipherText))+aes128gcmEncrypt+    :: Key -> (Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText)) aes128gcmEncrypt (Key key) = case maybeCryptoError $ cipherInit key of-  Nothing -> \_ _ _  -> Nothing-  Just (aes :: AES128) -> \(Nonce nonce) plaintext (AssDat ad) ->-    case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of-      Nothing -> Nothing-      Just aead ->-          let  (AuthTag tag0, ciphertext) = aeadSimpleEncrypt aead ad plaintext 16-               tag = Byte.convert tag0-          in Just (ciphertext,tag)+    Nothing -> \_ _ _ -> Nothing+    Just (aes :: AES128) -> \(Nonce nonce) plaintext (AssDat ad) ->+        case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of+            Nothing -> Nothing+            Just aead ->+                let (AuthTag tag0, ciphertext) = aeadSimpleEncrypt aead ad plaintext 16+                    tag = Byte.convert tag0+                 in Just (ciphertext, tag)  aes128gcmDecrypt :: Key -> (Nonce -> CipherText -> AssDat -> Maybe PlainText) aes128gcmDecrypt (Key key) = case maybeCryptoError $ cipherInit key of-  Nothing -> \_ _ _  -> Nothing-  Just (aes :: AES128) -> \(Nonce nonce) ciphertag (AssDat ad) ->-    case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of-      Nothing -> Nothing-      Just aead ->-          let (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag-              authtag = AuthTag $ Byte.convert tag-           in aeadSimpleDecrypt aead ad ciphertext authtag+    Nothing -> \_ _ _ -> Nothing+    Just (aes :: AES128) -> \(Nonce nonce) ciphertag (AssDat ad) ->+        case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of+            Nothing -> Nothing+            Just aead ->+                let (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag+                    authtag = AuthTag $ Byte.convert tag+                 in aeadSimpleDecrypt aead ad ciphertext authtag -aes256gcmEncrypt :: Key -> (Nonce -> PlainText -> AssDat -> Maybe (CipherText,CipherText))+aes256gcmEncrypt+    :: Key -> (Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText)) aes256gcmEncrypt (Key key) = case maybeCryptoError $ cipherInit key of-  Nothing -> \_ _ _  -> Nothing-  Just (aes :: AES256) -> \(Nonce nonce) plaintext (AssDat ad) ->-    case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of-      Nothing -> Nothing-      Just aead ->-          let  (AuthTag tag0, ciphertext) = aeadSimpleEncrypt aead ad plaintext 16-               tag = Byte.convert tag0-          in Just (ciphertext,tag)+    Nothing -> \_ _ _ -> Nothing+    Just (aes :: AES256) -> \(Nonce nonce) plaintext (AssDat ad) ->+        case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of+            Nothing -> Nothing+            Just aead ->+                let (AuthTag tag0, ciphertext) = aeadSimpleEncrypt aead ad plaintext 16+                    tag = Byte.convert tag0+                 in Just (ciphertext, tag)  aes256gcmDecrypt :: Key -> (Nonce -> CipherText -> AssDat -> Maybe PlainText) aes256gcmDecrypt (Key key) = case maybeCryptoError $ cipherInit key of-  Nothing -> \_ _ _  -> Nothing-  Just (aes :: AES256) -> \(Nonce nonce) ciphertag (AssDat ad) ->-    case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of-      Nothing -> Nothing-      Just aead ->-          let (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag-              authtag = AuthTag $ Byte.convert tag-           in aeadSimpleDecrypt aead ad ciphertext authtag+    Nothing -> \_ _ _ -> Nothing+    Just (aes :: AES256) -> \(Nonce nonce) ciphertag (AssDat ad) ->+        case maybeCryptoError $ aeadInit AEAD_GCM aes nonce of+            Nothing -> Nothing+            Just aead ->+                let (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag+                    authtag = AuthTag $ Byte.convert tag+                 in aeadSimpleDecrypt aead ad ciphertext authtag  ---------------------------------------------------------------- @@ -112,15 +118,15 @@ -- Nonce       +IIIIIIIIIIIIIIIIII--------+ bsXORpad :: ByteString -> ByteString -> ByteString bsXORpad (PS fp0 off0 len0) (PS fp1 off1 len1)-  | len0 < len1 = error "bsXORpad"-  | otherwise = BS.unsafeCreate len0 $ \dst ->-  withForeignPtr fp0 $ \p0 ->-    withForeignPtr fp1 $ \p1 -> do-        let src0 = p0 `plusPtr` off0-        let src1 = p1 `plusPtr` off1-        let diff = len0 - len1-        copyBytes dst src0 diff-        loop (dst `plusPtr` diff) (src0 `plusPtr` diff) src1 len1+    | len0 < len1 = error "bsXORpad"+    | otherwise = BS.unsafeCreate len0 $ \dst ->+        withForeignPtr fp0 $ \p0 ->+            withForeignPtr fp1 $ \p1 -> do+                let src0 = p0 `plusPtr` off0+                let src1 = p1 `plusPtr` off1+                let diff = len0 - len1+                copyBytes dst src0 diff+                loop (dst `plusPtr` diff) (src0 `plusPtr` diff) src1 len1   where     loop :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()     loop _ _ _ 0 = return ()@@ -146,25 +152,35 @@ makeNiteEncrypt :: Cipher -> Key -> IV -> NiteEncrypt makeNiteEncrypt cipher key iv = niteEncryptWrapper (niteEncrypt cipher key iv) -niteEncryptWrapper :: (PlainText -> AssDat -> PacketNumber -> Maybe (CipherText,CipherText)) -> NiteEncrypt+niteEncryptWrapper+    :: (PlainText -> AssDat -> PacketNumber -> Maybe (CipherText, CipherText))+    -> NiteEncrypt niteEncryptWrapper enc dst plaintext ad pn = case enc plaintext ad pn of     Nothing -> return (-1)-    Just (hdr,bdy) -> do+    Just (hdr, bdy) -> do         len <- copyBS dst hdr         let dst' = dst `plusPtr` len         len' <- copyBS dst' bdy         return (len + len') -niteEncrypt :: Cipher -> Key -> IV-             -> PlainText -> AssDat -> PacketNumber -> Maybe (CipherText,CipherText)+niteEncrypt+    :: Cipher+    -> Key+    -> IV+    -> PlainText+    -> AssDat+    -> PacketNumber+    -> Maybe (CipherText, CipherText) niteEncrypt cipher key iv =     let enc = cipherEncrypt cipher key-        mk  = makeNonce iv-    in \plaintext header pn -> let bytePN = bytestring64 $ fromIntegral pn-                                   nonce  = mk bytePN-                               in enc nonce plaintext header+        mk = makeNonce iv+     in \plaintext header pn ->+            let bytePN = bytestring64 $ fromIntegral pn+                nonce = mk bytePN+             in enc nonce plaintext header -niteEncrypt' :: Cipher -> Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText,CipherText)+niteEncrypt'+    :: Cipher -> Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText) niteEncrypt' cipher key nonce plaintext header =     cipherEncrypt cipher key nonce plaintext header @@ -175,21 +191,30 @@ makeNiteDecrypt :: Cipher -> Key -> IV -> NiteDecrypt makeNiteDecrypt cipher key iv = niteDecryptWrapper (niteDecrypt cipher key iv) -niteDecryptWrapper :: (CipherText -> AssDat -> PacketNumber -> Maybe PlainText) -> NiteDecrypt+niteDecryptWrapper+    :: (CipherText -> AssDat -> PacketNumber -> Maybe PlainText) -> NiteDecrypt niteDecryptWrapper dec dst ciphertext ad pn = case dec ciphertext ad pn of-  Nothing -> return (-1)-  Just bs -> copyBS dst bs+    Nothing -> return (-1)+    Just bs -> copyBS dst bs -niteDecrypt :: Cipher -> Key -> IV-            -> CipherText -> AssDat -> PacketNumber -> Maybe PlainText+niteDecrypt+    :: Cipher+    -> Key+    -> IV+    -> CipherText+    -> AssDat+    -> PacketNumber+    -> Maybe PlainText niteDecrypt cipher key iv =     let dec = cipherDecrypt cipher key-        mk  = makeNonce iv-    in \ciphertext header pn -> let bytePN = bytestring64 (fromIntegral pn)-                                    nonce = mk bytePN-                                in dec nonce ciphertext header+        mk = makeNonce iv+     in \ciphertext header pn ->+            let bytePN = bytestring64 (fromIntegral pn)+                nonce = mk bytePN+             in dec nonce ciphertext header -niteDecrypt' :: Cipher -> Key -> Nonce -> CipherText -> AssDat -> Maybe PlainText+niteDecrypt'+    :: Cipher -> Key -> Nonce -> CipherText -> AssDat -> Maybe PlainText niteDecrypt' cipher key nonce ciphertext header =     cipherDecrypt cipher key nonce ciphertext header @@ -198,30 +223,34 @@ protectionMask :: Cipher -> Key -> (Sample -> Mask) protectionMask cipher key =     let f = cipherHeaderProtection cipher key-    in \sample -> f sample+     in \sample -> f sample  cipherHeaderProtection :: Cipher -> Key -> (Sample -> Mask) cipherHeaderProtection cipher key-  | cipher == cipher_TLS13_AES128GCM_SHA256        = aes128ecbEncrypt key-  | cipher == cipher_TLS13_AES128CCM_SHA256        = error "cipher_TLS13_AES128CCM_SHA256"-  | cipher == cipher_TLS13_AES256GCM_SHA384        = aes256ecbEncrypt key-  | otherwise                                      = error "cipherHeaderProtection"+    | cipher == cipher_TLS13_AES128GCM_SHA256 = aes128ecbEncrypt key+    | cipher == cipher_TLS13_AES128CCM_SHA256 =+        error "cipher_TLS13_AES128CCM_SHA256"+    | cipher == cipher_TLS13_AES256GCM_SHA384 = aes256ecbEncrypt key+    | otherwise =+        error "cipherHeaderProtection"  aes128ecbEncrypt :: Key -> (Sample -> Mask) aes128ecbEncrypt (Key key) = case maybeCryptoError $ cipherInit key of-  Nothing -> \_ -> Mask "0123456789012345"-  Just (aes :: AES128) ->-    let encrypt = ecbEncrypt aes-    in \(Sample sample) -> let mask = encrypt sample-                           in Mask mask+    Nothing -> \_ -> Mask "0123456789012345"+    Just (aes :: AES128) ->+        let encrypt = ecbEncrypt aes+         in \(Sample sample) ->+                let mask = encrypt sample+                 in Mask mask  aes256ecbEncrypt :: Key -> (Sample -> Mask) aes256ecbEncrypt (Key key) = case maybeCryptoError $ cipherInit key of-  Nothing -> \_ -> Mask "0123456789012345"-  Just (aes :: AES256) ->-    let encrypt = ecbEncrypt aes-    in \(Sample sample) -> let mask = encrypt sample-                           in Mask mask+    Nothing -> \_ -> Mask "0123456789012345"+    Just (aes :: AES256) ->+        let encrypt = ecbEncrypt aes+         in \(Sample sample) ->+                let mask = encrypt sample+                 in Mask mask  ---------------------------------------------------------------- 

@@ -1,23 +1,23 @@ module Network.QUIC.Crypto.Types (-  -- * Types-    PlainText-  , CipherText-  , Key(..)-  , IV(..)-  , CID-  , Secret(..)-  , AssDat(..)-  , Sample(..)-  , Mask(..)-  , Nonce(..)-  , Salt-  , Label(..)-  , Cipher-  , InitialSecret-  , TrafficSecrets-  , ClientTrafficSecret(..)-  , ServerTrafficSecret(..)-  ) where+    -- * Types+    PlainText,+    CipherText,+    Key (..),+    IV (..),+    CID,+    Secret (..),+    AssDat (..),+    Sample (..),+    Mask (..),+    Nonce (..),+    Salt,+    Label (..),+    Cipher,+    InitialSecret,+    TrafficSecrets,+    ClientTrafficSecret (..),+    ServerTrafficSecret (..),+) where  import qualified Data.ByteString.Char8 as C8 import Network.TLS hiding (Version)@@ -28,18 +28,18 @@  ---------------------------------------------------------------- -type PlainText  = ByteString+type PlainText = ByteString type CipherText = ByteString-type Salt       = ByteString+type Salt = ByteString -newtype Key    = Key    ByteString deriving (Eq)-newtype IV     = IV     ByteString deriving (Eq)+newtype Key = Key ByteString deriving (Eq)+newtype IV = IV ByteString deriving (Eq) newtype Secret = Secret ByteString deriving (Eq) newtype AssDat = AssDat ByteString deriving (Eq) newtype Sample = Sample ByteString deriving (Eq)-newtype Mask   = Mask   ByteString deriving (Eq)-newtype Label  = Label  ByteString deriving (Eq)-newtype Nonce  = Nonce  ByteString deriving (Eq)+newtype Mask = Mask ByteString deriving (Eq)+newtype Label = Label ByteString deriving (Eq)+newtype Nonce = Nonce ByteString deriving (Eq)  instance Show Key where     show (Key x) = "Key=" ++ C8.unpack (enc16 x)

@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.Crypto.Utils (-    tagLength-  , sampleLength-  , bsXOR-  , calculateIntegrityTag-  ) where+    tagLength,+    sampleLength,+    bsXOR,+    calculateIntegrityTag,+) where  import qualified Data.ByteArray as Byte (xor) import qualified Data.ByteString as BS@@ -27,35 +27,38 @@  tagLength :: Cipher -> Int tagLength cipher-  | cipher == cipher_TLS13_AES128GCM_SHA256        = 16-  | cipher == cipher_TLS13_AES128CCM_SHA256        = 16-  | cipher == cipher_TLS13_AES256GCM_SHA384        = 16-  | otherwise                                      = error "tagLength"+    | cipher == cipher_TLS13_AES128GCM_SHA256 = 16+    | cipher == cipher_TLS13_AES128CCM_SHA256 = 16+    | cipher == cipher_TLS13_AES256GCM_SHA384 = 16+    | otherwise = error "tagLength"  sampleLength :: Cipher -> Int sampleLength cipher-  | cipher == cipher_TLS13_AES128GCM_SHA256        = 16-  | cipher == cipher_TLS13_AES128CCM_SHA256        = 16-  | cipher == cipher_TLS13_AES256GCM_SHA384        = 16-  | otherwise                                      = error "sampleLength"+    | cipher == cipher_TLS13_AES128GCM_SHA256 = 16+    | cipher == cipher_TLS13_AES128CCM_SHA256 = 16+    | cipher == cipher_TLS13_AES256GCM_SHA384 = 16+    | otherwise = error "sampleLength"  ----------------------------------------------------------------  calculateIntegrityTag :: Version -> CID -> ByteString -> ByteString calculateIntegrityTag ver oCID pseudo0 =     case aes128gcmEncrypt (key ver) (nonce ver) "" (AssDat pseudo) of-      Nothing -> ""-      Just (hdr,bdy) -> hdr `BS.append` bdy+        Nothing -> ""+        Just (hdr, bdy) -> hdr `BS.append` bdy   where     (ocid, ocidlen) = unpackCID oCID-    pseudo = BS.concat [BS.singleton ocidlen-                       ,Short.fromShort ocid-                       ,pseudo0]-    key Draft29  = Key "\xcc\xce\x18\x7e\xd0\x9a\x09\xd0\x57\x28\x15\x5a\x6c\xb9\x6b\xe1"+    pseudo =+        BS.concat+            [ BS.singleton ocidlen+            , Short.fromShort ocid+            , pseudo0+            ]+    key Draft29 = Key "\xcc\xce\x18\x7e\xd0\x9a\x09\xd0\x57\x28\x15\x5a\x6c\xb9\x6b\xe1"     key Version1 = Key "\xbe\x0c\x69\x0b\x9f\x66\x57\x5a\x1d\x76\x6b\x54\xe3\x68\xc8\x4e"     key Version2 = Key "\x8f\xb4\xb0\x1b\x56\xac\x48\xe2\x60\xfb\xcb\xce\xad\x7c\xcc\x92"-    key _        = Key "not supported"-    nonce Draft29  = Nonce "\xe5\x49\x30\xf9\x7f\x21\x36\xf0\x53\x0a\x8c\x1c"+    key _ = Key "not supported"+    nonce Draft29 = Nonce "\xe5\x49\x30\xf9\x7f\x21\x36\xf0\x53\x0a\x8c\x1c"     nonce Version1 = Nonce "\x46\x15\x99\xd3\x5d\x63\x2b\xf2\x23\x98\x25\xbb"     nonce Version2 = Nonce "\xd8\x69\x69\xbc\x2d\x7c\x6d\x99\x90\xef\xb0\x4a"-    nonce _        = Nonce "not supported"+    nonce _ = Nonce "not supported"

@@ -1,13 +1,14 @@ {-# LANGUAGE CPP #-}+ module Network.QUIC.Event (-    getSystemTimerManager-  , registerTimeout-  , unregisterTimeout-  , updateTimeout-  , TimerManager-  , TimeoutCallback-  , TimeoutKey-  ) where+    getSystemTimerManager,+    registerTimeout,+    unregisterTimeout,+    updateTimeout,+    TimerManager,+    TimeoutCallback,+    TimeoutKey,+) where #if defined(mingw32_HOST_OS) import GHC.Event.Windows 

@@ -1,9 +1,9 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Network.QUIC.Exception (-    handleLogT-  , handleLogUnit-  ) where+    handleLogT,+    handleLogUnit,+) where  import qualified GHC.IO.Exception as E import qualified System.IO.Error as E@@ -17,11 +17,11 @@   where     handler :: E.SomeException -> IO ()     handler se = case E.fromException se of-      -- threadWait: invalid argument (Bad file descriptor)-      Just e | E.ioeGetErrorType e == E.InvalidArgument -> return ()-      -- recvBuf: does not exist (Connection refused)-      Just e | E.ioeGetErrorType e == E.NoSuchThing     -> return ()-      _                                                 -> logAction $ bhow se+        -- threadWait: invalid argument (Bad file descriptor)+        Just e | E.ioeGetErrorType e == E.InvalidArgument -> return ()+        -- recvBuf: does not exist (Connection refused)+        Just e | E.ioeGetErrorType e == E.NoSuchThing -> return ()+        _ -> logAction $ bhow se  -- Log and throw an exception handleLogT :: DebugLogger -> IO a -> IO a

@@ -3,13 +3,13 @@ module Network.QUIC.IO where  import qualified Data.ByteString as BS+import Network.Control import qualified UnliftIO.Exception as E import UnliftIO.STM  import Network.QUIC.Connection import Network.QUIC.Connector import Network.QUIC.Imports-import Network.QUIC.Parameters import Network.QUIC.Stream import Network.QUIC.Types @@ -33,10 +33,11 @@  ---------------------------------------------------------------- -data Blocked = BothBlocked Stream Int Int-             | ConnBlocked Int-             | StrmBlocked Stream Int-             deriving Show+data Blocked+    = BothBlocked Stream Int Int+    | ConnBlocked Int+    | StrmBlocked Stream Int+    deriving (Show)  addTx :: Connection -> Stream -> Int -> IO () addTx conn s len = atomically $ do@@ -45,19 +46,19 @@  -- | Sending a list of data in the stream. sendStreamMany :: Stream -> [ByteString] -> IO ()-sendStreamMany _   [] = return ()+sendStreamMany _ [] = return () sendStreamMany s dats0 = do     sclosed <- isTxStreamClosed s     when sclosed $ E.throwIO StreamIsClosed     -- fixme: size check for 0RTT     let len = totalLen dats0     ready <- isConnection1RTTReady conn-    if not ready then do-        -- 0-RTT-        putSendStreamQ conn $ TxStreamData s dats0 len False-        addTx conn s len-      else-        flowControl dats0 len False+    if not ready+        then do+            -- 0-RTT+            putSendStreamQ conn $ TxStreamData s dats0 len False+            addTx conn s len+        else flowControl dats0 len False   where     conn = streamConnection s     flowControl dats len wait = do@@ -66,36 +67,37 @@         -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit         eblocked <- checkBlocked s len wait         case eblocked of-          Right n-            | len == n  -> do-                  putSendStreamQ conn $ TxStreamData s dats len False-                  addTx conn s n-            | otherwise -> do-                  let (dats1,dats2) = split n dats-                  putSendStreamQ conn $ TxStreamData s dats1 n False-                  addTx conn s n-                  flowControl dats2 (len - n) False-          Left blocked  -> do-              -- fixme: RTT0Level?-              sendBlocked conn RTT1Level blocked-              flowControl dats len True+            Right n+                | len == n -> do+                    putSendStreamQ conn $ TxStreamData s dats len False+                    addTx conn s n+                | otherwise -> do+                    let (dats1, dats2) = split n dats+                    putSendStreamQ conn $ TxStreamData s dats1 n False+                    addTx conn s n+                    flowControl dats2 (len - n) False+            Left blocked -> do+                -- fixme: RTT0Level?+                sendBlocked conn RTT1Level blocked+                flowControl dats len True  sendBlocked :: Connection -> EncryptionLevel -> Blocked -> IO () sendBlocked conn lvl blocked = sendFrames conn lvl frames   where     frames = case blocked of-      StrmBlocked strm n   -> [StreamDataBlocked (streamId strm) n]-      ConnBlocked n        -> [DataBlocked n]-      BothBlocked strm n m -> [StreamDataBlocked (streamId strm) n, DataBlocked m]+        StrmBlocked strm n -> [StreamDataBlocked (streamId strm) n]+        ConnBlocked n -> [DataBlocked n]+        BothBlocked strm n m -> [StreamDataBlocked (streamId strm) n, DataBlocked m] -split :: Int -> [BS.ByteString] -> ([BS.ByteString],[BS.ByteString])+split :: Int -> [BS.ByteString] -> ([BS.ByteString], [BS.ByteString]) split n0 dats0 = loop n0 dats0 id   where-    loop 0 bss      build = (build [], bss)-    loop _ []       build = (build [], [])-    loop n (bs:bss) build = case len `compare` n of-        GT -> let (bs1,bs2) = BS.splitAt n bs-              in (build [bs1], bs2:bss)+    loop 0 bss build = (build [], bss)+    loop _ [] build = (build [], [])+    loop n (bs : bss) build = case len `compare` n of+        GT ->+            let (bs1, bs2) = BS.splitAt n bs+             in (build [bs1], bs2 : bss)         EQ -> (build [bs], bss)         LT -> loop (n - len) bss (build . (bs :))       where@@ -106,21 +108,21 @@     let conn = streamConnection s     strmFlow <- readStreamFlowTx s     connFlow <- readConnectionFlowTx conn-    let strmWindow = flowWindow strmFlow-        connWindow = flowWindow connFlow+    let strmWindow = txWindowSize strmFlow+        connWindow = txWindowSize connFlow         minFlow = min strmWindow connWindow         n = min len minFlow     when wait $ checkSTM (n > 0)-    if n > 0 then-        return $ Right n-      else do-        let cs = len > strmWindow-            cw = len > connWindow-            blocked-              | cs && cw  = BothBlocked s (flowMaxData strmFlow) (flowMaxData connFlow)-              | cs        = StrmBlocked s (flowMaxData strmFlow)-              | otherwise = ConnBlocked (flowMaxData connFlow)-        return $ Left blocked+    if n > 0+        then return $ Right n+        else do+            let cs = len > strmWindow+                cw = len > connWindow+                blocked+                    | cs && cw = BothBlocked s (txfLimit strmFlow) (txfLimit connFlow)+                    | cs = StrmBlocked s (txfLimit strmFlow)+                    | otherwise = ConnBlocked (txfLimit connFlow)+            return $ Left blocked  ---------------------------------------------------------------- @@ -147,23 +149,29 @@         putSendStreamQ conn $ TxStreamData s [] 0 True         waitFinTx s     delStream conn s-    when ((isClient conn && isServerInitiatedBidirectional sid)-       || (isServer conn && isClientInitiatedBidirectional sid)) $ do-        -- FLOW CONTROL: MAX_STREAMS: recv: announcing my limit properly-        checkMaxStreams conn Bidirectional-    when ((isClient conn && isServerInitiatedUnidirectional sid)-       || (isServer conn && isClientInitiatedUnidirectional sid)) $ do-        -- FLOW CONTROL: MAX_STREAMS: recv: announcing my limit properly-        checkMaxStreams conn Unidirectional+    when+        ( (isClient conn && isServerInitiatedBidirectional sid)+            || (isServer conn && isClientInitiatedBidirectional sid)+        )+        $ do+            -- FLOW CONTROL: MAX_STREAMS: recv: announcing my limit properly+            checkMaxStreams conn Bidirectional+    when+        ( (isClient conn && isServerInitiatedUnidirectional sid)+            || (isServer conn && isClientInitiatedUnidirectional sid)+        )+        $ do+            -- FLOW CONTROL: MAX_STREAMS: recv: announcing my limit properly+            checkMaxStreams conn Unidirectional   where     checkMaxStreams conn dir = do         mx <- checkStreamIdRoom conn dir         case mx of-          Nothing -> return ()-          Just nms -> do-            sendFrames conn RTT1Level [MaxStreams dir nms]-            fire conn (Microseconds 50000) $+            Nothing -> return ()+            Just nms -> do                 sendFrames conn RTT1Level [MaxStreams dir nms]+                fire conn (Microseconds 50000) $+                    sendFrames conn RTT1Level [MaxStreams dir nms]  -- | Accepting a stream initiated by the peer. acceptStream :: Connection -> IO Stream@@ -177,23 +185,17 @@ recvStream s n = do     bs <- takeRecvStreamQwithSize s n     let len = BS.length bs+        sid = streamId s         conn = streamConnection s-    addRxStreamData s len-    addRxData conn len-    window <- getRxStreamWindow s-    let sid = streamId s-        initialWindow = initialRxMaxStreamData conn sid     -- FLOW CONTROL: MAX_STREAM_DATA: recv: announcing my limit properly-    when (window <= (initialWindow !>>. 1)) $ do-        newMax <- addRxMaxStreamData s initialWindow+    mxs <- updateStreamFlowRx s len+    forM_ mxs $ \newMax -> do         sendFrames conn RTT1Level [MaxStreamData sid newMax]         fire conn (Microseconds 50000) $             sendFrames conn RTT1Level [MaxStreamData sid newMax]     -- FLOW CONTROL: MAX_DATA: recv: announcing my limit properly-    cwindow <- getRxDataWindow conn-    let cinitialWindow = initialMaxData $ getMyParameters conn-    when (cwindow <= (cinitialWindow !>>. 1)) $ do-        newMax <- addRxMaxData conn cinitialWindow+    mxc <- updateFlowRx conn len+    forM_ mxc $ \newMax -> do         sendFrames conn RTT1Level [MaxData newMax]         fire conn (Microseconds 50000) $             sendFrames conn RTT1Level [MaxData newMax]

@@ -5,8 +5,8 @@  import qualified Data.ByteString.Char8 as C8 import qualified Network.Socket as NS-import Network.TLS hiding (Version, HandshakeFailed)-import Network.UDP (UDPSocket(..))+import Network.TLS hiding (HandshakeFailed, Version)+import Network.UDP (UDPSocket (..))  import Network.QUIC.Connection import Network.QUIC.Imports@@ -15,67 +15,86 @@ ----------------------------------------------------------------  -- | 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-  }+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     UDPSocket{..} <- getSocket conn     mysa <- NS.getSocketName udpSocket-    mycid   <- getMyCID conn+    mycid <- getMyCID conn     peercid <- getPeerCID conn     c <- getCipher conn RTT1Level     mproto <- getApplicationProtocol conn     mode <- getTLSMode conn     r <- getRetried conn     v <- getVersion conn-    return ConnectionInfo {-        version = v-      , cipher = c-      , alpn = mproto-      , handshakeMode = mode-      , retry = r-      , localSockAddr  = mysa-      , remoteSockAddr = peerSockAddr-      , localCID  = mycid-      , remoteCID = peercid-      }+    return+        ConnectionInfo+            { version = v+            , cipher = c+            , alpn = mproto+            , handshakeMode = mode+            , retry = r+            , localSockAddr = mysa+            , remoteSockAddr = peerSockAddr+            , 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 ""+    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 ""  ----------------------------------------------------------------  -- | Statistics of a connection.-data ConnectionStats = ConnectionStats {-    txBytes :: Int-  , rxBytes :: Int-  } deriving (Eq, Show)+data ConnectionStats = ConnectionStats+    { txBytes :: Int+    , rxBytes :: Int+    }+    deriving (Eq, Show)  -- | Getting statistics of a connection. getConnectionStats :: Connection -> IO ConnectionStats getConnectionStats conn = do     tx <- getTxBytes conn     rx <- getRxBytes conn-    return $ ConnectionStats {-        txBytes = tx-      , rxBytes = rx-      }+    return $+        ConnectionStats+            { txBytes = tx+            , rxBytes = rx+            }

@@ -1,22 +1,22 @@ module Network.QUIC.Internal (-    module Network.QUIC.Config-  , module Network.QUIC.Connection-  , module Network.QUIC.Connector-  , module Network.QUIC.Crypto-  , module Network.QUIC.Logger-  , module Network.QUIC.Packet-  , module Network.QUIC.Parameters-  , module Network.QUIC.Qlog-  , module Network.QUIC.Stream-  , module Network.QUIC.TLS-  , module Network.QUIC.Types-  , module Network.QUIC.Utils-  , module Network.QUIC.Recovery-  , module Network.QUIC.Client.Reader-  , module Network.QUIC.Windows-  ) where+    module Network.QUIC.Config,+    module Network.QUIC.Connection,+    module Network.QUIC.Connector,+    module Network.QUIC.Crypto,+    module Network.QUIC.Logger,+    module Network.QUIC.Packet,+    module Network.QUIC.Parameters,+    module Network.QUIC.Qlog,+    module Network.QUIC.Stream,+    module Network.QUIC.TLS,+    module Network.QUIC.Types,+    module Network.QUIC.Utils,+    module Network.QUIC.Recovery,+    module Network.QUIC.Client.Reader,+    module Network.QUIC.Windows,+) where -import Network.QUIC.Client.Reader (controlConnection,ConnectionControl(..))+import Network.QUIC.Client.Reader (ConnectionControl (..), controlConnection) import Network.QUIC.Config import Network.QUIC.Connection import Network.QUIC.Connector

@@ -1,18 +1,18 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.Logger (-    Builder-  , DebugLogger-  , bhow-  , stdoutLogger-  , dirDebugLogger-  ) where+    Builder,+    DebugLogger,+    bhow,+    stdoutLogger,+    dirDebugLogger,+) where -import System.FilePath-import System.Log.FastLogger import Data.ByteString.Builder (byteString, toLazyByteString) import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy.Char8 as BL+import System.FilePath+import System.Log.FastLogger  import Network.QUIC.Imports import Network.QUIC.Types

@@ -1,39 +1,43 @@ module Network.QUIC.Packet (-  -- * Encode-    encodeVersionNegotiationPacket-  , encodeRetryPacket-  , encodePlainPacket-  -- * Decode-  , decodePacket-  , decodePackets-  , decodeCryptPackets-  , decryptCrypt-  , decodeStatelessResetToken-  -- * Frame-  , encodeFrames-  , decodeFramesBuffer-  , decodeFramesBS-  , countZero -- testing-  -- * Header-  , isLong-  , isShort-  , protectFlags-  , unprotectFlags-  , encodeLongHeaderFlags-  , encodeShortHeaderFlags-  , decodeLongHeaderPacketType-  , encodePktNumLength-  , decodePktNumLength-  , versionNegotiationPacketType-  , retryPacketType-  -- * Token-  , CryptoToken(..)-  , isRetryToken-  , generateToken-  , generateRetryToken-  , encryptToken-  , decryptToken-  ) where+    -- * Encode+    encodeVersionNegotiationPacket,+    encodeRetryPacket,+    encodePlainPacket,++    -- * Decode+    decodePacket,+    decodePackets,+    decodeCryptPackets,+    decryptCrypt,+    decodeStatelessResetToken,++    -- * Frame+    encodeFrames,+    decodeFramesBuffer,+    decodeFramesBS,+    countZero, -- testing++    -- * Header+    isLong,+    isShort,+    protectFlags,+    unprotectFlags,+    encodeLongHeaderFlags,+    encodeShortHeaderFlags,+    decodeLongHeaderPacketType,+    encodePktNumLength,+    decodePktNumLength,+    versionNegotiationPacketType,+    retryPacketType,++    -- * Token+    CryptoToken (..),+    isRetryToken,+    generateToken,+    generateRetryToken,+    encryptToken,+    decryptToken,+) where  import Network.QUIC.Packet.Decode import Network.QUIC.Packet.Decrypt

@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.Packet.Decode (-    decodePacket-  , decodePackets-  , decodeCryptPackets-  , decodeStatelessResetToken-  ) where+    decodePacket,+    decodePackets,+    decodeCryptPackets,+    decodeStatelessResetToken,+) where  import qualified Data.ByteString as BS import qualified Data.ByteString.Short as Short@@ -18,12 +18,12 @@ ----------------------------------------------------------------  -- Server uses this.-decodeCryptPackets :: ByteString -> IO [(CryptPacket,EncryptionLevel,Int)]+decodeCryptPackets :: ByteString -> IO [(CryptPacket, EncryptionLevel, Int)] decodeCryptPackets bs0 = unwrap <$> decodePackets bs0   where-    unwrap (PacketIC c l s:xs) = (c,l,s) : unwrap xs-    unwrap (_:xs)              = unwrap xs-    unwrap []                  = []+    unwrap (PacketIC c l s : xs) = (c, l, s) : unwrap xs+    unwrap (_ : xs) = unwrap xs+    unwrap [] = []  -- Client uses this. decodePackets :: ByteString -> IO [PacketI]@@ -52,29 +52,29 @@     decode rbuf proFlags False = do         (ver, dCID, sCID) <- decodeLongHeader rbuf         case ver of-          Negotiation      -> do-              decodeVersionNegotiationPacket rbuf dCID sCID-          _                -> case decodeLongHeaderPacketType ver proFlags of-            RetryPacketType     -> do-                decodeRetryPacket rbuf proFlags ver dCID sCID-            RTT0PacketType      -> do-                let header = RTT0 ver dCID sCID-                cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf-                siz <- savingSize rbuf-                return $ PacketIC cpkt RTT0Level siz-            InitialPacketType   -> do-                tokenLen <- fromIntegral <$> decodeInt' rbuf-                token <- extractByteString rbuf tokenLen-                let header = Initial ver dCID sCID token-                cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf-                siz <- savingSize rbuf-                return $ PacketIC cpkt InitialLevel siz-            HandshakePacketType -> do-                let header = Handshake ver dCID sCID-                crypt <- CryptPacket header <$> makeLongCrypt bs rbuf-                siz <- savingSize rbuf-                return $ PacketIC crypt HandshakeLevel siz-    handler BufferOverrun = return (PacketIB BrokenPacket,"")+            Negotiation -> do+                decodeVersionNegotiationPacket rbuf dCID sCID+            _ -> case decodeLongHeaderPacketType ver proFlags of+                RetryPacketType -> do+                    decodeRetryPacket rbuf proFlags ver dCID sCID+                RTT0PacketType -> do+                    let header = RTT0 ver dCID sCID+                    cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf+                    siz <- savingSize rbuf+                    return $ PacketIC cpkt RTT0Level siz+                InitialPacketType -> do+                    tokenLen <- fromIntegral <$> decodeInt' rbuf+                    token <- extractByteString rbuf tokenLen+                    let header = Initial ver dCID sCID token+                    cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf+                    siz <- savingSize rbuf+                    return $ PacketIC cpkt InitialLevel siz+                HandshakePacketType -> do+                    let header = Handshake ver dCID sCID+                    crypt <- CryptPacket header <$> makeLongCrypt bs rbuf+                    siz <- savingSize rbuf+                    return $ PacketIC crypt HandshakeLevel siz+    handler BufferOverrun = return (PacketIB BrokenPacket, "")  makeShortCrypt :: ByteString -> ReadBuffer -> IO Crypt makeShortCrypt bs rbuf = do@@ -94,12 +94,12 @@ ----------------------------------------------------------------  decodeLongHeader :: ReadBuffer -> IO (Version, CID, CID)-decodeLongHeader rbuf  = do-    ver     <- Version <$> read32 rbuf+decodeLongHeader rbuf = do+    ver <- Version <$> read32 rbuf     dcidlen <- fromIntegral <$> read8 rbuf-    dCID    <- makeCID <$> extractShortByteString rbuf dcidlen+    dCID <- makeCID <$> extractShortByteString rbuf dcidlen     scidlen <- fromIntegral <$> read8 rbuf-    sCID    <- makeCID <$> extractShortByteString rbuf scidlen+    sCID <- makeCID <$> extractShortByteString rbuf scidlen     return (ver, dCID, sCID)  decodeVersionNegotiationPacket :: ReadBuffer -> CID -> CID -> IO PacketI@@ -109,26 +109,27 @@     return $ PacketIV $ VersionNegotiationPacket dCID sCID vers   where     decodeVersions siz vers-      | siz >= 4  = do+        | siz >= 4 = do             ver <- Version <$> read32 rbuf             decodeVersions (siz - 4) ((ver :) . vers)-      | otherwise = return $ vers []+        | otherwise = return $ vers [] -decodeRetryPacket :: ReadBuffer -> Flags Protected -> Version -> CID -> CID -> IO PacketI+decodeRetryPacket+    :: ReadBuffer -> Flags Protected -> Version -> CID -> CID -> IO PacketI decodeRetryPacket rbuf _proFlags version dCID sCID = do     rsiz <- remainingSize rbuf     token <- extractByteString rbuf (rsiz - 16)     siz <- savingSize rbuf     pseudo <- extractByteString rbuf $ negate siz     tag <- extractByteString rbuf 16-    return $ PacketIR $ RetryPacket version dCID sCID token (Right (pseudo,tag))+    return $ PacketIR $ RetryPacket version dCID sCID token (Right (pseudo, tag))  ----------------------------------------------------------------  decodeStatelessResetToken :: ByteString -> Maybe StatelessResetToken decodeStatelessResetToken bs-  | len < 21  = Nothing-  | otherwise = Just $ StatelessResetToken $ Short.toShort token+    | len < 21 = Nothing+    | otherwise = Just $ StatelessResetToken $ Short.toShort token   where     len = BS.length bs-    (_,token) = BS.splitAt (len - 16) bs+    (_, token) = BS.splitAt (len - 16) bs

@@ -1,10 +1,10 @@+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ExistentialQuantification #-}  module Network.QUIC.Packet.Decrypt (-    decryptCrypt-  ) where+    decryptCrypt,+) where  import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS@@ -32,40 +32,44 @@         makeMask = unprotect protector         Mask mask = makeMask sample     case BS.uncons mask of-      Nothing -> return Nothing-      Just (mask1,mask2) -> do-        let rawFlags@(Flags flags) = unprotectFlags proFlags mask1-            epnLen = decodePktNumLength rawFlags-            epn = BS.take epnLen $ BS.drop cryptPktNumOffset cryptPacket-            bytePN = bsXOR mask2 epn-            headerLen = cryptPktNumOffset + epnLen-            (proHeader, ciphertext) = BS.splitAt headerLen cryptPacket-        peerPN <- if lvl == RTT1Level then getPeerPacketNumber conn else return 0-        let pn = decodePacketNumber peerPN (toEncodedPacketNumber bytePN) epnLen-        header <- BS.create headerLen $ \p -> do-            void $ copy p proHeader-            poke8 flags p 0-            void $ copy (p `plusPtr` cryptPktNumOffset) $ BS.take epnLen bytePN-        let keyPhase | lvl == RTT1Level = flags `testBit` 2-                     | otherwise        = False-        coder <- getCoder conn lvl keyPhase-        siz <- decrypt coder (decryptBuf conn) ciphertext (AssDat header) pn-        let rrMask | lvl == RTT1Level = 0x18-                   | otherwise        = 0x0c-            marks | flags .&. rrMask == 0 = defaultPlainMarks-                  | otherwise             = setIllegalReservedBits defaultPlainMarks-        if siz < 0 then-            return Nothing-          else do-              mframes <- decodeFramesBuffer (decryptBuf conn) siz-              case mframes of-                Nothing -> do-                    let marks' = setUnknownFrame marks-                    return $ Just $ Plain rawFlags pn [] marks'-                Just frames -> do-                    let marks' | null frames = setNoFrames marks-                               | otherwise   = marks-                    return $ Just $ Plain rawFlags pn frames marks'+        Nothing -> return Nothing+        Just (mask1, mask2) -> do+            let rawFlags@(Flags flags) = unprotectFlags proFlags mask1+                epnLen = decodePktNumLength rawFlags+                epn = BS.take epnLen $ BS.drop cryptPktNumOffset cryptPacket+                bytePN = bsXOR mask2 epn+                headerLen = cryptPktNumOffset + epnLen+                (proHeader, ciphertext) = BS.splitAt headerLen cryptPacket+            peerPN <- if lvl == RTT1Level then getPeerPacketNumber conn else return 0+            let pn = decodePacketNumber peerPN (toEncodedPacketNumber bytePN) epnLen+            header <- BS.create headerLen $ \p -> do+                void $ copy p proHeader+                poke8 flags p 0+                void $ copy (p `plusPtr` cryptPktNumOffset) $ BS.take epnLen bytePN+            let keyPhase+                    | lvl == RTT1Level = flags `testBit` 2+                    | otherwise = False+            coder <- getCoder conn lvl keyPhase+            siz <- decrypt coder (decryptBuf conn) ciphertext (AssDat header) pn+            let rrMask+                    | lvl == RTT1Level = 0x18+                    | otherwise = 0x0c+                marks+                    | flags .&. rrMask == 0 = defaultPlainMarks+                    | otherwise = setIllegalReservedBits defaultPlainMarks+            if siz < 0+                then return Nothing+                else do+                    mframes <- decodeFramesBuffer (decryptBuf conn) siz+                    case mframes of+                        Nothing -> do+                            let marks' = setUnknownFrame marks+                            return $ Just $ Plain rawFlags pn [] marks'+                        Just frames -> do+                            let marks'+                                    | null frames = setNoFrames marks+                                    | otherwise = marks+                            return $ Just $ Plain rawFlags pn frames marks'  toEncodedPacketNumber :: ByteString -> EncodedPacketNumber toEncodedPacketNumber bs = foldl' (\b a -> b * 256 + fromIntegral a) 0 $ BS.unpack bs

@@ -1,11 +1,11 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Packet.Encode (---    encodePacket-    encodeVersionNegotiationPacket-  , encodeRetryPacket-  , encodePlainPacket-  ) where+    --    encodePacket+    encodeVersionNegotiationPacket,+    encodeRetryPacket,+    encodePlainPacket,+) where  import qualified Data.ByteString as BS import Foreign.ForeignPtr@@ -24,6 +24,7 @@ ----------------------------------------------------------------  -- | This is not used internally.+ {- encodePacket :: Connection -> PacketO -> IO [ByteString] encodePacket _    (PacketOV pkt) = (:[]) <$> encodeVersionNegotiationPacket pkt@@ -42,6 +43,7 @@     -- vers     mapM_ (\(Version ver) -> write32 wbuf ver) vers     -- no header protection+    return ()  ---------------------------------------------------------------- @@ -57,8 +59,9 @@     let tag = calculateIntegrityTag ver odCID pseudo0     copyByteString wbuf tag     -- no header protection+    return () -- only for testing-encodeRetryPacket (RetryPacket ver dCID sCID token (Right (_,tag))) = withWriteBuffer maximumQUICHeaderSize $ \wbuf -> do+encodeRetryPacket (RetryPacket ver dCID sCID token (Right (_, tag))) = withWriteBuffer maximumQUICHeaderSize $ \wbuf -> do     save wbuf     Flags flags <- retryPacketType ver     write8 wbuf flags@@ -66,64 +69,112 @@     copyByteString wbuf token     copyByteString wbuf tag     -- no header protection+    return ()  ----------------------------------------------------------------  -- WriteBuffer: protect(header) + encrypt(plain_frames) -- encodeBuf:   plain_frames -encodePlainPacket :: Connection -> SizedBuffer -> PlainPacket -> Maybe Int -> IO (Int,Int)+encodePlainPacket+    :: Connection -> SizedBuffer -> PlainPacket -> Maybe Int -> IO (Int, Int) encodePlainPacket conn (SizedBuffer buf bufsiz) ppkt@(PlainPacket _ plain) mlen = do-    let mlen' | isNoPaddings (plainMarks plain) = Nothing-              | otherwise                       = mlen+    let mlen'+            | isNoPaddings (plainMarks plain) = Nothing+            | otherwise = mlen     wbuf <- newWriteBuffer buf bufsiz     encodePlainPacket' conn wbuf ppkt mlen' -encodePlainPacket' :: Connection -> WriteBuffer -> PlainPacket -> Maybe Int -> IO (Int,Int)+encodePlainPacket'+    :: Connection -> WriteBuffer -> PlainPacket -> Maybe Int -> IO (Int, Int) encodePlainPacket' conn wbuf (PlainPacket (Initial ver dCID sCID token) (Plain flags pn frames _)) mlen = do     headerBeg <- currentOffset wbuf     -- flag ... sCID-    (epn, epnLen) <- encodeLongHeaderPP conn wbuf InitialPacketType ver dCID sCID flags pn+    (epn, epnLen) <-+        encodeLongHeaderPP conn wbuf InitialPacketType ver dCID sCID flags pn     -- token     encodeInt' wbuf $ fromIntegral $ BS.length token     copyByteString wbuf token     -- length .. payload-    protectPayloadHeader conn wbuf frames pn epn epnLen headerBeg mlen InitialLevel False-+    protectPayloadHeader+        conn+        wbuf+        frames+        pn+        epn+        epnLen+        headerBeg+        mlen+        InitialLevel+        False encodePlainPacket' conn wbuf (PlainPacket (RTT0 ver dCID sCID) (Plain flags pn frames _)) mlen = do     headerBeg <- currentOffset wbuf     -- flag ... sCID-    (epn, epnLen) <- encodeLongHeaderPP conn wbuf RTT0PacketType ver dCID sCID flags pn+    (epn, epnLen) <-+        encodeLongHeaderPP conn wbuf RTT0PacketType ver dCID sCID flags pn     -- length .. payload-    protectPayloadHeader conn wbuf frames pn epn epnLen headerBeg mlen RTT0Level False-+    protectPayloadHeader+        conn+        wbuf+        frames+        pn+        epn+        epnLen+        headerBeg+        mlen+        RTT0Level+        False encodePlainPacket' conn wbuf (PlainPacket (Handshake ver dCID sCID) (Plain flags pn frames _)) mlen = do     headerBeg <- currentOffset wbuf     -- flag ... sCID-    (epn, epnLen) <- encodeLongHeaderPP conn wbuf HandshakePacketType ver dCID sCID flags pn+    (epn, epnLen) <-+        encodeLongHeaderPP conn wbuf HandshakePacketType ver dCID sCID flags pn     -- length .. payload-    protectPayloadHeader conn wbuf frames pn epn epnLen headerBeg mlen HandshakeLevel False-+    protectPayloadHeader+        conn+        wbuf+        frames+        pn+        epn+        epnLen+        headerBeg+        mlen+        HandshakeLevel+        False encodePlainPacket' conn wbuf (PlainPacket (Short dCID) (Plain flags pn frames marks)) mlen = do     headerBeg <- currentOffset wbuf     -- flag-    let (epn, epnLen) | is4bytesPN marks = (fromIntegral pn, 4)-                      | otherwise        = encodePacketNumber 0 {- dummy -} pn+    let (epn, epnLen)+            | is4bytesPN marks = (fromIntegral pn, 4)+            | otherwise = encodePacketNumber 0 {- dummy -} pn         pp = encodePktNumLength epnLen     quicBit <- greaseQuicBit <$> getPeerParameters conn-    (keyPhase,_) <- getCurrentKeyPhase conn+    (keyPhase, _) <- getCurrentKeyPhase conn     Flags flags' <- encodeShortHeaderFlags flags pp quicBit keyPhase     write8 wbuf flags'     -- dCID     let (dcid, _) = unpackCID dCID     copyShortByteString wbuf dcid-    protectPayloadHeader conn wbuf frames pn epn epnLen headerBeg mlen RTT1Level keyPhase+    protectPayloadHeader+        conn+        wbuf+        frames+        pn+        epn+        epnLen+        headerBeg+        mlen+        RTT1Level+        keyPhase  ---------------------------------------------------------------- -encodeLongHeader :: WriteBuffer-                 -> Version -> CID -> CID-                 -> IO ()+encodeLongHeader+    :: WriteBuffer+    -> Version+    -> CID+    -> CID+    -> IO () encodeLongHeader wbuf (Version ver) dCID sCID = do     write32 wbuf ver     let (dcid, dcidlen) = unpackCID dCID@@ -135,11 +186,16 @@  ---------------------------------------------------------------- -encodeLongHeaderPP :: Connection -> WriteBuffer-                   -> LongHeaderPacketType -> Version -> CID -> CID-                   -> Flags Raw-                   -> PacketNumber-                   -> IO (EncodedPacketNumber, Int)+encodeLongHeaderPP+    :: Connection+    -> WriteBuffer+    -> LongHeaderPacketType+    -> Version+    -> CID+    -> CID+    -> Flags Raw+    -> PacketNumber+    -> IO (EncodedPacketNumber, Int) encodeLongHeaderPP conn wbuf pkttyp ver dCID sCID flags pn = do     let el@(_, pnLen) = encodePacketNumber 0 {- dummy -} pn         pp = encodePktNumLength pnLen@@ -151,17 +207,28 @@  ---------------------------------------------------------------- -protectPayloadHeader :: Connection -> WriteBuffer -> [Frame] -> PacketNumber -> EncodedPacketNumber -> Int -> Buffer -> Maybe Int -> EncryptionLevel -> Bool -> IO (Int,Int)+protectPayloadHeader+    :: Connection+    -> WriteBuffer+    -> [Frame]+    -> PacketNumber+    -> EncodedPacketNumber+    -> Int+    -> Buffer+    -> Maybe Int+    -> EncryptionLevel+    -> Bool+    -> IO (Int, Int) protectPayloadHeader conn wbuf frames pn epn epnLen headerBeg mlen lvl keyPhase = do     -- Real size is maximumUdpPayloadSize. But smaller is better.-    let encBuf    = encodeBuf conn+    let encBuf = encodeBuf conn         encBufLen = 1500 - 20 - 8     payloadWithoutPaddingSiz <- encodeFramesWithPadding encBuf encBufLen frames     cipher <- getCipher conn lvl     -- before length or packer number     lengthOrPNBeg <- currentOffset wbuf-    (packetLen, headerLen, plainLen, tagLen, padLen)-        <- calcLen cipher lengthOrPNBeg payloadWithoutPaddingSiz+    (packetLen, headerLen, plainLen, tagLen, padLen) <-+        calcLen cipher lengthOrPNBeg payloadWithoutPaddingSiz     when (lvl /= RTT1Level) $ writeLen (epnLen + plainLen + tagLen)     pnBeg <- currentOffset wbuf     writeEpn epnLen@@ -177,28 +244,29 @@     len <- encrypt coder cryptoBeg plaintext (AssDat header) pn     maskBeg <- getMask protector     ---    if len < 0 || maskBeg == nullPtr then-         return (-1, -1)-       else do-          -- protecting header-          protectHeader headerBeg pnBeg epnLen maskBeg-          return (packetLen, padLen)+    if len < 0 || maskBeg == nullPtr+        then return (-1, -1)+        else do+            -- protecting header+            protectHeader headerBeg pnBeg epnLen maskBeg+            return (packetLen, padLen)   where     calcLen cipher lengthOrPNBeg payloadWithoutPaddingSiz = do-        let headerLen = (lengthOrPNBeg `minusPtr` headerBeg)-                      -- length: assuming 2byte length-                      + (if lvl /= RTT1Level then 2 else 0)-                      + epnLen+        let headerLen =+                (lengthOrPNBeg `minusPtr` headerBeg)+                    -- length: assuming 2byte length+                    + (if lvl /= RTT1Level then 2 else 0)+                    + epnLen         let tagLen = tagLength cipher             plainLen = case mlen of-                Nothing          -> payloadWithoutPaddingSiz+                Nothing -> payloadWithoutPaddingSiz                 Just expectedLen -> expectedLen - headerLen - tagLen             packetLen = headerLen + plainLen + tagLen             padLen = plainLen - payloadWithoutPaddingSiz         return (packetLen, headerLen, plainLen, tagLen, padLen)     -- length: assuming 2byte length     writeLen len = encodeInt'2 wbuf $ fromIntegral len-    writeEpn 1 = write8  wbuf $ fromIntegral epn+    writeEpn 1 = write8 wbuf $ fromIntegral epn     writeEpn 2 = write16 wbuf $ fromIntegral epn     writeEpn 3 = write24 wbuf epn     writeEpn _ = write32 wbuf epn

@@ -1,17 +1,17 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.Packet.Frame (-    encodeFrames-  , encodeFramesWithPadding-  , decodeFramesBS-  , decodeFramesBuffer-  , countZero -- testing-  ) where+    encodeFrames,+    encodeFramesWithPadding,+    decodeFramesBS,+    decodeFramesBuffer,+    countZero, -- testing+) where  import qualified Data.ByteString as BS import qualified Data.ByteString.Short as Short-import Foreign.Ptr (Ptr, plusPtr, minusPtr, alignPtr, castPtr)-import Foreign.Storable (peek, alignment)+import Foreign.Ptr (Ptr, alignPtr, castPtr, minusPtr, plusPtr)+import Foreign.Storable (alignment, peek) import Network.Socket.Internal (zeroMemory)  import Network.QUIC.Imports@@ -21,12 +21,14 @@  encodeFrames :: [Frame] -> IO ByteString encodeFrames frames = withWriteBuffer 2048 $ \wbuf ->-  mapM_ (encodeFrame wbuf) frames+    mapM_ (encodeFrame wbuf) frames -encodeFramesWithPadding :: Buffer-                        -> BufferSize-                        -> [Frame]-                        -> IO Int   -- ^ payload size without paddings+encodeFramesWithPadding+    :: Buffer+    -> BufferSize+    -> [Frame]+    -> IO Int+    -- ^ payload size without paddings encodeFramesWithPadding buf siz frames = do     zeroMemory buf $ fromIntegral siz -- padding     wbuf <- newWriteBuffer buf siz@@ -45,7 +47,7 @@     encodeInt' wbuf $ fromIntegral range1     mapM_ putRanges ranges   where-    putRanges (gap,rng) = do+    putRanges (gap, rng) = do         encodeInt' wbuf $ fromIntegral gap         encodeInt' wbuf $ fromIntegral rng encodeFrame wbuf (ResetStream sid (ApplicationProtocolError err) finalLen) = do@@ -68,10 +70,12 @@     copyByteString wbuf token encodeFrame wbuf (StreamF sid off dats fin) = do     let flag0 = 0x08 .|. 0x02 -- len-        flag1 | off /= 0  = flag0 .|. 0x04 -- off-              | otherwise = flag0-        flag2 | fin       = flag1 .|. 0x01 -- fin-              | otherwise = flag1+        flag1+            | off /= 0 = flag0 .|. 0x04 -- off+            | otherwise = flag0+        flag2+            | fin = flag1 .|. 0x01 -- fin+            | otherwise = flag1     write8 wbuf flag2     encodeInt' wbuf $ fromIntegral sid     when (off /= 0) $ encodeInt' wbuf $ fromIntegral off@@ -86,8 +90,8 @@     encodeInt' wbuf $ fromIntegral n encodeFrame wbuf (MaxStreams dir ms) = do     case dir of-      Bidirectional  -> write8 wbuf 0x12-      Unidirectional -> write8 wbuf 0x13+        Bidirectional -> write8 wbuf 0x12+        Unidirectional -> write8 wbuf 0x13     encodeInt' wbuf $ fromIntegral ms encodeFrame wbuf (DataBlocked n) = do     write8 wbuf 0x14@@ -98,8 +102,8 @@     encodeInt' wbuf $ fromIntegral n encodeFrame wbuf (StreamsBlocked dir ms) = do     case dir of-      Bidirectional  -> write8 wbuf 0x16-      Unidirectional -> write8 wbuf 0x17+        Bidirectional -> write8 wbuf 0x16+        Unidirectional -> write8 wbuf 0x17     encodeInt' wbuf $ fromIntegral ms encodeFrame wbuf (NewConnectionID cidInfo rpt) = do     write8 wbuf 0x18@@ -148,47 +152,47 @@   where     loop frames = do         ok <- (>= 1) <$> remainingSize rbuf-        if ok then do-            frame <- decodeFrame rbuf-            case frame of-              UnknownFrame _ -> return Nothing-              _              -> loop (frames . (frame:))-          else-            return $ Just $ frames []+        if ok+            then do+                frame <- decodeFrame rbuf+                case frame of+                    UnknownFrame _ -> return Nothing+                    _ -> loop (frames . (frame :))+            else return $ Just $ frames []  decodeFrame :: ReadBuffer -> IO Frame decodeFrame rbuf = do     ftyp <- fromIntegral <$> decodeInt' rbuf     case ftyp :: FrameType of-      0x00 -> decodePadding rbuf-      0x01 -> return Ping-      0x02 -> decodeAck rbuf-   -- 0x03 -> Ack with ECN Counts-      0x04 -> decodeResetStream rbuf-      0x05 -> decodeStopSending rbuf-      0x06 -> decodeCrypto rbuf-      0x07 -> decodeNewToken rbuf-      x | 0x08 <= x && x <= 0x0f -> do-              let off = testBit x 2-                  len = testBit x 1-                  fin = testBit x 0-              decodeStream rbuf off len fin-      0x10 -> decodeMaxData rbuf-      0x11 -> decodeMaxStreamData rbuf-      0x12 -> decodeMaxStreams rbuf Bidirectional-      0x13 -> decodeMaxStreams rbuf Unidirectional-      0x14 -> decodeDataBlocked rbuf-      0x15 -> decodeStreamDataBlocked rbuf-      0x16 -> decodeStreamsBlocked rbuf Bidirectional-      0x17 -> decodeStreamsBlocked rbuf Unidirectional-      0x18 -> decodeNewConnectionID rbuf-      0x19 -> decodeRetireConnectionID rbuf-      0x1a -> decodePathChallenge rbuf-      0x1b -> decodePathResponse rbuf-      0x1c -> decodeConnectionClose rbuf-      0x1d -> decodeConnectionCloseApp rbuf-      0x1e -> return HandshakeDone-      x    -> return $ UnknownFrame x+        0x00 -> decodePadding rbuf+        0x01 -> return Ping+        0x02 -> decodeAck rbuf+        -- 0x03 -> Ack with ECN Counts+        0x04 -> decodeResetStream rbuf+        0x05 -> decodeStopSending rbuf+        0x06 -> decodeCrypto rbuf+        0x07 -> decodeNewToken rbuf+        x | 0x08 <= x && x <= 0x0f -> do+            let off = testBit x 2+                len = testBit x 1+                fin = testBit x 0+            decodeStream rbuf off len fin+        0x10 -> decodeMaxData rbuf+        0x11 -> decodeMaxStreamData rbuf+        0x12 -> decodeMaxStreams rbuf Bidirectional+        0x13 -> decodeMaxStreams rbuf Unidirectional+        0x14 -> decodeDataBlocked rbuf+        0x15 -> decodeStreamDataBlocked rbuf+        0x16 -> decodeStreamsBlocked rbuf Bidirectional+        0x17 -> decodeStreamsBlocked rbuf Unidirectional+        0x18 -> decodeNewConnectionID rbuf+        0x19 -> decodeRetireConnectionID rbuf+        0x1a -> decodePathChallenge rbuf+        0x1b -> decodePathResponse rbuf+        0x1c -> decodeConnectionClose rbuf+        0x1d -> decodeConnectionCloseApp rbuf+        0x1e -> return HandshakeDone+        x -> return $ UnknownFrame x  decodePadding :: ReadBuffer -> IO Frame decodePadding rbuf = do@@ -201,39 +205,38 @@  countZero :: Ptr Word8 -> Ptr Word8 -> IO Int countZero beg0 end0-  | (end0 `minusPtr` beg0) <= ali = fst <$> countBy1 beg0 end0 0-  | otherwise = do-    let beg1 = alignPtr beg0 ali-        end1' = alignPtr end0 ali-        end1 | end0 == end1' = end1'-             | otherwise     = end1' `plusPtr` negate ali-    (n1,cont1) <- countBy1 beg0 beg1 0-    if not cont1 then-        return n1-      else do-        (n2,beg2) <- countBy8 (castPtr beg1) (castPtr end1) 0-        (n3,_) <- countBy1 (castPtr beg2) end0 0-        return (n1 + n2 + n3)+    | (end0 `minusPtr` beg0) <= ali = fst <$> countBy1 beg0 end0 0+    | otherwise = do+        let beg1 = alignPtr beg0 ali+            end1' = alignPtr end0 ali+            end1+                | end0 == end1' = end1'+                | otherwise = end1' `plusPtr` negate ali+        (n1, cont1) <- countBy1 beg0 beg1 0+        if not cont1+            then return n1+            else do+                (n2, beg2) <- countBy8 (castPtr beg1) (castPtr end1) 0+                (n3, _) <- countBy1 (castPtr beg2) end0 0+                return (n1 + n2 + n3)   where     ali = alignment (0 :: Word64)-    countBy1 :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Int,Bool)+    countBy1 :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Int, Bool)     countBy1 beg end n-      | beg < end = do+        | beg < end = do             ftyp <- peek beg-            if ftyp == 0 then-                countBy1 (beg `plusPtr` 1) end (n + 1)-              else-                return (n, False)-      | otherwise = return (n, True)+            if ftyp == 0+                then countBy1 (beg `plusPtr` 1) end (n + 1)+                else return (n, False)+        | otherwise = return (n, True)     countBy8 :: Ptr Word64 -> Ptr Word64 -> Int -> IO (Int, Ptr Word64)     countBy8 beg end n-      | beg < end = do+        | beg < end = do             ftyp <- peek beg-            if ftyp == 0 then-                countBy8 (beg `plusPtr` ali) end (n + ali)-              else-                return (n, beg)-      | otherwise = return (n, beg)+            if ftyp == 0+                then countBy8 (beg `plusPtr` ali) end (n + ali)+                else return (n, beg)+        | otherwise = return (n, beg)  decodeCrypto :: ReadBuffer -> IO Frame decodeCrypto rbuf = do@@ -245,10 +248,10 @@ decodeAck :: ReadBuffer -> IO Frame decodeAck rbuf = do     largest <- fromIntegral <$> decodeInt' rbuf-    delay   <- fromIntegral <$> decodeInt' rbuf-    count   <- fromIntegral <$> decodeInt' rbuf-    range1  <- fromIntegral <$> decodeInt' rbuf-    ranges  <- getRanges count id+    delay <- fromIntegral <$> decodeInt' rbuf+    count <- fromIntegral <$> decodeInt' rbuf+    range1 <- fromIntegral <$> decodeInt' rbuf+    ranges <- getRanges count id     return $ Ack (AckInfo largest range1 ranges) $ Milliseconds delay   where     getRanges 0 build = return $ build []@@ -279,16 +282,18 @@ decodeStream :: ReadBuffer -> Bool -> Bool -> Bool -> IO Frame decodeStream rbuf hasOff hasLen fin = do     sID <- fromIntegral <$> decodeInt' rbuf-    off <- if hasOff then-             fromIntegral <$> decodeInt' rbuf-           else-             return 0-    dat <- if hasLen then do-             len <- fromIntegral <$> decodeInt' rbuf-             extractByteString rbuf len-           else do-             len <- remainingSize rbuf-             extractByteString rbuf len+    off <-+        if hasOff+            then fromIntegral <$> decodeInt' rbuf+            else return 0+    dat <-+        if hasLen+            then do+                len <- fromIntegral <$> decodeInt' rbuf+                extractByteString rbuf len+            else do+                len <- remainingSize rbuf+                extractByteString rbuf len     return $ StreamF sID off [dat] fin  ----------------------------------------------------------------@@ -323,16 +328,16 @@  decodeConnectionClose :: ReadBuffer -> IO Frame decodeConnectionClose rbuf = do-    err    <- TransportError . fromIntegral <$> decodeInt' rbuf-    ftyp   <- fromIntegral <$> decodeInt' rbuf-    len    <- fromIntegral <$> decodeInt' rbuf+    err <- TransportError . fromIntegral <$> decodeInt' rbuf+    ftyp <- fromIntegral <$> decodeInt' rbuf+    len <- fromIntegral <$> decodeInt' rbuf     reason <- extractShortByteString rbuf len     return $ ConnectionClose err ftyp reason -decodeConnectionCloseApp  :: ReadBuffer -> IO Frame+decodeConnectionCloseApp :: ReadBuffer -> IO Frame decodeConnectionCloseApp rbuf = do-    err    <- ApplicationProtocolError . fromIntegral <$> decodeInt' rbuf-    len    <- fromIntegral <$> decodeInt' rbuf+    err <- ApplicationProtocolError . fromIntegral <$> decodeInt' rbuf+    len <- fromIntegral <$> decodeInt' rbuf     reason <- extractShortByteString rbuf len     return $ ConnectionCloseApp err reason 

@@ -1,18 +1,18 @@ {-# LANGUAGE BinaryLiterals #-}  module Network.QUIC.Packet.Header (-    isLong-  , isShort-  , protectFlags-  , unprotectFlags-  , encodeLongHeaderFlags-  , encodeShortHeaderFlags-  , decodeLongHeaderPacketType-  , encodePktNumLength-  , decodePktNumLength-  , versionNegotiationPacketType-  , retryPacketType-  ) where+    isLong,+    isShort,+    protectFlags,+    unprotectFlags,+    encodeLongHeaderFlags,+    encodeShortHeaderFlags,+    decodeLongHeaderPacketType,+    encodePktNumLength,+    decodePktNumLength,+    versionNegotiationPacketType,+    retryPacketType,+) where  import Network.QUIC.Imports import Network.QUIC.Types@@ -39,43 +39,56 @@     mask = mask1 .&. flagBits flags     proFlags = flags `xor` mask - {-# INLINE flagBits #-}+{- FOURMOLU_DISABLE -} flagBits :: Word8 -> Word8 flagBits flags-  | isLong flags = 0b00001111 -- long header-  | otherwise    = 0b00011111 -- short header+    | isLong flags = 0b00001111 -- long header+    | otherwise    = 0b00011111 -- short header+{- FOURMOLU_ENABLE -}  ----------------------------------------------------------------  randomizeQuicBit :: Word8 -> Bool -> IO Word8 randomizeQuicBit flags quicBit-  | quicBit = do+    | quicBit = do         r <- getRandomOneByte         return ((flags .&. 0b10111111) .|. (r .&. 0b01000000))-  | otherwise = return flags+    | otherwise = return flags  {-# INLINE encodeShortHeaderFlags #-}-encodeShortHeaderFlags :: Flags Raw -> Flags Raw -> Bool -> Bool -> IO (Flags Raw)+{- FOURMOLU_DISABLE -}+encodeShortHeaderFlags+    :: Flags Raw -> Flags Raw -> Bool -> Bool -> IO (Flags Raw) encodeShortHeaderFlags (Flags fg) (Flags pp) quicBit keyPhase =     Flags <$> randomizeQuicBit flags quicBit   where-    flags =          0b01000000-         .|. (fg .&. 0b00111100)-         .|. (pp .&. 0b00000011)-         .|. (if keyPhase then 0b00000100 else 0b00000000)+    flags =+                        0b01000000+            .|. (fg .&. 0b00111100)+            .|. (pp .&. 0b00000011)+            .|. (if keyPhase then 0b00000100 else 0b00000000)+{- FOURMOLU_ENABLE -}  {-# INLINE encodeLongHeaderFlags #-}-encodeLongHeaderFlags :: Version -> LongHeaderPacketType -> Flags Raw -> Flags Raw -> Bool -> IO (Flags Raw)+encodeLongHeaderFlags+    :: Version+    -> LongHeaderPacketType+    -> Flags Raw+    -> Flags Raw+    -> Bool+    -> IO (Flags Raw) encodeLongHeaderFlags ver typ (Flags fg) (Flags pp) quicBit =     Flags <$> randomizeQuicBit flags quicBit   where     Flags tp = longHeaderPacketType ver typ-    flags =   tp-         .|. (fg .&. 0b00001100)-         .|. (pp .&. 0b00000011)+    flags =+        tp+            .|. (fg .&. 0b00001100)+            .|. (pp .&. 0b00000011)  {-# INLINE longHeaderPacketType #-}+{- FOURMOLU_DISABLE -} longHeaderPacketType :: Version -> LongHeaderPacketType -> Flags Raw longHeaderPacketType Version2 InitialPacketType   = Flags 0b11010000 longHeaderPacketType Version2 RTT0PacketType      = Flags 0b11100000@@ -85,6 +98,7 @@ longHeaderPacketType _        RTT0PacketType      = Flags 0b11010000 longHeaderPacketType _        HandshakePacketType = Flags 0b11100000 longHeaderPacketType _        RetryPacketType     = Flags 0b11110000+{- FOURMOLU_ENABLE -}  retryPacketType :: Version -> IO (Flags Raw) retryPacketType Version2 = do@@ -103,6 +117,7 @@     return $ Flags flags  {-# INLINE decodeLongHeaderPacketType #-}+{- FOURMOLU_DISABLE -} decodeLongHeaderPacketType :: Version -> Flags Protected -> LongHeaderPacketType decodeLongHeaderPacketType Version2 (Flags flags) = case flags .&. 0b00110000 of     0b00010000 -> InitialPacketType@@ -114,6 +129,7 @@     0b00010000 -> RTT0PacketType     0b00100000 -> HandshakePacketType     _          -> RetryPacketType+{- FOURMOLU_ENABLE -}  {-# INLINE encodePktNumLength #-} encodePktNumLength :: Int -> Flags Raw

@@ -1,7 +1,7 @@ module Network.QUIC.Packet.Number (-    encodePacketNumber-  , decodePacketNumber-  ) where+    encodePacketNumber,+    decodePacketNumber,+) where  import Network.QUIC.Imports import Network.QUIC.Types@@ -16,6 +16,7 @@ -- True -- >>> encodePacketNumber 0xabe8bc 0xace8fe == (0xace8fe, 3) -- True+{- FOURMOLU_DISABLE -} encodePacketNumber :: PacketNumber -> PacketNumber -> (EncodedPacketNumber, Int) encodePacketNumber largestPN pn = (diff, bytes)   where@@ -26,6 +27,7 @@       | enoughRange < 16777216 = (0x00ffffff, 3)       | otherwise              = (0xffffffff, 4)     diff = fromIntegral (pn .&. pnMask)+{- FOURMOLU_ENABLE -}  ---------------------------------------------------------------- @@ -37,6 +39,7 @@ -- True -- >>> decodePacketNumber 0xabe8bc 0xace8fe 3 == 0xace8fe -- True+{- FOURMOLU_DISABLE -} decodePacketNumber :: PacketNumber -> EncodedPacketNumber -> Int -> PacketNumber decodePacketNumber largestPN truncatedPN bytes   | candidatePN <= expectedPN - pnHwin@@ -53,3 +56,4 @@     pnMask = pnWin - 1     candidatePN = (expectedPN .&. complement pnMask)               .|. fromIntegral truncatedPN+{- FOURMOLU_ENABLE -}

@@ -1,11 +1,11 @@ module Network.QUIC.Packet.Token (-    CryptoToken(..)-  , isRetryToken-  , generateToken-  , generateRetryToken-  , encryptToken-  , decryptToken-  ) where+    CryptoToken (..),+    isRetryToken,+    generateToken,+    generateRetryToken,+    encryptToken,+    decryptToken,+) where  import qualified Crypto.Token as CT import Data.UnixTime@@ -19,11 +19,11 @@  ---------------------------------------------------------------- -data CryptoToken = CryptoToken {-    tokenQUICVersion :: Version-  , tokenCreatedTime :: TimeMicrosecond-  , tokenCIDs        :: Maybe (CID, CID, CID) -- local, remote, orig local-  }+data CryptoToken = CryptoToken+    { tokenQUICVersion :: Version+    , tokenCreatedTime :: TimeMicrosecond+    , tokenCIDs :: Maybe (CID, CID, CID) -- local, remote, orig local+    }  isRetryToken :: CryptoToken -> Bool isRetryToken token = isJust $ tokenCIDs token@@ -38,7 +38,7 @@ generateRetryToken :: Version -> CID -> CID -> CID -> IO CryptoToken generateRetryToken ver l r o = do     t <- getTimeMicrosecond-    return $ CryptoToken ver t $ Just (l,r,o)+    return $ CryptoToken ver t $ Just (l, r, o)  ---------------------------------------------------------------- @@ -55,21 +55,21 @@  -- length includes its field instance Storable CryptoToken where-    sizeOf    ~_ = cryptoTokenSize+    sizeOf ~_ = cryptoTokenSize     alignment ~_ = 4     peek ptr = do         rbuf <- newReadBuffer (castPtr ptr) cryptoTokenSize-        ver  <- Version <$> read32 rbuf+        ver <- Version <$> read32 rbuf         s <- CTime . fromIntegral <$> read64 rbuf         let tim = UnixTime s 0         typ <- read8 rbuf         case typ of-          0 -> return $ CryptoToken ver tim Nothing-          _ -> do-              l <- pick rbuf-              r <- pick rbuf-              o <- pick rbuf-              return $ CryptoToken ver tim $ Just (l,r,o)+            0 -> return $ CryptoToken ver tim Nothing+            _ -> do+                l <- pick rbuf+                r <- pick rbuf+                o <- pick rbuf+                return $ CryptoToken ver tim $ Just (l, r, o)       where         pick rbuf = do             xlen0 <- fromIntegral <$> read8 rbuf@@ -83,12 +83,12 @@         let CTime s = utSeconds tim         write64 wbuf $ fromIntegral s         case mcids of-          Nothing      -> write8 wbuf 0-          Just (l,r,o) -> do-              write8 wbuf 1-              bury wbuf l-              bury wbuf r-              bury wbuf o+            Nothing -> write8 wbuf 0+            Just (l, r, o) -> do+                write8 wbuf 1+                bury wbuf l+                bury wbuf r+                bury wbuf o       where         bury wbuf x = do             let (xcid, xlen) = unpackCID x

@@ -1,18 +1,18 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Parameters (-    Parameters(..)-  , defaultParameters-  , baseParameters -- only for Connection-  , encodeParameters-  , decodeParameters-  , AuthCIDs(..)-  , defaultAuthCIDs-  , setCIDsToParameters-  , getCIDsToParameters-  ) where+    Parameters (..),+    defaultParameters,+    baseParameters, -- only for Connection+    encodeParameters,+    decodeParameters,+    AuthCIDs (..),+    defaultAuthCIDs,+    setCIDsToParameters,+    getCIDsToParameters,+) where  import qualified Data.ByteString as BS import qualified Data.ByteString.Short as Short@@ -30,8 +30,9 @@ newtype Key = Key Word32 deriving (Eq, Show) type Value = ByteString -type ParameterList = [(Key,Value)]+type ParameterList = [(Key, Value)] +{- FOURMOLU_DISABLE -} pattern OriginalDestinationConnectionId :: Key pattern OriginalDestinationConnectionId  = Key 0x00 pattern MaxIdleTimeout                  :: Key@@ -72,56 +73,58 @@ pattern Grease                           = Key 0xff pattern GreaseQuicBit                   :: Key pattern GreaseQuicBit                    = Key 0x2ab2-+{- FOURMOLU_ENABLE -}  -- | QUIC transport parameters.-data Parameters = Parameters {-    originalDestinationConnectionId :: Maybe CID-  , maxIdleTimeout                  :: Milliseconds-  , statelessResetToken             :: Maybe StatelessResetToken -- 16 bytes-  , maxUdpPayloadSize               :: Int-  , initialMaxData                  :: Int-  , initialMaxStreamDataBidiLocal   :: Int-  , initialMaxStreamDataBidiRemote  :: Int-  , initialMaxStreamDataUni         :: Int-  , initialMaxStreamsBidi           :: Int-  , initialMaxStreamsUni            :: Int-  , ackDelayExponent                :: Int-  , maxAckDelay                     :: Milliseconds-  , disableActiveMigration          :: Bool-  , preferredAddress                :: Maybe ByteString -- fixme-  , activeConnectionIdLimit         :: Int-  , initialSourceConnectionId       :: Maybe CID-  , retrySourceConnectionId         :: Maybe CID-  , grease                          :: Maybe ByteString-  , greaseQuicBit                   :: Bool-  , versionInformation              :: Maybe VersionInfo-  } deriving (Eq,Show)+data Parameters = Parameters+    { originalDestinationConnectionId :: Maybe CID+    , maxIdleTimeout :: Milliseconds+    , statelessResetToken :: Maybe StatelessResetToken -- 16 bytes+    , maxUdpPayloadSize :: Int+    , initialMaxData :: Int+    , initialMaxStreamDataBidiLocal :: Int+    , initialMaxStreamDataBidiRemote :: Int+    , initialMaxStreamDataUni :: Int+    , initialMaxStreamsBidi :: Int+    , initialMaxStreamsUni :: Int+    , ackDelayExponent :: Int+    , maxAckDelay :: Milliseconds+    , disableActiveMigration :: Bool+    , preferredAddress :: Maybe ByteString -- fixme+    , activeConnectionIdLimit :: Int+    , initialSourceConnectionId :: Maybe CID+    , retrySourceConnectionId :: Maybe CID+    , grease :: Maybe ByteString+    , greaseQuicBit :: Bool+    , versionInformation :: Maybe VersionInfo+    }+    deriving (Eq, Show)  -- | The default value for QUIC transport parameters. baseParameters :: Parameters-baseParameters = Parameters {-    originalDestinationConnectionId    = Nothing-  , maxIdleTimeout                     = Milliseconds 0 -- disabled-  , statelessResetToken                = Nothing-  , maxUdpPayloadSize                  = 65527-  , initialMaxData                     = 0-  , initialMaxStreamDataBidiLocal      = 0-  , initialMaxStreamDataBidiRemote     = 0-  , initialMaxStreamDataUni            = 0-  , initialMaxStreamsBidi              = 0-  , initialMaxStreamsUni               = 0-  , ackDelayExponent                   = 3-  , maxAckDelay                        = Milliseconds 25-  , disableActiveMigration             = False-  , preferredAddress                   = Nothing-  , activeConnectionIdLimit            = 2-  , initialSourceConnectionId          = Nothing-  , retrySourceConnectionId            = Nothing-  , grease                             = Nothing-  , greaseQuicBit                      = False-  , versionInformation                 = Nothing-  }+baseParameters =+    Parameters+        { originalDestinationConnectionId = Nothing+        , maxIdleTimeout = Milliseconds 0 -- disabled+        , statelessResetToken = Nothing+        , maxUdpPayloadSize = 65527+        , initialMaxData = 0+        , initialMaxStreamDataBidiLocal = 0+        , initialMaxStreamDataBidiRemote = 0+        , initialMaxStreamDataUni = 0+        , initialMaxStreamsBidi = 0+        , initialMaxStreamsUni = 0+        , ackDelayExponent = 3+        , maxAckDelay = Milliseconds 25+        , disableActiveMigration = False+        , preferredAddress = Nothing+        , activeConnectionIdLimit = 2+        , initialSourceConnectionId = Nothing+        , retrySourceConnectionId = Nothing+        , grease = Nothing+        , greaseQuicBit = False+        , versionInformation = Nothing+        }  decInt :: ByteString -> Int decInt = fromIntegral . decodeInt@@ -136,7 +139,7 @@ encMilliseconds (Milliseconds n) = encodeInt $ fromIntegral n  fromVersionInfo :: Maybe VersionInfo -> Value-fromVersionInfo Nothing                = "" -- never reach+fromVersionInfo Nothing = "" -- never reach fromVersionInfo (Just VersionInfo{..}) = unsafeDupablePerformIO $     withWriteBuffer len $ \wbuf -> do         let putVersion (Version ver) = write32 wbuf ver@@ -147,95 +150,112 @@  toVersionInfo :: Value -> Maybe VersionInfo toVersionInfo bs-  | len < 3 || remainder /= 0   = Just brokenVersionInfo-  | otherwise                   = Just $ unsafeDupablePerformIO $-    withReadBuffer bs $ \rbuf -> do-        let getVersion = Version <$> read32 rbuf-        VersionInfo <$> getVersion <*> replicateM (cnt - 1) getVersion+    | len < 3 || remainder /= 0 = Just brokenVersionInfo+    | otherwise = Just $+        unsafeDupablePerformIO $+            withReadBuffer bs $ \rbuf -> do+                let getVersion = Version <$> read32 rbuf+                VersionInfo <$> getVersion <*> replicateM (cnt - 1) getVersion   where     len = BS.length bs-    (cnt,remainder) = len `divMod` 4+    (cnt, remainder) = len `divMod` 4  fromParameterList :: ParameterList -> Parameters fromParameterList kvs = foldl' update params kvs   where     params = baseParameters-    update x (OriginalDestinationConnectionId,v)-        = x { originalDestinationConnectionId = Just (toCID v) }-    update x (MaxIdleTimeout,v)-        = x { maxIdleTimeout = decMilliseconds v }-    update x (StateLessResetToken,v)-        = x { statelessResetToken = Just (StatelessResetToken $ Short.toShort v) }-    update x (MaxUdpPayloadSize,v)-        = x { maxUdpPayloadSize = decInt v }-    update x (InitialMaxData,v)-        = x { initialMaxData = decInt v }-    update x (InitialMaxStreamDataBidiLocal,v)-        = x { initialMaxStreamDataBidiLocal = decInt v }-    update x (InitialMaxStreamDataBidiRemote,v)-        = x { initialMaxStreamDataBidiRemote = decInt v }-    update x (InitialMaxStreamDataUni,v)-        = x { initialMaxStreamDataUni = decInt v }-    update x (InitialMaxStreamsBidi,v)-        = x { initialMaxStreamsBidi = decInt v }-    update x (InitialMaxStreamsUni,v)-        = x { initialMaxStreamsUni = decInt v }-    update x (AckDelayExponent,v)-        = x { ackDelayExponent = decInt v }-    update x (MaxAckDelay,v)-        = x { maxAckDelay = decMilliseconds v }-    update x (DisableActiveMigration,_)-        = x { disableActiveMigration = True }-    update x (PreferredAddress,v)-        = x { preferredAddress = Just v }-    update x (ActiveConnectionIdLimit,v)-        = x { activeConnectionIdLimit = decInt v }-    update x (InitialSourceConnectionId,v)-        = x { initialSourceConnectionId = Just (toCID v) }-    update x (RetrySourceConnectionId,v)-        = x { retrySourceConnectionId = Just (toCID v) }-    update x (Grease,v)-        = x { grease = Just v }-    update x (GreaseQuicBit,_)-        = x { greaseQuicBit = True }-    update x (VersionInformation,v)-        = x { versionInformation = toVersionInfo v }+    update x (OriginalDestinationConnectionId, v) =+        x{originalDestinationConnectionId = Just (toCID v)}+    update x (MaxIdleTimeout, v) =+        x{maxIdleTimeout = decMilliseconds v}+    update x (StateLessResetToken, v) =+        x{statelessResetToken = Just (StatelessResetToken $ Short.toShort v)}+    update x (MaxUdpPayloadSize, v) =+        x{maxUdpPayloadSize = decInt v}+    update x (InitialMaxData, v) =+        x{initialMaxData = decInt v}+    update x (InitialMaxStreamDataBidiLocal, v) =+        x{initialMaxStreamDataBidiLocal = decInt v}+    update x (InitialMaxStreamDataBidiRemote, v) =+        x{initialMaxStreamDataBidiRemote = decInt v}+    update x (InitialMaxStreamDataUni, v) =+        x{initialMaxStreamDataUni = decInt v}+    update x (InitialMaxStreamsBidi, v) =+        x{initialMaxStreamsBidi = decInt v}+    update x (InitialMaxStreamsUni, v) =+        x{initialMaxStreamsUni = decInt v}+    update x (AckDelayExponent, v) =+        x{ackDelayExponent = decInt v}+    update x (MaxAckDelay, v) =+        x{maxAckDelay = decMilliseconds v}+    update x (DisableActiveMigration, _) =+        x{disableActiveMigration = True}+    update x (PreferredAddress, v) =+        x{preferredAddress = Just v}+    update x (ActiveConnectionIdLimit, v) =+        x{activeConnectionIdLimit = decInt v}+    update x (InitialSourceConnectionId, v) =+        x{initialSourceConnectionId = Just (toCID v)}+    update x (RetrySourceConnectionId, v) =+        x{retrySourceConnectionId = Just (toCID v)}+    update x (Grease, v) =+        x{grease = Just v}+    update x (GreaseQuicBit, _) =+        x{greaseQuicBit = True}+    update x (VersionInformation, v) =+        x{versionInformation = toVersionInfo v}     update x _ = x -diff :: Eq a => Parameters -> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key,Value)+diff+    :: Eq a+    => Parameters+    -> (Parameters -> a)+    -> Key+    -> (a -> Value)+    -> Maybe (Key, Value) diff params label key enc-  | val == val0 = Nothing-  | otherwise   = Just (key, enc val)+    | val == val0 = Nothing+    | otherwise = Just (key, enc val)   where     val = label params     val0 = label baseParameters  toParameterList :: Parameters -> ParameterList-toParameterList p = catMaybes [-    diff p originalDestinationConnectionId-         OriginalDestinationConnectionId    (fromCID . fromJust)-  , diff p maxIdleTimeout          MaxIdleTimeout          encMilliseconds-  , diff p statelessResetToken     StateLessResetToken     encSRT-  , diff p maxUdpPayloadSize       MaxUdpPayloadSize       encInt-  , diff p initialMaxData          InitialMaxData          encInt-  , diff p initialMaxStreamDataBidiLocal  InitialMaxStreamDataBidiLocal  encInt-  , diff p initialMaxStreamDataBidiRemote InitialMaxStreamDataBidiRemote encInt-  , diff p initialMaxStreamDataUni InitialMaxStreamDataUni encInt-  , diff p initialMaxStreamsBidi   InitialMaxStreamsBidi   encInt-  , diff p initialMaxStreamsUni    InitialMaxStreamsUni    encInt-  , diff p ackDelayExponent        AckDelayExponent        encInt-  , diff p maxAckDelay             MaxAckDelay             encMilliseconds-  , diff p disableActiveMigration  DisableActiveMigration  (const "")-  , diff p preferredAddress        PreferredAddress        fromJust-  , diff p activeConnectionIdLimit ActiveConnectionIdLimit encInt-  , diff p initialSourceConnectionId-         InitialSourceConnectionId    (fromCID . fromJust)-  , diff p retrySourceConnectionId-         RetrySourceConnectionId      (fromCID . fromJust)-  , diff p greaseQuicBit           GreaseQuicBit           (const "")-  , diff p grease                  Grease                  fromJust-  , diff p versionInformation      VersionInformation      fromVersionInfo-  ]+toParameterList p =+    catMaybes+        [ diff+            p+            originalDestinationConnectionId+            OriginalDestinationConnectionId+            (fromCID . fromJust)+        , diff p maxIdleTimeout MaxIdleTimeout encMilliseconds+        , diff p statelessResetToken StateLessResetToken encSRT+        , diff p maxUdpPayloadSize MaxUdpPayloadSize encInt+        , diff p initialMaxData InitialMaxData encInt+        , diff p initialMaxStreamDataBidiLocal InitialMaxStreamDataBidiLocal encInt+        , diff p initialMaxStreamDataBidiRemote InitialMaxStreamDataBidiRemote encInt+        , diff p initialMaxStreamDataUni InitialMaxStreamDataUni encInt+        , diff p initialMaxStreamsBidi InitialMaxStreamsBidi encInt+        , diff p initialMaxStreamsUni InitialMaxStreamsUni encInt+        , diff p ackDelayExponent AckDelayExponent encInt+        , diff p maxAckDelay MaxAckDelay encMilliseconds+        , diff p disableActiveMigration DisableActiveMigration (const "")+        , diff p preferredAddress PreferredAddress fromJust+        , diff p activeConnectionIdLimit ActiveConnectionIdLimit encInt+        , diff+            p+            initialSourceConnectionId+            InitialSourceConnectionId+            (fromCID . fromJust)+        , diff+            p+            retrySourceConnectionId+            RetrySourceConnectionId+            (fromCID . fromJust)+        , diff p greaseQuicBit GreaseQuicBit (const "")+        , diff p grease Grease fromJust+        , diff p versionInformation VersionInformation fromVersionInfo+        ]  encSRT :: Maybe StatelessResetToken -> ByteString encSRT (Just (StatelessResetToken srt)) = Short.fromShort srt@@ -243,10 +263,11 @@  encodeParameterList :: ParameterList -> ByteString encodeParameterList kvs = unsafeDupablePerformIO $-    withWriteBuffer 4096 $ \wbuf -> do -- for grease+    withWriteBuffer 4096 $ \wbuf -> do+        -- for grease         mapM_ (put wbuf) kvs   where-    put wbuf (Key k,v) = do+    put wbuf (Key k, v) = do         encodeInt' wbuf $ fromIntegral k         encodeInt' wbuf $ fromIntegral $ BS.length v         copyByteString wbuf v@@ -255,49 +276,53 @@ decodeParameterList bs = unsafeDupablePerformIO $ withReadBuffer bs (`go` id)   where     go rbuf build = do-       rest1 <- remainingSize rbuf-       if rest1 == 0 then-          return $ Just (build [])-       else do-          key <- fromIntegral <$> decodeInt' rbuf-          len <- fromIntegral <$> decodeInt' rbuf-          val <- extractByteString rbuf len-          go rbuf (build . ((Key key,val):))+        rest1 <- remainingSize rbuf+        if rest1 == 0+            then return $ Just (build [])+            else do+                key <- fromIntegral <$> decodeInt' rbuf+                len <- fromIntegral <$> decodeInt' rbuf+                val <- extractByteString rbuf len+                go rbuf (build . ((Key key, val) :))  -- | An example parameters obsoleted in the near future. defaultParameters :: Parameters-defaultParameters = baseParameters {-    maxIdleTimeout                 = microToMilli idleTimeout -- 30000-  , maxUdpPayloadSize              = maximumUdpPayloadSize -- 2048-  , initialMaxData                 = 1048576-  , initialMaxStreamDataBidiLocal  =  262144-  , initialMaxStreamDataBidiRemote =  262144-  , initialMaxStreamDataUni        =  262144-  , initialMaxStreamsBidi          =     100-  , initialMaxStreamsUni           =       3-  , activeConnectionIdLimit        =       3-  , greaseQuicBit                  = True-  }+defaultParameters =+    baseParameters+        { maxIdleTimeout = microToMilli idleTimeout -- 30000+        , maxUdpPayloadSize = maximumUdpPayloadSize -- 2048+        , initialMaxData = 1048576+        , initialMaxStreamDataBidiLocal = 262144+        , initialMaxStreamDataBidiRemote = 262144+        , initialMaxStreamDataUni = 262144+        , initialMaxStreamsBidi = 100+        , initialMaxStreamsUni = 3+        , activeConnectionIdLimit = 3+        , greaseQuicBit = True+        } -data AuthCIDs = AuthCIDs {-    initSrcCID  :: Maybe CID-  , origDstCID  :: Maybe CID-  , retrySrcCID :: Maybe CID-  } deriving (Eq, Show)+data AuthCIDs = AuthCIDs+    { initSrcCID :: Maybe CID+    , origDstCID :: Maybe CID+    , retrySrcCID :: Maybe CID+    }+    deriving (Eq, Show)  defaultAuthCIDs :: AuthCIDs defaultAuthCIDs = AuthCIDs Nothing Nothing Nothing  setCIDsToParameters :: AuthCIDs -> Parameters -> Parameters-setCIDsToParameters AuthCIDs{..} params = params {-    originalDestinationConnectionId = origDstCID-  , initialSourceConnectionId       = initSrcCID-  , retrySourceConnectionId         = retrySrcCID-  }+setCIDsToParameters AuthCIDs{..} params =+    params+        { originalDestinationConnectionId = origDstCID+        , initialSourceConnectionId = initSrcCID+        , retrySourceConnectionId = retrySrcCID+        }  getCIDsToParameters :: Parameters -> AuthCIDs-getCIDsToParameters Parameters{..} = AuthCIDs {-    origDstCID  = originalDestinationConnectionId-  , initSrcCID  = initialSourceConnectionId-  , retrySrcCID = retrySourceConnectionId-  }+getCIDsToParameters Parameters{..} =+    AuthCIDs+        { origDstCID = originalDestinationConnectionId+        , initSrcCID = initialSourceConnectionId+        , retrySrcCID = retrySourceConnectionId+        }

@@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.QUIC.QLogger (-    QLogger-  , dirQLogger-  ) where+    QLogger,+    dirQLogger,+) where  import System.FilePath import System.Log.FastLogger@@ -12,7 +12,8 @@ import Network.QUIC.Qlog import Network.QUIC.Types -dirQLogger :: Maybe FilePath -> TimeMicrosecond -> CID -> ByteString -> IO (QLogger, IO ())+dirQLogger+    :: Maybe FilePath -> TimeMicrosecond -> CID -> ByteString -> IO (QLogger, IO ()) dirQLogger Nothing _ _ _ = do     let qLog ~_ = return ()         clean = return ()

@@ -3,23 +3,23 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Qlog (-    QLogger-  , newQlogger-  , Qlog(..)-  , KeepQlog(..)-  , QlogMsg(..)-  , qlogReceived-  , qlogDropped-  , qlogRecvInitial-  , qlogSentRetry-  , qlogParamsSet-  , qlogDebug-  , qlogCIDUpdate-  , Debug(..)-  , LR(..)-  , packetType-  , sw-  ) where+    QLogger,+    newQlogger,+    Qlog (..),+    KeepQlog (..),+    QlogMsg (..),+    qlogReceived,+    qlogDropped,+    qlogRecvInitial,+    qlogSentRetry,+    qlogParamsSet,+    qlogDebug,+    qlogCIDUpdate,+    Debug (..),+    LR (..),+    packetType,+    sw,+) where  import qualified Data.ByteString as BS @@ -44,14 +44,15 @@     qlog (Debug msg) = "{\"message\":\"" <> msg <> "\"}"  instance Qlog LR where-    qlog (Local  cid) = "{\"owner\":\"local\",\"new\":\"" <> sw cid <> "\"}"+    qlog (Local cid) = "{\"owner\":\"local\",\"new\":\"" <> sw cid <> "\"}"     qlog (Remote cid) = "{\"owner\":\"remote\",\"new\":\"" <> sw cid <> "\"}"  instance Qlog RetryPacket where     qlog RetryPacket{} = "{\"header\":{\"packet_type\":\"retry\",\"packet_number\":\"\"}}"  instance Qlog VersionNegotiationPacket where-    qlog VersionNegotiationPacket{} = "{\"header\":{\"packet_type\":\"version_negotiation\",\"packet_number\":\"\"}}"+    qlog VersionNegotiationPacket{} =+        "{\"header\":{\"packet_type\":\"version_negotiation\",\"packet_number\":\"\"}}"  instance Qlog Header where     qlog hdr = "{\"header\":{\"packet_type\":\"" <> packetType hdr <> "\"}}"@@ -60,90 +61,126 @@     qlog (CryptPacket hdr _) = qlog hdr  instance Qlog PlainPacket where-    qlog (PlainPacket hdr Plain{..}) = "{\"header\":{\"packet_type\":\"" <> toLogStr (packetType hdr) <> "\",\"packet_number\":\"" <> sw plainPacketNumber <> "\",\"dcid\":\"" <> sw (headerMyCID hdr) <> "\"},\"frames\":[" <> foldr (<>) "" (intersperse "," (map qlog plainFrames)) <> "]}"+    qlog (PlainPacket hdr Plain{..}) =+        "{\"header\":{\"packet_type\":\""+            <> toLogStr (packetType hdr)+            <> "\",\"packet_number\":\""+            <> sw plainPacketNumber+            <> "\",\"dcid\":\""+            <> sw (headerMyCID hdr)+            <> "\"},\"frames\":["+            <> foldr (<>) "" (intersperse "," (map qlog plainFrames))+            <> "]}"  instance Qlog StatelessReset where     qlog StatelessReset = "{\"header\":{\"packet_type\":\"stateless_reset\",\"packet_number\":\"\"}}"  packetType :: Header -> LogStr-packetType Initial{}   = "initial"-packetType RTT0{}      = "0RTT"+packetType Initial{} = "initial"+packetType RTT0{} = "0RTT" packetType Handshake{} = "handshake"-packetType Short{}     = "1RTT"+packetType Short{} = "1RTT"  instance Qlog Frame where     qlog frame = "{\"frame_type\":\"" <> frameType frame <> "\"" <> frameExtra frame <> "}"  frameType :: Frame -> LogStr-frameType Padding{}             = "padding"-frameType Ping                  = "ping"-frameType Ack{}                 = "ack"-frameType ResetStream{}         = "reset_stream"-frameType StopSending{}         = "stop_sending"-frameType CryptoF{}             = "crypto"-frameType NewToken{}            = "new_token"-frameType StreamF{}             = "stream"-frameType MaxData{}             = "max_data"-frameType MaxStreamData{}       = "max_stream_data"-frameType MaxStreams{}          = "max_streams"-frameType DataBlocked{}         = "data_blocked"-frameType StreamDataBlocked{}   = "stream_data_blocked"-frameType StreamsBlocked{}      = "streams_blocked"-frameType NewConnectionID{}     = "new_connection_id"-frameType RetireConnectionID{}  = "retire_connection_id"-frameType PathChallenge{}       = "path_challenge"-frameType PathResponse{}        = "path_response"-frameType ConnectionClose{}     = "connection_close"-frameType ConnectionCloseApp{}  = "connection_close"-frameType HandshakeDone{}       = "handshake_done"-frameType UnknownFrame{}        = "unknown"+frameType Padding{} = "padding"+frameType Ping = "ping"+frameType Ack{} = "ack"+frameType ResetStream{} = "reset_stream"+frameType StopSending{} = "stop_sending"+frameType CryptoF{} = "crypto"+frameType NewToken{} = "new_token"+frameType StreamF{} = "stream"+frameType MaxData{} = "max_data"+frameType MaxStreamData{} = "max_stream_data"+frameType MaxStreams{} = "max_streams"+frameType DataBlocked{} = "data_blocked"+frameType StreamDataBlocked{} = "stream_data_blocked"+frameType StreamsBlocked{} = "streams_blocked"+frameType NewConnectionID{} = "new_connection_id"+frameType RetireConnectionID{} = "retire_connection_id"+frameType PathChallenge{} = "path_challenge"+frameType PathResponse{} = "path_response"+frameType ConnectionClose{} = "connection_close"+frameType ConnectionCloseApp{} = "connection_close"+frameType HandshakeDone{} = "handshake_done"+frameType UnknownFrame{} = "unknown"  {-# INLINE frameExtra #-} frameExtra :: Frame -> LogStr frameExtra (Padding n) = ",\"payload_length\":" <> sw n-frameExtra  Ping = ""+frameExtra Ping = "" frameExtra (Ack ai _Delay) = ",\"acked_ranges\":" <> ack ai frameExtra ResetStream{} = "" frameExtra (StopSending _StreamId _ApplicationError) = ""-frameExtra (CryptoF off dat) =  ",\"offset\":\"" <> sw off <> "\",\"length\":" <> sw (BS.length dat)+frameExtra (CryptoF off dat) = ",\"offset\":\"" <> sw off <> "\",\"length\":" <> sw (BS.length dat) frameExtra (NewToken _Token) = ""-frameExtra (StreamF sid off dat fin) = ",\"stream_id\":\"" <> sw sid <> "\",\"offset\":\"" <> sw off <> "\",\"length\":" <> sw (sum' $ map BS.length dat) <> ",\"fin\":" <> if fin then "true" else "false"+frameExtra (StreamF sid off dat fin) =+    ",\"stream_id\":\""+        <> sw sid+        <> "\",\"offset\":\""+        <> sw off+        <> "\",\"length\":"+        <> sw (sum' $ map BS.length dat)+        <> ",\"fin\":"+        <> if fin then "true" else "false" frameExtra (MaxData mx) = ",\"maximum\":\"" <> sw mx <> "\"" frameExtra (MaxStreamData sid mx) = ",\"stream_id\":\"" <> sw sid <> "\",\"maximum\":\"" <> sw mx <> "\"" frameExtra (MaxStreams _Direction ms) = ",\"maximum\":\"" <> sw ms <> "\"" frameExtra DataBlocked{} = "" frameExtra StreamDataBlocked{} = "" frameExtra StreamsBlocked{} = ""-frameExtra (NewConnectionID (CIDInfo sn cid _) rpt) = ",\"sequence_number\":\"" <> sw sn <> "\",\"connection_id:\":\"" <> sw cid <> "\",\"retire_prior_to\":\"" <> sw rpt <> "\""+frameExtra (NewConnectionID (CIDInfo sn cid _) rpt) =+    ",\"sequence_number\":\""+        <> sw sn+        <> "\",\"connection_id:\":\""+        <> sw cid+        <> "\",\"retire_prior_to\":\""+        <> sw rpt+        <> "\"" frameExtra (RetireConnectionID sn) = ",\"sequence_number\":\"" <> sw sn <> "\"" frameExtra (PathChallenge _PathData) = "" frameExtra (PathResponse _PathData) = ""-frameExtra (ConnectionClose err _FrameType reason) = ",\"error_space\":\"transport\",\"error_code\":\"" <> transportError err <> "\",\"raw_error_code\":" <> transportError' err <> ",\"reason\":\"" <> toLogStr (Short.fromShort reason) <> "\""-frameExtra (ConnectionCloseApp err reason) =  ",\"error_space\":\"application\",\"error_code\":" <> applicationProtoclError err <> ",\"reason\":\"" <> toLogStr (Short.fromShort reason) <> "\"" -- fixme+frameExtra (ConnectionClose err _FrameType reason) =+    ",\"error_space\":\"transport\",\"error_code\":\""+        <> transportError err+        <> "\",\"raw_error_code\":"+        <> transportError' err+        <> ",\"reason\":\""+        <> toLogStr (Short.fromShort reason)+        <> "\""+frameExtra (ConnectionCloseApp err reason) =+    ",\"error_space\":\"application\",\"error_code\":"+        <> applicationProtoclError err+        <> ",\"reason\":\""+        <> toLogStr (Short.fromShort reason)+        <> "\"" -- fixme frameExtra HandshakeDone{} = "" frameExtra (UnknownFrame _Int) = ""  transportError :: TransportError -> LogStr-transportError NoError                 = "no_error"-transportError InternalError           = "internal_error"-transportError ConnectionRefused       = "connection_refused"-transportError FlowControlError        = "flow_control_error"-transportError StreamLimitError        = "stream_limit_error"-transportError StreamStateError        = "stream_state_error"-transportError FinalSizeError          = "final_size_error"-transportError FrameEncodingError      = "frame_encoding_error"+transportError NoError = "no_error"+transportError InternalError = "internal_error"+transportError ConnectionRefused = "connection_refused"+transportError FlowControlError = "flow_control_error"+transportError StreamLimitError = "stream_limit_error"+transportError StreamStateError = "stream_state_error"+transportError FinalSizeError = "final_size_error"+transportError FrameEncodingError = "frame_encoding_error" transportError TransportParameterError = "transport_parameter_err"-transportError ConnectionIdLimitError  = "connection_id_limit_error"-transportError ProtocolViolation       = "protocol_violation"-transportError InvalidToken            = "invalid_migration"-transportError CryptoBufferExceeded    = "crypto_buffer_exceeded"-transportError KeyUpdateError          = "key_update_error"-transportError AeadLimitReached        = "aead_limit_reached"-transportError NoViablePath            = "no_viablpath"-transportError (TransportError n)      = sw n+transportError ConnectionIdLimitError = "connection_id_limit_error"+transportError ProtocolViolation = "protocol_violation"+transportError InvalidToken = "invalid_migration"+transportError CryptoBufferExceeded = "crypto_buffer_exceeded"+transportError KeyUpdateError = "key_update_error"+transportError AeadLimitReached = "aead_limit_reached"+transportError NoViablePath = "no_viablpath"+transportError (TransportError n) = sw n  transportError' :: TransportError -> LogStr-transportError' (TransportError n)     = sw n+transportError' (TransportError n) = sw n  applicationProtoclError :: ApplicationProtocolError -> LogStr applicationProtoclError (ApplicationProtocolError n) = sw n@@ -153,12 +190,13 @@ ack (AckInfo lpn r rs) = "[" <> ack1 fr fpn rs <> "]"   where     fpn = fromIntegral lpn - r-    fr | r == 0    = "[" <> sw lpn <> "]"-       | otherwise = "[" <> sw fpn <> "," <> sw lpn <> "]"+    fr+        | r == 0 = "[" <> sw lpn <> "]"+        | otherwise = "[" <> sw fpn <> "," <> sw lpn <> "]"  ack1 :: LogStr -> Range -> [(Gap, Range)] -> LogStr-ack1 ret _ []   = ret-ack1 ret fpn ((g,r):grs) = ack1 ret' f grs+ack1 ret _ [] = ret+ack1 ret fpn ((g, r) : grs) = ack1 ret' f grs   where     ret' = "[" <> sw f <> "," <> sw l <> "]," <> ret     l = fpn - g - 2@@ -166,29 +204,35 @@  ---------------------------------------------------------------- -instance Qlog (Parameters,String) where-    qlog (Parameters{..},owner) =-               "{\"owner\":\"" <> toLogStr owner-          <> "\",\"initial_max_data\":\"" <> sw initialMaxData-          <> "\",\"initial_max_stream_data_bidi_local\":\"" <> sw initialMaxStreamDataBidiLocal-          <> "\",\"initial_max_stream_data_bidi_remote\":\"" <> sw initialMaxStreamDataBidiRemote-          <> "\",\"initial_max_stream_data_uni\":\"" <> sw initialMaxStreamDataUni-          <> "\"}"+instance Qlog (Parameters, String) where+    qlog (Parameters{..}, owner) =+        "{\"owner\":\""+            <> toLogStr owner+            <> "\",\"initial_max_data\":\""+            <> sw initialMaxData+            <> "\",\"initial_max_stream_data_bidi_local\":\""+            <> sw initialMaxStreamDataBidiLocal+            <> "\",\"initial_max_stream_data_bidi_remote\":\""+            <> sw initialMaxStreamDataBidiRemote+            <> "\",\"initial_max_stream_data_uni\":\""+            <> sw initialMaxStreamDataUni+            <> "\"}"  ---------------------------------------------------------------- -data QlogMsg = QRecvInitial-             | QSentRetry-             | QSent LogStr TimeMicrosecond-             | QReceived LogStr TimeMicrosecond-             | QDropped LogStr TimeMicrosecond-             | QMetricsUpdated LogStr TimeMicrosecond-             | QPacketLost LogStr TimeMicrosecond-             | QCongestionStateUpdated LogStr TimeMicrosecond-             | QLossTimerUpdated LogStr TimeMicrosecond-             | QDebug LogStr TimeMicrosecond-             | QParamsSet LogStr TimeMicrosecond-             | QCIDUpdate LogStr TimeMicrosecond+data QlogMsg+    = QRecvInitial+    | QSentRetry+    | QSent LogStr TimeMicrosecond+    | QReceived LogStr TimeMicrosecond+    | QDropped LogStr TimeMicrosecond+    | QMetricsUpdated LogStr TimeMicrosecond+    | QPacketLost LogStr TimeMicrosecond+    | QCongestionStateUpdated LogStr TimeMicrosecond+    | QLossTimerUpdated LogStr TimeMicrosecond+    | QDebug LogStr TimeMicrosecond+    | QParamsSet LogStr TimeMicrosecond+    | QCIDUpdate LogStr TimeMicrosecond  {-# INLINE toLogStrTime #-} toLogStrTime :: QlogMsg -> TimeMicrosecond -> LogStr@@ -197,25 +241,65 @@ toLogStrTime QSentRetry _ =     "{\"time\":0,\"name\":\"transport:packet_sent\",\"data\":{\"header\":{\"packet_type\":\"retry\",\"packet_number\":\"\"}}}\n" toLogStrTime (QReceived msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:packet_received\",\"data\":" <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"transport:packet_received\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QSent msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:packet_sent\",\"data\":"     <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"transport:packet_sent\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QDropped msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:packet_dropped\",\"data\":"  <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"transport:packet_dropped\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QParamsSet msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:parameters_set\",\"data\":"  <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"transport:parameters_set\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QMetricsUpdated msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:metrics_updated\",\"data\":"  <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"recovery:metrics_updated\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QPacketLost msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:packet_lost\",\"data\":"      <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"recovery:packet_lost\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QCongestionStateUpdated msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:congestion_state_updated\",\"data\":" <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"recovery:congestion_state_updated\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QLossTimerUpdated msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:loss_timer_updated\",\"data\":" <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"recovery:loss_timer_updated\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QDebug msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"debug\",\"data\":" <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"debug\",\"data\":"+        <> msg+        <> "}\n" toLogStrTime (QCIDUpdate msg tim) base =-    "{\"time\":" <> swtim tim base <> ",\"name\":\"connectivity:connection_id_updated\",\"data\":" <> msg <> "}\n"+    "{\"time\":"+        <> swtim tim base+        <> ",\"name\":\"connectivity:connection_id_updated\",\"data\":"+        <> msg+        <> "}\n"  ---------------------------------------------------------------- @@ -228,7 +312,7 @@ swtim tim base = toLogStr (show m ++ "." ++ show u)   where     Microseconds x = elapsedTimeMicrosecond tim base-    (m,u) = x `divMod` 1000+    (m, u) = x `divMod` 1000  ---------------------------------------------------------------- @@ -237,7 +321,16 @@ newQlogger :: TimeMicrosecond -> ByteString -> CID -> FastLogger -> IO QLogger newQlogger base rl ocid fastLogger = do     let ocid' = toLogStr $ enc16 $ fromCID ocid-    fastLogger $ "{\"qlog_format\":\"NDJSON\",\"qlog_version\":\"draft-02\",\"title\":\"Haskell quic qlog\",\"trace\":{\"vantage_point\":{\"type\":\"" <> toLogStr rl <> "\"},\"common_fields\":{\"ODCID\":\"" <> ocid' <> "\",\"group_id\":\"" <> ocid' <> "\",\"reference_time\":" <> swtim base timeMicrosecond0 <>  "}}}\n"+    fastLogger $+        "{\"qlog_format\":\"NDJSON\",\"qlog_version\":\"draft-02\",\"title\":\"Haskell quic qlog\",\"trace\":{\"vantage_point\":{\"type\":\""+            <> toLogStr rl+            <> "\"},\"common_fields\":{\"ODCID\":\""+            <> ocid'+            <> "\",\"group_id\":\""+            <> ocid'+            <> "\",\"reference_time\":"+            <> swtim base timeMicrosecond0+            <> "}}}\n"     let qlogger qmsg = do             let msg = toLogStrTime qmsg base             fastLogger msg@@ -262,7 +355,7 @@ qlogSentRetry :: KeepQlog q => q -> IO () qlogSentRetry q = keepQlog q QSentRetry -qlogParamsSet :: KeepQlog q => q -> (Parameters,String) -> IO ()+qlogParamsSet :: KeepQlog q => q -> (Parameters, String) -> IO () qlogParamsSet q params = do     tim <- getTimeMicrosecond     keepQlog q $ QParamsSet (qlog params) tim

@@ -2,11 +2,12 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Receiver (-    receiver-  ) where+    receiver,+) where  import qualified Data.ByteString as BS-import Network.TLS (AlertDescription(..))+import Network.Control+import Network.TLS (AlertDescription (..)) import UnliftIO.Concurrent (forkIO) import qualified UnliftIO.Exception as E @@ -23,7 +24,7 @@ import Network.QUIC.Recovery import Network.QUIC.Server.Reader (runNewServerReader) import Network.QUIC.Stream-import Network.QUIC.Types+import Network.QUIC.Types as QUIC  receiver :: Connection -> IO () receiver conn = handleLogT logAction body@@ -37,13 +38,14 @@         ito <- readMinIdleTimeout conn         mx <- timeout ito "recvTimeout" $ connRecv conn -- fixme: taking minimum with peer's one         case mx of-          Nothing -> do-              st <- getConnectionState conn-              let msg0 | isClient conn = "Client"-                       | otherwise     = "Server"-                  msg = msg0 ++ " " ++ show st-              E.throwIO $ ConnectionIsTimeout msg-          Just x  -> return x+            Nothing -> do+                st <- getConnectionState conn+                let msg0+                        | isClient conn = "Client"+                        | otherwise = "Server"+                    msg = msg0 ++ " " ++ show st+                E.throwIO $ ConnectionIsTimeout msg+            Just x -> return x     loopHandshake = do         rpkt <- recvTimeout         processReceivedPacketHandshake conn rpkt@@ -55,70 +57,88 @@             cid = headerMyCID hdr         included <- myCIDsInclude conn cid         case included of-          Just nseq -> do-            shouldUpdate <- shouldUpdateMyCID conn nseq-            when shouldUpdate $ do-                setMyCID conn cid-                cidInfo <- getNewMyCID conn-                when (isServer conn) $ do-                    register <- getRegister conn-                    register (cidInfoCID cidInfo) conn-                sendFrames conn RTT1Level [NewConnectionID cidInfo 0]-            processReceivedPacket conn rpkt-            shouldUpdatePeer <- if shouldUpdate then shouldUpdatePeerCID conn-                                                else return False-            when shouldUpdatePeer $ choosePeerCIDForPrivacy conn-          _ -> do-            qlogDropped conn hdr-            connDebugLog conn $ bhow cid <> " is unknown"+            Just nseq -> do+                shouldUpdate <- shouldUpdateMyCID conn nseq+                when shouldUpdate $ do+                    setMyCID conn cid+                    cidInfo <- getNewMyCID conn+                    when (isServer conn) $ do+                        register <- getRegister conn+                        register (cidInfoCID cidInfo) conn+                    sendFrames conn RTT1Level [NewConnectionID cidInfo 0]+                processReceivedPacket conn rpkt+                shouldUpdatePeer <-+                    if shouldUpdate+                        then shouldUpdatePeerCID conn+                        else return False+                when shouldUpdatePeer $ choosePeerCIDForPrivacy conn+            _ -> do+                qlogDropped conn hdr+                connDebugLog conn $ bhow cid <> " is unknown"     logAction msg = connDebugLog conn ("debug: receiver: " <> msg)  processReceivedPacketHandshake :: Connection -> ReceivedPacket -> IO () processReceivedPacketHandshake conn rpkt = do     let CryptPacket hdr _ = rpCryptPacket rpkt         lvl = rpEncryptionLevel rpkt-        msg = "processReceivedPacketHandshake " ++ if isServer conn then "Server" else "Client"+        msg =+            "processReceivedPacketHandshake "+                ++ if isServer conn then "Server" else "Client"     mx <- timeout (Microseconds 10000) msg $ waitEncryptionLevel conn lvl     case mx of-      Nothing -> do-          putOffCrypto conn lvl rpkt-          when (isClient conn) $ do-              lvl' <- getEncryptionLevel conn-              speedup (connLDCC conn) lvl' "not decryptable"-      Just ()-        | isClient conn -> do-              when (lvl == InitialLevel) $ do-                  peercid <- getPeerCID conn-                  let newPeerCID = headerPeerCID hdr-                  when (peercid /= headerPeerCID hdr) $-                      resetPeerCID conn newPeerCID-                  setPeerAuthCIDs conn $ \auth ->-                      auth { initSrcCID = Just newPeerCID }-              case hdr of-                Initial peerVer _ _ _ -> do-                    myVer <- getVersion conn-                    let myOrigiVer = getOriginalVersion conn-                        firstTime = myVer == myOrigiVer-                    when (firstTime && myVer /= peerVer) $ do-                        setVersion conn peerVer-                        dcid <- getClientDstCID conn-                        initializeCoder conn InitialLevel $ initialSecrets peerVer dcid-                _ -> return ()-              processReceivedPacket conn rpkt-        | otherwise -> do-              mycid <- getMyCID conn-              when (lvl == HandshakeLevel-                    || (lvl == InitialLevel && mycid == headerMyCID hdr)) $ do-                  setAddressValidated conn-              when (lvl == HandshakeLevel) $ do-                  let ldcc = connLDCC conn-                  discarded <- getAndSetPacketNumberSpaceDiscarded ldcc InitialLevel-                  unless discarded $ fire conn (Microseconds 100000) $ do-                      dropSecrets conn InitialLevel-                      clearCryptoStream conn InitialLevel-                      onPacketNumberSpaceDiscarded ldcc InitialLevel-              processReceivedPacket conn rpkt+        Nothing -> do+            putOffCrypto conn lvl rpkt+            when (isClient conn) $ do+                lvl' <- getEncryptionLevel conn+                speedup (connLDCC conn) lvl' "not decryptable"+        Just ()+            | isClient conn -> do+                when (lvl == InitialLevel) $ do+                    peercid <- getPeerCID conn+                    let newPeerCID = headerPeerCID hdr+                    when (peercid /= headerPeerCID hdr) $+                        resetPeerCID conn newPeerCID+                    setPeerAuthCIDs conn $ \auth ->+                        auth{initSrcCID = Just newPeerCID}+                case hdr of+                    Initial peerVer _ _ _ -> do+                        myVer <- getVersion conn+                        let myOrigiVer = getOriginalVersion conn+                            firstTime = myVer == myOrigiVer+                        when (firstTime && myVer /= peerVer) $ do+                            setVersion conn peerVer+                            dcid <- getClientDstCID conn+                            initializeCoder conn InitialLevel $ initialSecrets peerVer dcid+                    _ -> return ()+                processReceivedPacket conn rpkt+            | otherwise -> do+                mycid <- getMyCID conn+                when+                    ( lvl == HandshakeLevel+                        || (lvl == InitialLevel && mycid == headerMyCID hdr)+                    )+                    $ do+                        setAddressValidated conn+                when (lvl == HandshakeLevel) $ do+                    let ldcc = connLDCC conn+                    discarded <- getAndSetPacketNumberSpaceDiscarded ldcc InitialLevel+                    unless discarded $ fire conn (Microseconds 100000) $ do+                        dropSecrets conn InitialLevel+                        clearCryptoStream conn InitialLevel+                        onPacketNumberSpaceDiscarded ldcc InitialLevel+                processReceivedPacket conn rpkt +rateLimit :: Int+rateLimit = 10++checkRate :: [Frame] -> Int+checkRate fs0 = go fs0 0+  where+    go [] n = n+    go (f : fs) n+        | rateControled f = go fs (n + 1)+        | otherwise = go fs n+ processReceivedPacket :: Connection -> ReceivedPacket -> IO () processReceivedPacket conn rpkt = do     let CryptPacket hdr crypt = rpCryptPacket rpkt@@ -126,69 +146,82 @@         tim = rpTimeRecevied rpkt     mplain <- decryptCrypt conn crypt lvl     case mplain of-      Just plain@Plain{..} -> do-          addRxBytes conn $ rpReceivedBytes rpkt-          when (isIllegalReservedBits plainMarks || isNoFrames plainMarks) $-              closeConnection ProtocolViolation "Non 0 RR bits or no frames"-          when (isUnknownFrame plainMarks) $-              closeConnection FrameEncodingError "Unknown frame"-          -- For Ping, record PPN first, then send an ACK.-          onPacketReceived (connLDCC conn) lvl plainPacketNumber-          when (lvl == RTT1Level) $ setPeerPacketNumber conn plainPacketNumber-          qlogReceived conn (PlainPacket hdr plain) tim-          let ackEli   = any ackEliciting   plainFrames-          case cryptMigraionInfo crypt of-            Nothing -> return ()-            Just miginfo ->-                void . forkIO $ runNewServerReader conn miginfo-          (ckp,cpn) <- getCurrentKeyPhase conn-          let Flags flags = plainFlags-              nkp = flags `testBit` 2-          when (nkp /= ckp && plainPacketNumber > cpn) $ do-              setCurrentKeyPhase conn nkp plainPacketNumber-              updateCoder1RTT conn ckp -- ckp is now next-          mapM_ (processFrame conn lvl) plainFrames-          when ackEli $ do-              case lvl of-                RTT0Level -> return ()-                RTT1Level -> delayedAck conn-                _         -> do-                    sup <- getSpeedingUp (connLDCC conn)-                    when sup $ do-                        qlogDebug conn $ Debug "ping for speedup"-                        sendFrames conn lvl [Ping]-      Nothing -> do-          statelessReset <- isStatelessReset conn hdr crypt-          if statelessReset then do-              qlogReceived conn StatelessReset tim-              connDebugLog conn "debug: connection is reset statelessly"-              E.throwIO ConnectionIsReset-            else do-              qlogDropped conn hdr-              connDebugLog conn $ "debug: cannot decrypt: " <> bhow lvl <> " size = " <> bhow (BS.length $ cryptPacket crypt)-              -- fixme: sending statelss reset+        Just plain@Plain{..} -> do+            addRxBytes conn $ rpReceivedBytes rpkt+            when (isIllegalReservedBits plainMarks || isNoFrames plainMarks) $+                closeConnection ProtocolViolation "Non 0 RR bits or no frames"+            when (isUnknownFrame plainMarks) $+                closeConnection FrameEncodingError "Unknown frame"+            let controlled = checkRate plainFrames+            when (controlled /= 0) $ do+                rate <- addRate (controlRate conn) controlled+                when (rate > rateLimit) $ do+                    closeConnection QUIC.InternalError "Rate control"+            -- For Ping, record PPN first, then send an ACK.+            onPacketReceived (connLDCC conn) lvl plainPacketNumber+            when (lvl == RTT1Level) $ setPeerPacketNumber conn plainPacketNumber+            qlogReceived conn (PlainPacket hdr plain) tim+            let ackEli = any ackEliciting plainFrames+            case cryptMigraionInfo crypt of+                Nothing -> return ()+                Just miginfo ->+                    void . forkIO $ runNewServerReader conn miginfo+            (ckp, cpn) <- getCurrentKeyPhase conn+            let Flags flags = plainFlags+                nkp = flags `testBit` 2+            when (nkp /= ckp && plainPacketNumber > cpn) $ do+                setCurrentKeyPhase conn nkp plainPacketNumber+                updateCoder1RTT conn ckp -- ckp is now next+            mapM_ (processFrame conn lvl) plainFrames+            when ackEli $ do+                case lvl of+                    RTT0Level -> return ()+                    RTT1Level -> delayedAck conn+                    _ -> do+                        sup <- getSpeedingUp (connLDCC conn)+                        when sup $ do+                            qlogDebug conn $ Debug "ping for speedup"+                            sendFrames conn lvl [Ping]+        Nothing -> do+            statelessReset <- isStatelessReset conn hdr crypt+            if statelessReset+                then do+                    qlogReceived conn StatelessReset tim+                    connDebugLog conn "debug: connection is reset statelessly"+                    E.throwIO ConnectionIsReset+                else do+                    qlogDropped conn hdr+                    connDebugLog conn $+                        "debug: cannot decrypt: "+                            <> bhow lvl+                            <> " size = "+                            <> bhow (BS.length $ cryptPacket crypt) +-- fixme: sending statelss reset+ isSendOnly :: Connection -> StreamId -> Bool isSendOnly conn sid-  | isClient conn = isClientInitiatedUnidirectional sid-  | otherwise     = isServerInitiatedUnidirectional sid+    | isClient conn = isClientInitiatedUnidirectional sid+    | otherwise = isServerInitiatedUnidirectional sid  isReceiveOnly :: Connection -> StreamId -> Bool isReceiveOnly conn sid-  | isClient conn = isServerInitiatedUnidirectional sid-  | otherwise     = isClientInitiatedUnidirectional sid+    | isClient conn = isServerInitiatedUnidirectional sid+    | otherwise = isClientInitiatedUnidirectional sid  isInitiated :: Connection -> StreamId -> Bool isInitiated conn sid-  | isClient conn = isClientInitiated sid-  | otherwise     = isServerInitiated sid+    | isClient conn = isClientInitiated sid+    | otherwise = isServerInitiated sid  guardStream :: Connection -> StreamId -> Maybe Stream -> IO () guardStream conn sid Nothing-  | isInitiated conn sid = do+    | isInitiated conn sid = do         curSid <- getMyStreamId conn         when (sid > curSid) $-            closeConnection StreamStateError "a locally-initiated stream that has not yet been created"+            closeConnection+                StreamStateError+                "a locally-initiated stream that has not yet been created" guardStream _ _ _ = return ()  processFrame :: Connection -> EncryptionLevel -> Frame -> IO ()@@ -206,12 +239,12 @@         closeConnection StreamStateError "Received in a send-only stream"     mstrm <- findStream conn sid     case mstrm of-      Nothing   -> return ()-      Just strm -> do-          onResetStreamReceived (connHooks conn) strm aerr-          setTxStreamClosed strm-          setRxStreamClosed strm-          delStream conn strm+        Nothing -> return ()+        Just strm -> do+            onResetStreamReceived (connHooks conn) strm aerr+            setTxStreamClosed strm+            setRxStreamClosed strm+            delStream conn strm processFrame conn lvl (StopSending sid err) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $         closeConnection ProtocolViolation "STOP_SENDING"@@ -219,10 +252,10 @@         closeConnection StreamStateError "Receive-only stream"     mstrm <- findStream conn sid     case mstrm of-      Nothing   -> do-          when (isInitiated conn sid) $-              closeConnection StreamStateError "No such stream for STOP_SENDING"-      Just _strm -> sendFrames conn lvl [ResetStream sid err 0]+        Nothing -> do+            when (isInitiated conn sid) $+                closeConnection StreamStateError "No such stream for STOP_SENDING"+        Just _strm -> sendFrames conn lvl [ResetStream sid err 0] processFrame _ _ (CryptoF _ "") = return () processFrame conn lvl (CryptoF off cdat) = do     when (lvl == RTT0Level) $@@ -230,24 +263,24 @@     let len = BS.length cdat         rx = RxStreamData cdat off len False     case lvl of-      InitialLevel   -> do-          dup <- putRxCrypto conn lvl rx-          when dup $ speedup (connLDCC conn) lvl "duplicated"-      RTT0Level -> do-          connDebugLog conn $ "processFrame: invalid packet type " <> bhow lvl-      HandshakeLevel -> do-          dup <- putRxCrypto conn lvl rx-          when dup $ speedup (connLDCC conn) lvl "duplicated"-      RTT1Level-        | isClient conn ->-              void $ putRxCrypto conn lvl rx-        | otherwise ->-              closeConnection (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT"+        InitialLevel -> do+            dup <- putRxCrypto conn lvl rx+            when dup $ speedup (connLDCC conn) lvl "duplicated"+        RTT0Level -> do+            connDebugLog conn $ "processFrame: invalid packet type " <> bhow lvl+        HandshakeLevel -> do+            dup <- putRxCrypto conn lvl rx+            when dup $ speedup (connLDCC conn) lvl "duplicated"+        RTT1Level+            | isClient conn ->+                void $ putRxCrypto conn lvl rx+            | otherwise ->+                closeConnection (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT" processFrame conn lvl (NewToken token) = do     when (isServer conn || lvl /= RTT1Level) $         closeConnection ProtocolViolation "NEW_TOKEN for server or in 1-RTT"     when (isClient conn) $ setNewToken conn token-processFrame conn RTT0Level (StreamF sid off (dat:_) fin) = do+processFrame conn RTT0Level (StreamF sid off (dat : _) fin) = do     when (off == 0) $ updatePeerStreamId conn sid     -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit     ok <- checkRxMaxStreams conn sid@@ -261,13 +294,14 @@         rx = RxStreamData dat off len fin     fc <- putRxStreamData strm rx     case fc of-      -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit-      OverLimit -> closeConnection FlowControlError "Flow control error for stream in 0-RTT"-      Duplicated -> return ()-      Reassembled -> do-          ok' <- checkRxMaxData conn len-          -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit-          unless ok' $ closeConnection FlowControlError "Flow control error for connection in 0-RTT"+        -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit+        OverLimit -> closeConnection FlowControlError "Flow control error for stream in 0-RTT"+        Duplicated -> return ()+        Reassembled -> do+            ok' <- checkRxMaxData conn len+            -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit+            unless ok' $+                closeConnection FlowControlError "Flow control error for connection in 0-RTT" processFrame conn RTT1Level (StreamF sid _ [""] False) = do     -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit     ok <- checkRxMaxStreams conn sid@@ -276,7 +310,7 @@         closeConnection StreamStateError "send-only stream"     mstrm <- findStream conn sid     guardStream conn sid mstrm-processFrame conn RTT1Level (StreamF sid off (dat:_) fin) = do+processFrame conn RTT1Level (StreamF sid off (dat : _) fin) = do     when (off == 0) $ updatePeerStreamId conn sid     -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit     ok <- checkRxMaxStreams conn sid@@ -290,13 +324,14 @@         rx = RxStreamData dat off len fin     fc <- putRxStreamData strm rx     case fc of-      -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit-      OverLimit -> closeConnection FlowControlError "Flow control error for stream in 1-RTT"-      Duplicated -> return ()-      Reassembled -> do-          ok' <- checkRxMaxData conn len-          -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit-          unless ok' $ closeConnection FlowControlError "Flow control error for connection in 1-RTT"+        -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit+        OverLimit -> closeConnection FlowControlError "Flow control error for stream in 1-RTT"+        Duplicated -> return ()+        Reassembled -> do+            ok' <- checkRxMaxData conn len+            -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit+            unless ok' $+                closeConnection FlowControlError "Flow control error for connection in 1-RTT" processFrame conn lvl (MaxData n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $         closeConnection ProtocolViolation "MAX_DATA in Initial or Handshake"@@ -308,25 +343,24 @@         closeConnection StreamStateError "Receive-only stream"     mstrm <- findStream conn sid     case mstrm of-      Nothing   -> do-          when (isInitiated conn sid) $-              closeConnection StreamStateError "No such stream for MAX_STREAM_DATA"-      Just strm -> setTxMaxStreamData strm n+        Nothing -> do+            when (isInitiated conn sid) $+                closeConnection StreamStateError "No such stream for MAX_STREAM_DATA"+        Just strm -> setTxMaxStreamData strm n processFrame conn lvl (MaxStreams dir n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $         closeConnection ProtocolViolation "MAX_STREAMS in Initial or Handshake"-    when (n > 2^(60 :: Int)) $+    when (n > 2 ^ (60 :: Int)) $         closeConnection FrameEncodingError "Too large MAX_STREAMS"-    if dir == Bidirectional then-        setTxMaxStreams conn n-      else-        setTxUniMaxStreams conn n+    if dir == Bidirectional+        then setTxMaxStreams conn n+        else setTxUniMaxStreams conn n processFrame _conn _lvl DataBlocked{} = return () processFrame _conn _lvl (StreamDataBlocked _sid _) = return () processFrame _conn lvl (StreamsBlocked _dir n) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $         closeConnection ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake"-    when (n > 2^(60 :: Int)) $+    when (n > 2 ^ (60 :: Int)) $         closeConnection FrameEncodingError "Too large STREAMS_BLOCKED" processFrame conn lvl (NewConnectionID cidInfo rpt) = do     when (lvl == InitialLevel || lvl == HandshakeLevel) $@@ -341,11 +375,11 @@ processFrame conn RTT1Level (RetireConnectionID sn) = do     mcidInfo <- retireMyCID conn sn     case mcidInfo of-      Nothing -> return ()-      Just (CIDInfo _ cid _) -> do-          when (isServer conn) $ do-              unregister <- getUnregister conn-              unregister cid+        Nothing -> return ()+        Just (CIDInfo _ cid _) -> do+            when (isServer conn) $ do+                unregister <- getUnregister conn+                unregister cid processFrame conn RTT1Level (PathChallenge dat) =     sendFrames conn RTT1Level [PathResponse dat] processFrame conn RTT1Level (PathResponse dat) =@@ -384,21 +418,21 @@     let cid = headerMyCID hdr     included <- myCIDsInclude conn cid     case included of-      Just _ -> return False-      _      -> case decodeStatelessResetToken cryptPacket of-             Nothing    -> return False-             Just token -> isStatelessRestTokenValid conn cid token+        Just _ -> return False+        _ -> case decodeStatelessResetToken cryptPacket of+            Nothing -> return False+            Just token -> isStatelessRestTokenValid conn cid token  -- Return value indicates duplication. putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool putRxCrypto conn lvl rx = do     mstrm <- getCryptoStream conn lvl     case mstrm of-      Nothing   -> return False-      Just strm -> do-          let put = putCrypto conn . InpHandshake lvl-              putFin = return ()-          tryReassemble strm rx put putFin+        Nothing -> return False+        Just strm -> do+            let put = putCrypto conn . InpHandshake lvl+                putFin = return ()+            tryReassemble strm rx put putFin  killHandshaker :: Connection -> EncryptionLevel -> IO () killHandshaker conn lvl = putCrypto conn $ InpHandshake lvl ""

@@ -1,51 +1,51 @@ module Network.QUIC.Recovery (-  -- Interface-    checkWindowOpenSTM-  , takePingSTM-  , speedup-  , resender-  -- LossRecovery.hs-  , onPacketSent-  , onPacketReceived-  , onAckReceived-  , onPacketNumberSpaceDiscarded-  -- Metrics-  , setInitialCongestionWindow-  -- Misc-  , getPreviousRTT1PPNs-  , setPreviousRTT1PPNs-  , getSpeedingUp-  , getPacketNumberSpaceDiscarded-  , getAndSetPacketNumberSpaceDiscarded-  , setMaxAckDaley-  -- PeerPacketNumbers-  , getPeerPacketNumbers-  , fromPeerPacketNumbers-  , nullPeerPacketNumbers-  -- Persistent-  , findDuration-  , getPTO-  -- Release-  , releaseByRetry-  , releaseOldest-  -- Timer-  , beforeAntiAmp-  , ldccTimer-  -- Types-  , SentPacket-  , spPlainPacket-  , spTimeSent-  , spSentBytes-  , spEncryptionLevel-  , spPacketNumber-  , spPeerPacketNumbers-  , spAckEliciting-  , mkSentPacket-  , fixSentPacket-  , LDCC-  , newLDCC-  , qlogSent-  ) where+    -- Interface+    checkWindowOpenSTM,+    takePingSTM,+    speedup,+    resender,+    -- LossRecovery.hs+    onPacketSent,+    onPacketReceived,+    onAckReceived,+    onPacketNumberSpaceDiscarded,+    -- Metrics+    setInitialCongestionWindow,+    -- Misc+    getPreviousRTT1PPNs,+    setPreviousRTT1PPNs,+    getSpeedingUp,+    getPacketNumberSpaceDiscarded,+    getAndSetPacketNumberSpaceDiscarded,+    setMaxAckDaley,+    -- PeerPacketNumbers+    getPeerPacketNumbers,+    fromPeerPacketNumbers,+    nullPeerPacketNumbers,+    -- Persistent+    findDuration,+    getPTO,+    -- Release+    releaseByRetry,+    releaseOldest,+    -- Timer+    beforeAntiAmp,+    ldccTimer,+    -- Types+    SentPacket,+    spPlainPacket,+    spTimeSent,+    spSentBytes,+    spEncryptionLevel,+    spPacketNumber,+    spPeerPacketNumbers,+    spAckEliciting,+    mkSentPacket,+    fixSentPacket,+    LDCC,+    newLDCC,+    qlogSent,+) where  import Network.QUIC.Recovery.Interface import Network.QUIC.Recovery.LossRecovery

@@ -15,7 +15,6 @@  -- | Maximum reordering in time before time threshold loss detection --   considers a packet lost.  Specified as an RTT multiplier.- kTimeThreshold :: Microseconds -> Microseconds kTimeThreshold x = x + (x !>>. 3) -- 9/8 @@ -26,7 +25,7 @@  -- | Default limit on the initial bytes in flight. kInitialWindow :: Int -> Int---kInitialWindow pktSiz = min 14720 (10 * pktSiz)+-- kInitialWindow pktSiz = min 14720 (10 * pktSiz) kInitialWindow pktSiz = pktSiz !<<. 2 --  !<<. 1 is not good enough  -- | Minimum congestion window in bytes.

@@ -2,12 +2,12 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Recovery.Detect (-    releaseByPredicate-  , detectAndRemoveLostPackets-  , removePacketNumbers-  ) where+    releaseByPredicate,+    detectAndRemoveLostPackets,+    removePacketNumbers,+) where -import Data.Sequence (Seq, ViewL(..))+import Data.Sequence (Seq, ViewL (..)) import qualified Data.Sequence as Seq  import Network.QUIC.Imports@@ -17,11 +17,12 @@ import Network.QUIC.Recovery.Types import Network.QUIC.Types -releaseByPredicate :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)+releaseByPredicate+    :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket) releaseByPredicate ldcc@LDCC{..} lvl predicate = do     packets <- atomicModifyIORef' (sentPackets ! lvl) $ \(SentPackets db) ->-       let (pkts, db') = Seq.partition predicate db-       in (SentPackets db', pkts)+        let (pkts, db') = Seq.partition predicate db+         in (SentPackets db', pkts)     removePacketNumbers ldcc lvl packets     return packets @@ -29,48 +30,57 @@ detectAndRemoveLostPackets ldcc@LDCC{..} lvl = do     lae <- timeOfLastAckElicitingPacket <$> readIORef (lossDetection ! lvl)     when (lae == timeMicrosecond0) $-        qlogDebug ldcc $ Debug "detectAndRemoveLostPackets: timeOfLastAckElicitingPacket: 0"-    atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {-          lossTime = Nothing-        }+        qlogDebug ldcc $+            Debug "detectAndRemoveLostPackets: timeOfLastAckElicitingPacket: 0"+    atomicModifyIORef'' (lossDetection ! lvl) $ \ld ->+        ld+            { lossTime = Nothing+            }     RTT{..} <- readIORef recoveryRTT     LossDetection{..} <- readIORef (lossDetection ! lvl)     when (largestAckedPacket == -1) $-        qlogDebug ldcc $ Debug "detectAndRemoveLostPackets: largestAckedPacket: -1"+        qlogDebug ldcc $+            Debug "detectAndRemoveLostPackets: largestAckedPacket: -1"     -- Sec 6.1.2. Time Threshold     -- max(kTimeThreshold * max(smoothed_rtt, latest_rtt), kGranularity)     let lossDelay0 = kTimeThreshold $ max latestRTT smoothedRTT     let lossDelay = max lossDelay0 kGranularity      tm <- getPastTimeMicrosecond lossDelay-    let predicate ent = (spPacketNumber ent <= largestAckedPacket - kPacketThreshold)-                     || (spPacketNumber ent <= largestAckedPacket && spTimeSent ent <= tm)+    let predicate ent =+            (spPacketNumber ent <= largestAckedPacket - kPacketThreshold)+                || (spPacketNumber ent <= largestAckedPacket && spTimeSent ent <= tm)     lostPackets <- releaseByPredicate ldcc lvl predicate      mx <- findOldest ldcc lvl (\x -> spPacketNumber x <= largestAckedPacket)     case mx of-      -- No gap packet. PTO turn.-      Nothing -> return ()-      -- There are gap packets which are not declared lost.-      -- Set lossTime to next.-      Just x  -> do-          let next = spTimeSent x `addMicroseconds` lossDelay-          atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {-                lossTime = Just next-              }+        -- No gap packet. PTO turn.+        Nothing -> return ()+        -- There are gap packets which are not declared lost.+        -- Set lossTime to next.+        Just x -> do+            let next = spTimeSent x `addMicroseconds` lossDelay+            atomicModifyIORef'' (lossDetection ! lvl) $ \ld ->+                ld+                    { lossTime = Just next+                    }      unless (Seq.null lostPackets) $ qlogDebug ldcc $ Debug "loss detected"     return lostPackets -findOldest :: LDCC -> EncryptionLevel -> (SentPacket -> Bool)-           -> IO (Maybe SentPacket)+findOldest+    :: LDCC+    -> EncryptionLevel+    -> (SentPacket -> Bool)+    -> IO (Maybe SentPacket) findOldest LDCC{..} lvl p = oldest <$> readIORef (sentPackets ! lvl)   where     oldest (SentPackets db) = case Seq.viewl $ Seq.filter p db of-      EmptyL -> Nothing-      x :< _ -> Just x+        EmptyL -> Nothing+        x :< _ -> Just x -removePacketNumbers :: Foldable t => LDCC -> EncryptionLevel -> t SentPacket -> IO ()+removePacketNumbers+    :: Foldable t => LDCC -> EncryptionLevel -> t SentPacket -> IO () removePacketNumbers ldcc lvl packets = mapM_ reduce packets   where     reduce x = reducePeerPacketNumbers ldcc lvl ppns

@@ -2,11 +2,11 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Recovery.Interface (-    checkWindowOpenSTM-  , takePingSTM-  , speedup-  , resender-  ) where+    checkWindowOpenSTM,+    takePingSTM,+    speedup,+    resender,+) where  import qualified Data.Sequence as Seq import System.Log.FastLogger (LogStr)@@ -38,7 +38,7 @@     setSpeedingUp ldcc     qlogDebug ldcc $ Debug desc     packets <- atomicModifyIORef' (sentPackets ! lvl) $-                  \(SentPackets db) -> (emptySentPackets, db)+        \(SentPackets db) -> (emptySentPackets, db)     -- don't clear PeerPacketNumbers.     unless (null packets) $ do         onPacketsLost ldcc packets

@@ -2,13 +2,13 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Recovery.LossRecovery (-    onPacketSent-  , onPacketReceived-  , onAckReceived-  , onPacketNumberSpaceDiscarded-  ) where+    onPacketSent,+    onPacketReceived,+    onAckReceived,+    onPacketNumberSpaceDiscarded,+) where -import Data.Sequence (Seq, (|>), ViewR(..))+import Data.Sequence (Seq, ViewR (..), (|>)) import qualified Data.Sequence as Seq import UnliftIO.STM @@ -31,25 +31,29 @@ onPacketSent :: LDCC -> SentPacket -> IO () onPacketSent ldcc@LDCC{..} sentPacket = do     let lvl0 = spEncryptionLevel sentPacket-    let lvl | lvl0 == RTT0Level = RTT1Level-            | otherwise         = lvl0+    let lvl+            | lvl0 == RTT0Level = RTT1Level+            | otherwise = lvl0     discarded <- getPacketNumberSpaceDiscarded ldcc lvl     unless discarded $ do         onPacketSentCC ldcc sentPacket         when (spAckEliciting sentPacket) $-            atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {-                timeOfLastAckElicitingPacket = spTimeSent sentPacket-              }+            atomicModifyIORef'' (lossDetection ! lvl) $ \ld ->+                ld+                    { timeOfLastAckElicitingPacket = spTimeSent sentPacket+                    }         atomicModifyIORef'' (sentPackets ! lvl) $             \(SentPackets db) -> SentPackets (db |> sentPacket)         setLossDetectionTimer ldcc lvl  onPacketSentCC :: LDCC -> SentPacket -> IO () onPacketSentCC ldcc@LDCC{..} sentPacket = metricsUpdated ldcc $-    atomically $ modifyTVar' recoveryCC $ \cc -> cc {-        bytesInFlight = bytesInFlight cc + sentBytes-      , numOfAckEliciting = numOfAckEliciting cc + countAckEli sentPacket-      }+    atomically $+        modifyTVar' recoveryCC $ \cc ->+            cc+                { bytesInFlight = bytesInFlight cc + sentBytes+                , numOfAckEliciting = numOfAckEliciting cc + countAckEli sentPacket+                }   where     sentBytes = spSentBytes sentPacket @@ -68,64 +72,72 @@     when changed $ do         let predicate = fromAckInfoToPred ackInfo . spPacketNumber         releaseLostCandidates ldcc lvl predicate >>= updateCConAck-        releaseByPredicate    ldcc lvl predicate >>= detectLossUpdateCC+        releaseByPredicate ldcc lvl predicate >>= detectLossUpdateCC   where     update ld@LossDetection{..} = (ld', changed)       where-        ld' = ld { largestAckedPacket = max largestAckedPacket largestAcked-                 , previousAckInfo = ackInfo-                 }+        ld' =+            ld+                { largestAckedPacket = max largestAckedPacket largestAcked+                , previousAckInfo = ackInfo+                }         changed = previousAckInfo /= ackInfo     detectLossUpdateCC newlyAckedPackets = case Seq.viewr newlyAckedPackets of-      EmptyR -> return ()-      _ :> lastPkt -> do-          -- If the largest acknowledged is newly acked and-          -- at least one ack-eliciting was newly acked, update the RTT.-          when (spPacketNumber lastPkt == largestAcked-             && any spAckEliciting newlyAckedPackets) $ do-              rtt <- getElapsedTimeMicrosecond $ spTimeSent lastPkt-              let latestRtt = max rtt kGranularity-              updateRTT ldcc lvl latestRtt ackDelay+        EmptyR -> return ()+        _ :> lastPkt -> do+            -- If the largest acknowledged is newly acked and+            -- at least one ack-eliciting was newly acked, update the RTT.+            when+                ( spPacketNumber lastPkt == largestAcked+                    && any spAckEliciting newlyAckedPackets+                )+                $ do+                    rtt <- getElapsedTimeMicrosecond $ spTimeSent lastPkt+                    let latestRtt = max rtt kGranularity+                    updateRTT ldcc lvl latestRtt ackDelay -          {- fimxe-          -- Process ECN information if present.-          if (ACK frame contains ECN information):-             ProcessECN(ack, lvl)-          -}+            {- fimxe+            -- Process ECN information if present.+            if (ACK frame contains ECN information):+               ProcessECN(ack, lvl)+            -} -          lostPackets <- detectAndRemoveLostPackets ldcc lvl-          unless (null lostPackets) $ do-              mode <- ccMode <$> readTVarIO recoveryCC-              if lvl == RTT1Level && mode /= SlowStart then-                  mergeLostCandidates ldcc lostPackets-                else do-                  -- just in case-                  lostPackets' <- mergeLostCandidatesAndClear ldcc lostPackets-                  onPacketsLost ldcc lostPackets'-                  retransmit ldcc lostPackets'-          -- setLossDetectionTimer in updateCConAck-          updateCConAck newlyAckedPackets+            lostPackets <- detectAndRemoveLostPackets ldcc lvl+            unless (null lostPackets) $ do+                mode <- ccMode <$> readTVarIO recoveryCC+                if lvl == RTT1Level && mode /= SlowStart+                    then mergeLostCandidates ldcc lostPackets+                    else do+                        -- just in case+                        lostPackets' <- mergeLostCandidatesAndClear ldcc lostPackets+                        onPacketsLost ldcc lostPackets'+                        retransmit ldcc lostPackets'+            -- setLossDetectionTimer in updateCConAck+            updateCConAck newlyAckedPackets      updateCConAck newlyAckedPackets-      | newlyAckedPackets == Seq.empty = return ()-      | otherwise = do-          onPacketsAcked ldcc newlyAckedPackets+        | newlyAckedPackets == Seq.empty = return ()+        | otherwise = do+            onPacketsAcked ldcc newlyAckedPackets -          -- Sec 6.2.1. Computing PTO-          -- "The PTO backoff factor is reset when an acknowledgement is-          --  received, except in the following case. A server might-          --  take longer to respond to packets during the handshake-          --  than otherwise. To protect such a server from repeated-          --  client probes, the PTO backoff is not reset at a client-          --  that is not yet certain that the server has finished-          --  validating the client's address."-          validated <- peerCompletedAddressValidation ldcc-          when validated $ metricsUpdated ldcc $-              atomicModifyIORef'' recoveryRTT $ \rtt -> rtt { ptoCount = 0 }+            -- Sec 6.2.1. Computing PTO+            -- "The PTO backoff factor is reset when an acknowledgement is+            --  received, except in the following case. A server might+            --  take longer to respond to packets during the handshake+            --  than otherwise. To protect such a server from repeated+            --  client probes, the PTO backoff is not reset at a client+            --  that is not yet certain that the server has finished+            --  validating the client's address."+            validated <- peerCompletedAddressValidation ldcc+            when validated $+                metricsUpdated ldcc $+                    atomicModifyIORef'' recoveryRTT $+                        \rtt -> rtt{ptoCount = 0} -          setLossDetectionTimer ldcc lvl+            setLossDetectionTimer ldcc lvl -releaseLostCandidates :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)+releaseLostCandidates+    :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket) releaseLostCandidates ldcc@LDCC{..} lvl predicate = do     packets <- atomically $ do         SentPackets db <- readTVar lostCandidates@@ -142,46 +154,51 @@     atomically $ modifyTVar' recoveryCC $ modify maxPktSiz     newcc <- readTVarIO recoveryCC     when (ccMode oldcc /= ccMode newcc) $-      qlogContestionStateUpdated ldcc $ ccMode newcc+        qlogContestionStateUpdated ldcc $+            ccMode newcc   where-    modify maxPktSiz cc@CC{..} = cc {-           bytesInFlight = bytesInFlight'-         , congestionWindow = congestionWindow'-         , bytesAcked = bytesAcked'-         , ccMode = ccMode'-         , numOfAckEliciting = numOfAckEliciting'-         }+    modify maxPktSiz cc@CC{..} =+        cc+            { bytesInFlight = bytesInFlight'+            , congestionWindow = congestionWindow'+            , bytesAcked = bytesAcked'+            , ccMode = ccMode'+            , numOfAckEliciting = numOfAckEliciting'+            }       where-        (bytesInFlight',congestionWindow',bytesAcked',ccMode',numOfAckEliciting') =-              foldl' (.+) (bytesInFlight,congestionWindow,bytesAcked,ccMode,numOfAckEliciting) ackedPackets-        (bytes,cwin,acked,_,cnt) .+ sp@SentPacket{..} = (bytes',cwin',acked',mode',cnt')+        (bytesInFlight', congestionWindow', bytesAcked', ccMode', numOfAckEliciting') =+            foldl'+                (.+)+                (bytesInFlight, congestionWindow, bytesAcked, ccMode, numOfAckEliciting)+                ackedPackets+        (bytes, cwin, acked, _, cnt) .+ sp@SentPacket{..} = (bytes', cwin', acked', mode', cnt')           where             isRecovery = inCongestionRecovery spTimeSent congestionRecoveryStartTime             bytes' = bytes - spSentBytes             ackedA = acked + spSentBytes             cnt' = cnt - countAckEli sp-            (cwin',acked',mode')-              -- Do not increase congestion window in recovery period.-              | isRecovery      = (cwin, acked, Recovery)-              -- fixme: Do not increase congestion_window if application-              -- limited or flow control limited.-              ---              -- Slow start.-              | cwin < ssthresh = (cwin + spSentBytes, acked, SlowStart)-              -- Congestion avoidance.-              -- In this implementation, maxPktSiz == spSentBytes.-              -- spSentBytes is large enough, so we don't care-              -- the roundup issue of `div`.-              | ackedA >= cwin  = (cwin + maxPktSiz, ackedA - cwin, Avoidance)-              | otherwise       = (cwin, ackedA, Avoidance)+            (cwin', acked', mode')+                -- Do not increase congestion window in recovery period.+                | isRecovery = (cwin, acked, Recovery)+                -- fixme: Do not increase congestion_window if application+                -- limited or flow control limited.+                --+                -- Slow start.+                | cwin < ssthresh = (cwin + spSentBytes, acked, SlowStart)+                -- Congestion avoidance.+                -- In this implementation, maxPktSiz == spSentBytes.+                -- spSentBytes is large enough, so we don't care+                -- the roundup issue of `div`.+                | ackedA >= cwin = (cwin + maxPktSiz, ackedA - cwin, Avoidance)+                | otherwise = (cwin, ackedA, Avoidance)  ----------------------------------------------------------------  onPacketNumberSpaceDiscarded :: LDCC -> EncryptionLevel -> IO () onPacketNumberSpaceDiscarded ldcc lvl = do-    let (lvl',label) = case lvl of-          InitialLevel -> (HandshakeLevel,"initial")-          _            -> (RTT1Level, "handshake")+    let (lvl', label) = case lvl of+            InitialLevel -> (HandshakeLevel, "initial")+            _ -> (RTT1Level, "handshake")     qlogDebug ldcc $ Debug (label <> " discarded")     void $ discard ldcc lvl     setLossDetectionTimer ldcc lvl'

@@ -1,13 +1,13 @@+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NamedFieldPuns #-}  module Network.QUIC.Recovery.Metrics (-    updateRTT-  , updateCC-  , metricsUpdated-  , setInitialCongestionWindow-  ) where+    updateRTT,+    updateCC,+    metricsUpdated,+    setInitialCongestionWindow,+) where  import Data.Sequence (Seq) import UnliftIO.STM@@ -35,19 +35,26 @@     --     -- smoothed_rtt = rtt_sample     -- rttvar = rtt_sample / 2-    update rtt@RTT{..} | latestRTT == Microseconds 0 = (rtt {-        latestRTT   = latestRTT0-      , minRTT      = latestRTT0-      , smoothedRTT = latestRTT0-      , rttvar      = latestRTT0 `unsafeShiftR` 1-      }, True)+    update rtt@RTT{..}+        | latestRTT == Microseconds 0 =+            ( rtt+                { latestRTT = latestRTT0+                , minRTT = latestRTT0+                , smoothedRTT = latestRTT0+                , rttvar = latestRTT0 `unsafeShiftR` 1+                }+            , True+            )     -- Others:-    update rtt@RTT{..} = (rtt {-        latestRTT   = latestRTT0-      , minRTT      = minRTT'-      , smoothedRTT = smoothedRTT'-      , rttvar      = rttvar'-      }, False)+    update rtt@RTT{..} =+        ( rtt+            { latestRTT = latestRTT0+            , minRTT = minRTT'+            , smoothedRTT = smoothedRTT'+            , rttvar = rttvar'+            }+        , False+        )       where         -- minRTT ignores ack delay.         minRTT' = min minRTT latestRTT0@@ -59,15 +66,19 @@         -- if (latest_rtt >= min_rtt + ack_delay):         --   adjusted_rtt = latest_rtt - ack_delay         adjustedRTT-          | latestRTT0 >= minRTT + ackDelay = latestRTT0 - ackDelay-          | otherwise                       = latestRTT0+            | latestRTT0 >= minRTT + ackDelay = latestRTT0 - ackDelay+            | otherwise = latestRTT0         -- rttvar_sample = abs(smoothed_rtt - adjusted_rtt)         -- rttvar = 3/4 * rttvar + 1/4 * rttvar_sample-        rttvar' = rttvar - (rttvar !>>. 2)+        rttvar' =+            rttvar+                - (rttvar !>>. 2)                 + (abs (smoothedRTT - adjustedRTT) !>>. 2)         -- smoothed_rtt = 7/8 * smoothed_rtt + 1/8 * adjusted_rtt-        smoothedRTT' = smoothedRTT - (smoothedRTT !>>. 3)-                     + (adjustedRTT !>>. 3)+        smoothedRTT' =+            smoothedRTT+                - (smoothedRTT !>>. 3)+                + (adjustedRTT !>>. 3)  updateCC :: LDCC -> Seq SentPacket -> Bool -> IO () updateCC ldcc@LDCC{..} lostPackets isRecovery = do@@ -78,27 +89,29 @@         metricsUpdated ldcc $ atomically $ modifyTVar' recoveryCC $ \cc@CC{..} ->             let halfWindow = max minWindow $ kLossReductionFactor congestionWindow                 cwin-                  | persistent = minWindow-                  | otherwise  = halfWindow-                sst            = halfWindow+                    | persistent = minWindow+                    | otherwise = halfWindow+                sst = halfWindow                 mode-                  | cwin < sst = SlowStart -- persistent-                  | otherwise  = Recovery-            in cc {-                congestionRecoveryStartTime = Just now-              , congestionWindow = cwin-              , ssthresh         = sst-              , ccMode           = mode-              , bytesAcked       = 0-              }+                    | cwin < sst = SlowStart -- persistent+                    | otherwise = Recovery+             in cc+                    { congestionRecoveryStartTime = Just now+                    , congestionWindow = cwin+                    , ssthresh = sst+                    , ccMode = mode+                    , bytesAcked = 0+                    }         CC{ccMode} <- readTVarIO recoveryCC         qlogContestionStateUpdated ldcc ccMode  setInitialCongestionWindow :: LDCC -> Int -> IO () setInitialCongestionWindow ldcc@LDCC{..} pktSiz = metricsUpdated ldcc $-    atomically $ do modifyTVar' recoveryCC $ \cc -> cc {-        congestionWindow = kInitialWindow pktSiz-      }+    atomically $ do+        modifyTVar' recoveryCC $ \cc ->+            cc+                { congestionWindow = kInitialWindow pktSiz+                }  ---------------------------------------------------------------- @@ -109,21 +122,22 @@     body     rtt1 <- readIORef recoveryRTT     cc1 <- readTVarIO recoveryCC-    let ~diff = catMaybes [-            time "min_rtt"      (minRTT      rtt0) (minRTT      rtt1)-          , time "smoothed_rtt" (smoothedRTT rtt0) (smoothedRTT rtt1)-          , time "latest_rtt"   (latestRTT   rtt0) (latestRTT   rtt1)-          , time "rtt_variance" (rttvar      rtt0) (rttvar      rtt1)-          , numb "pto_count"    (ptoCount    rtt0) (ptoCount    rtt1)-          , numb "bytes_in_flight"   (bytesInFlight cc0) (bytesInFlight cc1)-          , numb "congestion_window" (congestionWindow cc0) (congestionWindow cc1)-          , numb "ssthresh"          (ssthresh cc0) (ssthresh cc1)-          ]+    let ~diff =+            catMaybes+                [ time "min_rtt" (minRTT rtt0) (minRTT rtt1)+                , time "smoothed_rtt" (smoothedRTT rtt0) (smoothedRTT rtt1)+                , time "latest_rtt" (latestRTT rtt0) (latestRTT rtt1)+                , time "rtt_variance" (rttvar rtt0) (rttvar rtt1)+                , numb "pto_count" (ptoCount rtt0) (ptoCount rtt1)+                , numb "bytes_in_flight" (bytesInFlight cc0) (bytesInFlight cc1)+                , numb "congestion_window" (congestionWindow cc0) (congestionWindow cc1)+                , numb "ssthresh" (ssthresh cc0) (ssthresh cc1)+                ]     unless (null diff) $ qlogMetricsUpdated ldcc $ MetricsDiff diff   where     time tag (Microseconds v0) (Microseconds v1)-      | v0 == v1  = Nothing-      | otherwise = Just (tag,v1)+        | v0 == v1 = Nothing+        | otherwise = Just (tag, v1)     numb tag v0 v1-      | v0 == v1  = Nothing-      | otherwise = Just (tag,v1)+        | v0 == v1 = Nothing+        | otherwise = Just (tag, v1)

@@ -2,14 +2,14 @@ {-# LANGUAGE TupleSections #-}  module Network.QUIC.Recovery.Misc (-    getPktNumPersistent-  , setPktNumPersistent-  , setSpeedingUp-  , getSpeedingUp-  , getPacketNumberSpaceDiscarded-  , getAndSetPacketNumberSpaceDiscarded-  , setMaxAckDaley-  ) where+    getPktNumPersistent,+    setPktNumPersistent,+    setSpeedingUp,+    getSpeedingUp,+    getPacketNumberSpaceDiscarded,+    getAndSetPacketNumberSpaceDiscarded,+    setMaxAckDaley,+) where  import Data.IORef @@ -50,4 +50,4 @@  setMaxAckDaley :: LDCC -> Microseconds -> IO () setMaxAckDaley LDCC{..} delay0 =-    atomicModifyIORef'' recoveryRTT $ \rtt -> rtt { maxAckDelay1RTT = delay0 }+    atomicModifyIORef'' recoveryRTT $ \rtt -> rtt{maxAckDelay1RTT = delay0}

@@ -1,16 +1,16 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Recovery.PeerPacketNumbers (-    getPeerPacketNumbers-  , addPeerPacketNumbers-  , delPeerPacketNumbers-  , clearPeerPacketNumbers-  , reducePeerPacketNumbers-  , setPreviousRTT1PPNs-  , getPreviousRTT1PPNs-  , nullPeerPacketNumbers-  , fromPeerPacketNumbers-  ) where+    getPeerPacketNumbers,+    addPeerPacketNumbers,+    delPeerPacketNumbers,+    clearPeerPacketNumbers,+    reducePeerPacketNumbers,+    setPreviousRTT1PPNs,+    getPreviousRTT1PPNs,+    nullPeerPacketNumbers,+    fromPeerPacketNumbers,+) where  import qualified Data.IntSet as IntSet 

@@ -2,15 +2,15 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Recovery.Persistent (-    getMaxAckDelay-  , calcPTO-  , backOff-  , inPersistentCongestion-  , findDuration -- for testing-  , getPTO-  ) where+    getMaxAckDelay,+    calcPTO,+    backOff,+    inPersistentCongestion,+    findDuration, -- for testing+    getPTO,+) where -import Data.Sequence (Seq, ViewL(..))+import Data.Sequence (Seq, ViewL (..)) import qualified Data.Sequence as Seq import Data.UnixTime @@ -23,8 +23,8 @@ getMaxAckDelay :: Maybe EncryptionLevel -> Microseconds -> Microseconds getMaxAckDelay Nothing n = n getMaxAckDelay (Just lvl) n-  | lvl `elem` [InitialLevel,HandshakeLevel] = 0-  | otherwise                                = n+    | lvl `elem` [InitialLevel, HandshakeLevel] = 0+    | otherwise = n  -- Sec 6.2.1. Computing PTO -- PTO = smoothed_rtt + max(4*rttvar, kGranularity) + max_ack_delay@@ -42,48 +42,46 @@     pn <- getPktNumPersistent ldcc     let mduration = findDuration lostPackets pn     case mduration of-      Nothing -> return False-      Just duration -> do-          rtt <- readIORef recoveryRTT-          let pto = calcPTO rtt Nothing-              Microseconds congestionPeriod = kPersistentCongestionThreshold pto-              threshold = microSecondsToUnixDiffTime congestionPeriod-          return (duration > threshold)+        Nothing -> return False+        Just duration -> do+            rtt <- readIORef recoveryRTT+            let pto = calcPTO rtt Nothing+                Microseconds congestionPeriod = kPersistentCongestionThreshold pto+                threshold = microSecondsToUnixDiffTime congestionPeriod+            return (duration > threshold)  findDuration :: Seq SentPacket -> PacketNumber -> Maybe UnixDiffTime findDuration pkts0 pn = leftEdge pkts0 Nothing   where     leftEdge pkts mdiff = case Seq.viewl pkts' of-        EmptyL      -> mdiff+        EmptyL -> mdiff         l :< pkts'' -> case rightEdge (spPacketNumber l) pkts'' Nothing of-          (Nothing, pkts''') -> leftEdge pkts''' mdiff-          (Just r,  pkts''') ->-              let diff' = spTimeSent r `diffUnixTime` spTimeSent l-              in case mdiff of-                Nothing          -> leftEdge pkts''' $ Just diff'-                Just diff-                  | diff' > diff -> leftEdge pkts''' $ Just diff'-                  | otherwise    -> leftEdge pkts''' $ Just diff+            (Nothing, pkts''') -> leftEdge pkts''' mdiff+            (Just r, pkts''') ->+                let diff' = spTimeSent r `diffUnixTime` spTimeSent l+                 in case mdiff of+                        Nothing -> leftEdge pkts''' $ Just diff'+                        Just diff+                            | diff' > diff -> leftEdge pkts''' $ Just diff'+                            | otherwise -> leftEdge pkts''' $ Just diff       where         (_, pkts') = Seq.breakl (\x -> spAckEliciting x && spPacketNumber x >= pn) pkts     rightEdge n pkts Nothing = case Seq.viewl pkts of         EmptyL -> (Nothing, Seq.empty)         r :< pkts'-          | spPacketNumber r == n + 1 ->-              if spAckEliciting r then-                  rightEdge (n + 1) pkts' $ Just r-                else-                  rightEdge (n + 1) pkts' Nothing-          | otherwise -> (Nothing, pkts)+            | spPacketNumber r == n + 1 ->+                if spAckEliciting r+                    then rightEdge (n + 1) pkts' $ Just r+                    else rightEdge (n + 1) pkts' Nothing+            | otherwise -> (Nothing, pkts)     rightEdge n pkts mr0 = case Seq.viewl pkts of         EmptyL -> (mr0, Seq.empty)         r :< pkts'-          | spPacketNumber r == n + 1 ->-              if spAckEliciting r then-                  rightEdge (n + 1) pkts' $ Just r-                else-                  rightEdge (n + 1) pkts' mr0-          | otherwise -> (mr0, pkts)+            | spPacketNumber r == n + 1 ->+                if spAckEliciting r+                    then rightEdge (n + 1) pkts' $ Just r+                    else rightEdge (n + 1) pkts' mr0+            | otherwise -> (mr0, pkts)  getPTO :: LDCC -> IO Microseconds getPTO LDCC{..} = do

@@ -2,13 +2,13 @@ {-# LANGUAGE RecordWildCards #-}  module Network.QUIC.Recovery.Release (-    releaseByRetry-  , releaseOldest-  , discard-  , onPacketsLost-  ) where+    releaseByRetry,+    releaseOldest,+    discard,+    onPacketsLost,+) where -import Data.Sequence (Seq, (><), ViewL(..), ViewR(..))+import Data.Sequence (Seq, ViewL (..), ViewR (..), (><)) import qualified Data.Sequence as Seq import UnliftIO.STM @@ -27,7 +27,8 @@     decreaseCC ldcc packets     writeIORef (lossDetection ! lvl) initialLossDetection     metricsUpdated ldcc $-        atomicModifyIORef'' recoveryRTT $ \rtt -> rtt { ptoCount = 0 }+        atomicModifyIORef'' recoveryRTT $+            \rtt -> rtt{ptoCount = 0}     return packets  releaseByClear :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)@@ -48,16 +49,17 @@ releaseOldest ldcc@LDCC{..} lvl = do     mr <- atomicModifyIORef' (sentPackets ! lvl) oldest     case mr of-      Nothing   -> return ()-      Just spkt -> do-          delPeerPacketNumbers ldcc lvl $ spPacketNumber spkt-          decreaseCC ldcc [spkt]+        Nothing -> return ()+        Just spkt -> do+            delPeerPacketNumbers ldcc lvl $ spPacketNumber spkt+            decreaseCC ldcc [spkt]     return mr   where     oldest (SentPackets db) = case Seq.viewl db2 of-      x :< db2' -> let db' = db1 >< db2'-                   in (SentPackets db', Just x)-      _         ->    (SentPackets db, Nothing)+        x :< db2' ->+            let db' = db1 >< db2'+             in (SentPackets db', Just x)+        _ -> (SentPackets db, Nothing)       where         (db1, db2) = Seq.breakl spAckEliciting db @@ -65,12 +67,14 @@  onPacketsLost :: LDCC -> Seq SentPacket -> IO () onPacketsLost ldcc@LDCC{..} lostPackets = case Seq.viewr lostPackets of-  EmptyR -> return ()-  _ :> lastPkt -> do-    decreaseCC ldcc lostPackets-    isRecovery <- inCongestionRecovery (spTimeSent lastPkt) . congestionRecoveryStartTime <$> readTVarIO recoveryCC-    onCongestionEvent ldcc lostPackets isRecovery-    mapM_ (qlogPacketLost ldcc . LostPacket) lostPackets+    EmptyR -> return ()+    _ :> lastPkt -> do+        decreaseCC ldcc lostPackets+        isRecovery <-+            inCongestionRecovery (spTimeSent lastPkt) . congestionRecoveryStartTime+                <$> readTVarIO recoveryCC+        onCongestionEvent ldcc lostPackets isRecovery+        mapM_ (qlogPacketLost ldcc . LostPacket) lostPackets   where     onCongestionEvent = updateCC @@ -81,9 +85,9 @@     let sentBytes = sum' (spSentBytes <$> packets)         num = sum' (countAckEli <$> packets)     metricsUpdated ldcc $-        atomically $ modifyTVar' recoveryCC $ \cc ->-          cc {-            bytesInFlight = bytesInFlight cc - sentBytes--            , numOfAckEliciting = numOfAckEliciting cc - num-          }+        atomically $+            modifyTVar' recoveryCC $ \cc ->+                cc+                    { bytesInFlight = bytesInFlight cc - sentBytes+                    , numOfAckEliciting = numOfAckEliciting cc - num+                    }

@@ -3,12 +3,12 @@ {-# LANGUAGE TupleSections #-}  module Network.QUIC.Recovery.Timer (-    getLossTimeAndSpace-  , getPtoTimeAndSpace-  , setLossDetectionTimer-  , beforeAntiAmp-  , ldccTimer-  ) where+    getLossTimeAndSpace,+    getPtoTimeAndSpace,+    setLossDetectionTimer,+    beforeAntiAmp,+    ldccTimer,+) where  import qualified Data.Sequence as Seq import Network.QUIC.Event@@ -17,6 +17,7 @@ import Network.QUIC.Connector import Network.QUIC.Imports import Network.QUIC.Qlog+import Network.QUIC.Recovery.Constants import Network.QUIC.Recovery.Detect import Network.QUIC.Recovery.Metrics import Network.QUIC.Recovery.Misc@@ -24,7 +25,6 @@ import Network.QUIC.Recovery.Release import Network.QUIC.Recovery.Types import Network.QUIC.Recovery.Utils-import Network.QUIC.Recovery.Constants import Network.QUIC.Types  ----------------------------------------------------------------@@ -34,20 +34,20 @@     SentPackets db <- readIORef (sentPackets ! lvl)     return $ Seq.null db -getLossTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond,EncryptionLevel))+getLossTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel)) getLossTimeAndSpace LDCC{..} =     loop [InitialLevel, HandshakeLevel, RTT1Level] Nothing   where-    loop []     r = return r-    loop (l:ls) r = do+    loop [] r = return r+    loop (l : ls) r = do         mt <- lossTime <$> readIORef (lossDetection ! l)         case mt of-          Nothing -> loop ls r-          Just t  -> case r of-            Nothing -> loop ls $ Just (t,l)-            Just (t0,_)-               | t < t0    -> loop ls $ Just (t,l)-               | otherwise -> loop ls r+            Nothing -> loop ls r+            Just t -> case r of+                Nothing -> loop ls $ Just (t, l)+                Just (t0, _)+                    | t < t0 -> loop ls $ Just (t, l)+                    | otherwise -> loop ls r  ---------------------------------------------------------------- @@ -55,39 +55,42 @@ getPtoTimeAndSpace ldcc@LDCC{..} = do     -- Arm PTO from now when there are no inflight packets.     CC{..} <- readTVarIO recoveryCC-    if bytesInFlight <= 0 then do-        validated <- peerCompletedAddressValidation ldcc-        if validated then do-            qlogDebug ldcc $ Debug "getPtoTimeAndSpace: validated"-            return Nothing-          else do-            rtt <- readIORef recoveryRTT-            lvl <- getEncryptionLevel ldcc-            let pto = backOff (calcPTO rtt $ Just lvl) (ptoCount rtt)-            ptoTime <- getFutureTimeMicrosecond pto-            return $ Just (ptoTime, lvl)-      else do-        completed <- isConnectionEstablished ldcc-        let lvls | completed = [InitialLevel, HandshakeLevel, RTT1Level]-                 | otherwise = [InitialLevel, HandshakeLevel]-        loop lvls+    if bytesInFlight <= 0+        then do+            validated <- peerCompletedAddressValidation ldcc+            if validated+                then do+                    qlogDebug ldcc $ Debug "getPtoTimeAndSpace: validated"+                    return Nothing+                else do+                    rtt <- readIORef recoveryRTT+                    lvl <- getEncryptionLevel ldcc+                    let pto = backOff (calcPTO rtt $ Just lvl) (ptoCount rtt)+                    ptoTime <- getFutureTimeMicrosecond pto+                    return $ Just (ptoTime, lvl)+        else do+            completed <- isConnectionEstablished ldcc+            let lvls+                    | completed = [InitialLevel, HandshakeLevel, RTT1Level]+                    | otherwise = [InitialLevel, HandshakeLevel]+            loop lvls   where     loop :: [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))     loop [] = return Nothing-    loop (l:ls) = do+    loop (l : ls) = do         notInFlight <- noInFlightPacket ldcc l-        if notInFlight then-            loop ls-          else do-            LossDetection{..} <- readIORef (lossDetection ! l)-            if timeOfLastAckElicitingPacket == timeMicrosecond0 then-                loop ls-              else do-                  rtt <- readIORef recoveryRTT-                  let pto0 = backOff (calcPTO rtt $ Just l) (ptoCount rtt)-                      pto = max pto0 kGranularity-                      ptoTime = timeOfLastAckElicitingPacket `addMicroseconds` pto-                  return $ Just (ptoTime, l)+        if notInFlight+            then loop ls+            else do+                LossDetection{..} <- readIORef (lossDetection ! l)+                if timeOfLastAckElicitingPacket == timeMicrosecond0+                    then loop ls+                    else do+                        rtt <- readIORef recoveryRTT+                        let pto0 = backOff (calcPTO rtt $ Just l) (ptoCount rtt)+                            pto = max pto0 kGranularity+                            ptoTime = timeOfLastAckElicitingPacket `addMicroseconds` pto+                        return $ Just (ptoTime, l)  ---------------------------------------------------------------- @@ -105,10 +108,9 @@ updateLossDetectionTimer ldcc@LDCC{..} tmi = do     mtmi <- readIORef timerInfo     when (mtmi /= Just tmi) $ do-        if timerLevel tmi == RTT1Level then-            atomically $ writeTVar timerInfoQ $ Next tmi-          else-            updateLossDetectionTimer' ldcc tmi+        if timerLevel tmi == RTT1Level+            then atomically $ writeTVar timerInfoQ $ Next tmi+            else updateLossDetectionTimer' ldcc tmi  ldccTimer :: LDCC -> IO () ldccTimer ldcc@LDCC{..} = forever $ do@@ -122,16 +124,17 @@ updateWithNext ldcc@LDCC{..} = do     x <- readTVarIO timerInfoQ     case x of-      Empty    -> return ()-      Next tmi -> updateLossDetectionTimer' ldcc tmi+        Empty -> return ()+        Next tmi -> updateLossDetectionTimer' ldcc tmi  updateLossDetectionTimer' :: LDCC -> TimerInfo -> IO () updateLossDetectionTimer' ldcc@LDCC{..} tmi = do     atomically $ writeTVar timerInfoQ Empty     let tim = timerTime tmi     Microseconds us0 <- getTimeoutInMicrosecond tim-    let us | us0 <= 0  = 10000 -- fixme-           | otherwise = us0+    let us+            | us0 <= 0 = 10000 -- fixme+            | otherwise = us0     update us     qlogLossTimerUpdated ldcc (tmi, Microseconds us) -- fixme tmi   where@@ -148,30 +151,30 @@ setLossDetectionTimer ldcc@LDCC{..} lvl0 = do     mtl <- getLossTimeAndSpace ldcc     case mtl of-      Just (earliestLossTime,lvl) -> do-          when (lvl0 == lvl) $ do-              -- Time threshold loss detection.-              let tmi = TimerInfo earliestLossTime lvl LossTime-              updateLossDetectionTimer ldcc tmi-      Nothing -> do-          -- See beforeAntiAmp-          CC{..} <- readTVarIO recoveryCC-          validated <- peerCompletedAddressValidation ldcc-          if numOfAckEliciting <= 0 && validated then-              -- There is nothing to detect lost, so no timer is-              -- set. However, we only do this if the peer has-              -- been validated, to prevent the server from being-              -- blocked by the anti-amplification limit.-              cancelLossDetectionTimer ldcc-            else do-              -- Determine which PN space to arm PTO for.-              mx <- getPtoTimeAndSpace ldcc-              case mx of-                Nothing -> return ()-                Just (ptoTime, lvl) -> do-                    when (lvl0 == lvl) $ do-                        let tmi = TimerInfo ptoTime lvl PTO-                        updateLossDetectionTimer ldcc tmi+        Just (earliestLossTime, lvl) -> do+            when (lvl0 == lvl) $ do+                -- Time threshold loss detection.+                let tmi = TimerInfo earliestLossTime lvl LossTime+                updateLossDetectionTimer ldcc tmi+        Nothing -> do+            -- See beforeAntiAmp+            CC{..} <- readTVarIO recoveryCC+            validated <- peerCompletedAddressValidation ldcc+            if numOfAckEliciting <= 0 && validated+                then -- There is nothing to detect lost, so no timer is+                -- set. However, we only do this if the peer has+                -- been validated, to prevent the server from being+                -- blocked by the anti-amplification limit.+                    cancelLossDetectionTimer ldcc+                else do+                    -- Determine which PN space to arm PTO for.+                    mx <- getPtoTimeAndSpace ldcc+                    case mx of+                        Nothing -> return ()+                        Just (ptoTime, lvl) -> do+                            when (lvl0 == lvl) $ do+                                let tmi = TimerInfo ptoTime lvl PTO+                                updateLossDetectionTimer ldcc tmi  beforeAntiAmp :: LDCC -> IO () beforeAntiAmp ldcc = cancelLossDetectionTimer ldcc@@ -187,42 +190,42 @@     when alive $ do         mtmi <- readIORef timerInfo         case mtmi of-          Nothing -> return ()-          Just tmi -> do-            let lvl = timerLevel tmi-            discarded <- getPacketNumberSpaceDiscarded ldcc lvl-            if discarded then-                updateWithNext ldcc-              else-                lossTimeOrPTO lvl tmi+            Nothing -> return ()+            Just tmi -> do+                let lvl = timerLevel tmi+                discarded <- getPacketNumberSpaceDiscarded ldcc lvl+                if discarded+                    then updateWithNext ldcc+                    else lossTimeOrPTO lvl tmi   where     lossTimeOrPTO lvl tmi = do         qlogLossTimerExpired ldcc         case timerType tmi of-          LossTime -> do-              -- Time threshold loss Detection-              lostPackets <- detectAndRemoveLostPackets ldcc lvl-              lostPackets' <- mergeLostCandidatesAndClear ldcc lostPackets-              when (null lostPackets') $ qlogDebug ldcc $ Debug "onLossDetectionTimeout: null"-              onPacketsLost ldcc lostPackets'-              retransmit ldcc lostPackets'-              setLossDetectionTimer ldcc lvl-          PTO -> do-              CC{..} <- readTVarIO recoveryCC-              if bytesInFlight > 0 then do-                  -- PTO. Send new data if available, else retransmit old data.-                  -- If neither is available, send a single PING frame.-                  sendPing ldcc lvl-                else do-                  -- Client sends an anti-deadlock packet: Initial is padded-                  -- to earn more anti-amplification credit,-                  -- a Handshake packet proves address ownership.-                  validated <- peerCompletedAddressValidation ldcc-                  when validated $ qlogDebug ldcc $ Debug "onLossDetectionTimeout: RTT1"-                  lvl' <- getEncryptionLevel ldcc -- fixme-                  sendPing ldcc lvl'+            LossTime -> do+                -- Time threshold loss Detection+                lostPackets <- detectAndRemoveLostPackets ldcc lvl+                lostPackets' <- mergeLostCandidatesAndClear ldcc lostPackets+                when (null lostPackets') $ qlogDebug ldcc $ Debug "onLossDetectionTimeout: null"+                onPacketsLost ldcc lostPackets'+                retransmit ldcc lostPackets'+                setLossDetectionTimer ldcc lvl+            PTO -> do+                CC{..} <- readTVarIO recoveryCC+                if bytesInFlight > 0+                    then do+                        -- PTO. Send new data if available, else retransmit old data.+                        -- If neither is available, send a single PING frame.+                        sendPing ldcc lvl+                    else do+                        -- Client sends an anti-deadlock packet: Initial is padded+                        -- to earn more anti-amplification credit,+                        -- a Handshake packet proves address ownership.+                        validated <- peerCompletedAddressValidation ldcc+                        when validated $ qlogDebug ldcc $ Debug "onLossDetectionTimeout: RTT1"+                        lvl' <- getEncryptionLevel ldcc -- fixme+                        sendPing ldcc lvl' -              metricsUpdated ldcc $-                  atomicModifyIORef'' recoveryRTT $-                      \rtt -> rtt { ptoCount = ptoCount rtt + 1 }-              setLossDetectionTimer ldcc lvl+                metricsUpdated ldcc $+                    atomicModifyIORef'' recoveryRTT $+                        \rtt -> rtt{ptoCount = ptoCount rtt + 1}+                setLossDetectionTimer ldcc lvl