module Network.QUIC.Connection.Timeout ( 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 Network.QUIC.Connection.Types import Network.QUIC.Connector import Network.QUIC.Imports import Network.QUIC.Types timeout :: Microseconds -> String -> IO a -> IO (Maybe a) timeout :: forall a. Microseconds -> String -> IO a -> IO (Maybe a) timeout (Microseconds Int ms) String _ IO a action = forall a. Int -> IO a -> IO (Maybe a) ST.timeout Int ms IO a action fire :: Connection -> Microseconds -> TimeoutCallback -> IO () fire :: Connection -> Microseconds -> TimeoutCallback -> TimeoutCallback fire Connection conn (Microseconds Int microseconds) TimeoutCallback action = do TimerManager timmgr <- IO TimerManager getSystemTimerManager forall (f :: * -> *) a. Functor f => f a -> f () void forall a b. (a -> b) -> a -> b $ TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout TimerManager timmgr Int microseconds TimeoutCallback action' where action' :: TimeoutCallback action' = do Bool alive <- forall a. Connector a => a -> IO Bool getAlive Connection conn forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool alive TimeoutCallback action forall (m :: * -> *) e a. (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a `E.catchSyncOrAsync` SomeException -> TimeoutCallback ignore cfire :: Connection -> Microseconds -> TimeoutCallback -> IO (IO ()) cfire :: Connection -> Microseconds -> TimeoutCallback -> IO TimeoutCallback cfire Connection conn (Microseconds Int microseconds) TimeoutCallback action = do TimerManager timmgr <- IO TimerManager getSystemTimerManager TimeoutKey key <- TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey registerTimeout TimerManager timmgr Int microseconds TimeoutCallback action' let cancel :: TimeoutCallback cancel = TimerManager -> TimeoutKey -> TimeoutCallback unregisterTimeout TimerManager timmgr TimeoutKey key forall (m :: * -> *) a. Monad m => a -> m a return TimeoutCallback cancel where action' :: TimeoutCallback action' = do Bool alive <- forall a. Connector a => a -> IO Bool getAlive Connection conn forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool alive TimeoutCallback action forall (m :: * -> *) e a. (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a `E.catchSyncOrAsync` SomeException -> TimeoutCallback ignore delay :: Microseconds -> IO () delay :: Microseconds -> TimeoutCallback delay (Microseconds Int microseconds) = forall (m :: * -> *). MonadIO m => Int -> m () threadDelay Int microseconds