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 = Int -> IO a -> IO (Maybe a)
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
    IO TimeoutKey -> TimeoutCallback
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO TimeoutKey -> TimeoutCallback)
-> IO TimeoutKey -> TimeoutCallback
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 <- Connection -> IO Bool
forall a. Connector a => a -> IO Bool
getAlive Connection
conn
        Bool -> TimeoutCallback -> TimeoutCallback
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alive TimeoutCallback
action TimeoutCallback
-> (SomeException -> TimeoutCallback) -> TimeoutCallback
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
    TimeoutCallback -> IO TimeoutCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeoutCallback
cancel
  where
    action' :: TimeoutCallback
action' = do
        Bool
alive <- Connection -> IO Bool
forall a. Connector a => a -> IO Bool
getAlive Connection
conn
        Bool -> TimeoutCallback -> TimeoutCallback
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alive TimeoutCallback
action TimeoutCallback
-> (SomeException -> TimeoutCallback) -> TimeoutCallback
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) = Int -> TimeoutCallback
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
microseconds