{-# LANGUAGE ScopedTypeVariables #-}

module Network.QUIC.Exception (
    handleLogT,
    handleLogUnit,
) where

import qualified GHC.IO.Exception as E
import qualified System.IO.Error as E
import qualified UnliftIO.Exception as E

import Network.QUIC.Logger

-- Catch all exceptions including asynchronous ones.
handleLogUnit :: DebugLogger -> IO () -> IO ()
handleLogUnit :: DebugLogger -> IO () -> IO ()
handleLogUnit DebugLogger
logAction IO ()
action = IO ()
action forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catchSyncOrAsync` SomeException -> IO ()
handler
  where
    handler :: E.SomeException -> IO ()
    handler :: SomeException -> IO ()
handler SomeException
se = case forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
se of
        -- threadWait: invalid argument (Bad file descriptor)
        Just IOError
e | IOError -> IOErrorType
E.ioeGetErrorType IOError
e forall a. Eq a => a -> a -> Bool
== IOErrorType
E.InvalidArgument -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- recvBuf: does not exist (Connection refused)
        Just IOError
e | IOError -> IOErrorType
E.ioeGetErrorType IOError
e forall a. Eq a => a -> a -> Bool
== IOErrorType
E.NoSuchThing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe IOError
_ -> DebugLogger
logAction forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Builder
bhow SomeException
se

-- Log and throw an exception
handleLogT :: DebugLogger -> IO a -> IO a
handleLogT :: forall a. DebugLogger -> IO a -> IO a
handleLogT DebugLogger
logAction IO a
action = IO a
action forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`E.catchAny` forall {b}. SomeException -> IO b
handler
  where
    handler :: SomeException -> IO b
handler (E.SomeException e
e) = do
        DebugLogger
logAction forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Builder
bhow e
e
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO e
e