{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} module Network.QUIC.Connection.Misc ( setVersionInfo, getVersionInfo, setVersion, getVersion, getOriginalVersion, getSocket, setSocket, clearSocket, getPathInfo, addPathInfo, findPathInfo, getPeerAuthCIDs, setPeerAuthCIDs, getClientDstCID, getMyParameters, getPeerParameters, setPeerParameters, delayedAck, resetDealyedAck, setMaxPacketSize, forkManaged, killReaders, addResource, freeResources, readMinIdleTimeout, setMinIdleTimeout, sendFrames, closeConnection, abortConnection, ) where import Control.Concurrent import qualified Control.Exception as E import qualified Data.Map.Strict as Map import Network.Socket (SockAddr, Socket) import System.Mem.Weak import Network.QUIC.Connection.Queue import Network.QUIC.Connection.State import Network.QUIC.Connection.Timeout import Network.QUIC.Connection.Types import Network.QUIC.Connector import Network.QUIC.Imports import Network.QUIC.Parameters import Network.QUIC.Types ---------------------------------------------------------------- setVersionInfo :: Connection -> VersionInfo -> IO () setVersionInfo Connection{..} ver = writeIORef quicVersionInfo ver getVersionInfo :: Connection -> IO VersionInfo getVersionInfo Connection{..} = readIORef quicVersionInfo setVersion :: Connection -> Version -> IO () setVersion Connection{..} ver = atomicModifyIORef'' quicVersionInfo $ \vi -> vi{chosenVersion = ver} getVersion :: Connection -> IO Version getVersion conn = chosenVersion <$> getVersionInfo conn getOriginalVersion :: Connection -> Version getOriginalVersion = chosenVersion . origVersionInfo ---------------------------------------------------------------- getSocket :: Connection -> IO Socket getSocket Connection{..} = readIORef connSocket setSocket :: Connection -> Socket -> IO Socket setSocket Connection{..} sock = atomicModifyIORef' connSocket (sock,) -- fixme clearSocket :: Connection -> IO Socket clearSocket Connection{..} = atomicModifyIORef' connSocket (undefined,) ---------------------------------------------------------------- getPathInfo :: Connection -> IO PathInfo getPathInfo Connection{..} = currPathInfo <$> readIORef peerInfo addPathInfo :: Connection -> PathInfo -> IO () addPathInfo Connection{..} newpi = atomicModifyIORef'' peerInfo add where add (PeerInfo oldpi _) = PeerInfo newpi $ Just oldpi findPathInfo :: Connection -> SockAddr -> IO (Maybe PathInfo) findPathInfo Connection{..} sa = do PeerInfo currpi mprevpi <- readIORef peerInfo return $ if peerSockAddr currpi == sa then Just currpi else if (peerSockAddr <$> mprevpi) == Just sa then mprevpi else Nothing ---------------------------------------------------------------- getMyAuthCIDs :: Connection -> IO AuthCIDs getMyAuthCIDs Connection{..} = readIORef connMyAuthCIDs getPeerAuthCIDs :: Connection -> IO AuthCIDs getPeerAuthCIDs Connection{..} = readIORef connPeerAuthCIDs setPeerAuthCIDs :: Connection -> (AuthCIDs -> AuthCIDs) -> IO () setPeerAuthCIDs Connection{..} f = atomicModifyIORef'' connPeerAuthCIDs f getClientDstCID :: Connection -> IO CID getClientDstCID conn = do cids <- if isClient conn then getPeerAuthCIDs conn else getMyAuthCIDs conn return $ case retrySrcCID cids of Nothing -> fromJust $ origDstCID cids Just dcid -> dcid ---------------------------------------------------------------- getMyParameters :: Connection -> Parameters getMyParameters Connection{..} = myParameters ---------------------------------------------------------------- getPeerParameters :: Connection -> IO Parameters getPeerParameters Connection{..} = readIORef peerParameters setPeerParameters :: Connection -> Parameters -> IO () setPeerParameters Connection{..} params = writeIORef peerParameters params ---------------------------------------------------------------- delayedAck :: Connection -> IO () delayedAck conn@Connection{..} = do (oldcnt, send_) <- atomicModifyIORef' delayedAckCount check when (oldcnt == 0) $ do new <- cfire conn (Microseconds 20000) sendAck join $ atomicModifyIORef' delayedAckCancel (new,) when send_ $ do let new = return () join $ atomicModifyIORef' delayedAckCancel (new,) sendAck where sendAck = putOutput conn $ OutControl RTT1Level [] check 1 = (0, (1, True)) check n = (n + 1, (n, False)) resetDealyedAck :: Connection -> IO () resetDealyedAck Connection{..} = do writeIORef delayedAckCount 0 let new = return () join $ atomicModifyIORef' delayedAckCancel (new,) ---------------------------------------------------------------- setMaxPacketSize :: Connection -> Int -> IO () setMaxPacketSize Connection{..} n = writeIORef (maxPacketSize connState) n ---------------------------------------------------------------- addResource :: Connection -> IO () -> IO () addResource Connection{..} f = atomicModifyIORef'' connResources $ \fs -> f' >> fs where f' = f `E.catch` ignore freeResources :: Connection -> IO () freeResources Connection{..} = join $ atomicModifyIORef' connResources (return (),) ---------------------------------------------------------------- addReader :: Connection -> ThreadId -> IO () addReader Connection{..} tid = do wtid <- mkWeakThreadId tid let n = fromThreadId tid atomicModifyIORef'' readers $ Map.insert n wtid delReader :: Connection -> ThreadId -> IO () delReader Connection{..} tid = do let n = fromThreadId tid atomicModifyIORef'' readers $ Map.delete n forkManaged :: Connection -> IO () -> IO () forkManaged conn action = void $ forkIO $ do E.bracket setup clean $ \_ -> action where setup = do tid <- myThreadId addReader conn tid return tid clean = delReader conn killReaders :: Connection -> IO () killReaders Connection{..} = do wtids <- readIORef readers forM_ wtids $ \wtid -> do mtid <- deRefWeak wtid case mtid of Nothing -> return () Just tid -> killThread tid ---------------------------------------------------------------- readMinIdleTimeout :: Connection -> IO Microseconds readMinIdleTimeout Connection{..} = readIORef minIdleTimeout setMinIdleTimeout :: Connection -> Microseconds -> IO () setMinIdleTimeout Connection{..} us | us == Microseconds 0 = return () | otherwise = atomicModifyIORef'' minIdleTimeout modify where modify us0 = min us us0 ---------------------------------------------------------------- sendFrames :: Connection -> EncryptionLevel -> [Frame] -> IO () sendFrames conn lvl frames = putOutput conn $ OutControl lvl frames -- | Closing a connection with/without a transport error. -- Internal threads should use this. closeConnection :: Connection -> TransportError -> ReasonPhrase -> IO () closeConnection conn err desc = do setConnectionClosed conn E.throwIO quicexc where quicexc = TransportErrorIsSent err desc -- | Closing a connection with an application protocol error. abortConnection :: Connection -> ApplicationProtocolError -> ReasonPhrase -> IO () abortConnection conn err desc = E.throwTo (mainThreadId conn) $ Abort err desc