diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2025-05-05 22:01:08 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-05-05 22:01:08 +0200 |
| commit | 88274b83a63a0bbe35c7dccd38ff509343a090ba (patch) | |
| tree | f6dc4a919b2dfdbcfbf1a0180c021381b31fa6ff | |
| parent | f8f8ebd1371bb10c604a83ac842e235085e3a5e1 (diff) | |
Handle and log exceptions during network protocol handling
| -rw-r--r-- | src/Erebos/Network/Protocol.hs | 7 |
1 files changed, 5 insertions, 2 deletions
diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs index cfbaea3..efafd31 100644 --- a/src/Erebos/Network/Protocol.hs +++ b/src/Erebos/Network/Protocol.hs @@ -36,6 +36,7 @@ import Control.Applicative import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM +import Control.Exception import Control.Monad import Control.Monad.Except import Control.Monad.Trans @@ -510,8 +511,10 @@ erebosNetworkProtocol initialIdentity gLog gDataFlow gControlFlow = do race_ (waitTill next) waitForUpdate - race_ signalTimeouts $ forever $ join $ atomically $ - passUpIncoming gs <|> processIncoming gs <|> processOutgoing gs + race_ signalTimeouts $ forever $ do + io <- atomically $ do + passUpIncoming gs <|> processIncoming gs <|> processOutgoing gs + catch io $ \(e :: SomeException) -> atomically $ gLog $ "exception during network protocol handling: " <> show e getConnection :: GlobalState addr -> addr -> STM (Connection addr) |