Fixes async exception handling in Snocket.

IntersectMBO · Sep 28, 2021 · fcb5b4a · fcb5b4a
1 parent ce9122c
commit fcb5b4a
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 97 deletions.
diff --git a/cabal.project b/cabal.project
@@ -169,97 +169,3 @@ constraints:
 -- The "cabal" wrapper script provided by nix-shell will cut off / restore the remainder of this file
 -- in order to force usage of nix provided dependencies for `source-repository-package`s.
 -- --------------------------- 8< --------------------------
--- Please do not put any `source-repository-package` clause above this line.
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/Win32-network
-  tag: 3825d3abf75f83f406c1f7161883c438dac7277d
-  --sha256: 19wahfv726fa3mqajpqdqhnl9ica3xmf68i254q45iyjcpj1psqx
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/iohk-monitoring-framework
-  tag: 808724ff8a19a33d0ed06f9ef59fbd900b08553c
-  --sha256: 0298dpl29gxzs9as9ha6y0w18hqwc00ipa3hzkxv7nlfrjjz8hmz
-  subdir: contra-tracer
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/cardano-prelude
-  tag: bb4ed71ba8e587f672d06edf9d2e376f4b055555
-  --sha256: 00h10l5mmiza9819p9v5q5749nb9pzgi20vpzpy1d34zmh6gf1cj
-  subdir:
-    cardano-prelude
-    cardano-prelude-test
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/cardano-base
-  tag: cb0f19c85e5bb5299839ad4ed66af6fa61322cc4
-  --sha256: 0dnkfqcvbifbk3m5pg8kyjqjy0zj1l4vd23p39n6ym4q0bnib1cq
-  subdir:
-    base-deriving-via
-    binary
-    binary/test
-    cardano-crypto-class
-    cardano-crypto-praos
-    measures
-    orphans-deriving-via
-    slotting
-    strict-containers
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: d5b184a820853c7ba202efd615b8fadca1acb52c
-  --sha256: 04k5p6qwmfdza65gl5319r1ahdfwjnyqgzpfxdx0x2g5jcbimar4
-  subdir:
-    alonzo/impl
-    alonzo/test
-    byron/chain/executable-spec
-    byron/crypto
-    byron/crypto/test
-    byron/ledger/executable-spec
-    byron/ledger/impl
-    byron/ledger/impl/test
-    cardano-ledger-core
-    semantics/executable-spec
-    semantics/small-steps-test
-    shelley/chain-and-ledger/dependencies/non-integer
-    shelley/chain-and-ledger/executable-spec
-    shelley/chain-and-ledger/shelley-spec-ledger-test
-    shelley-ma/impl
-    shelley-ma/shelley-ma-test
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/plutus
-  tag: 8c83c4abe211b4bbcaca3cdf1b2c0e38d0eb683f
-  --sha256: 1643s1g3jlm9pgalpc3vpij1zqb1n8yv8irq6qc43gs9bvl0wc3l
-  subdir:
-    plutus-ledger-api
-    plutus-tx
-    plutus-core
-    prettyprinter-configurable
-    word-array
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/goblins
-  tag: cde90a2b27f79187ca8310b6549331e59595e7ba
-  --sha256: 17c88rbva3iw82yg9srlxjv2ia5wjb9cyqw44hik565f5v9svnyg
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/cardano-crypto
-  tag: f73079303f663e028288f9f4a9e08bcca39a923e
-  --sha256: 1n87i15x54s0cjkh3nsxs4r1x016cdw1fypwmr68936n3xxsjn6q
-
--- Drops an instance breaking the Plutus code. Should be released to Hackage
--- eventually.
-source-repository-package
-  type: git
-  location: https://github.com/michaelpj/flat.git
-  tag: ee59880f47ab835dbd73bea0847dab7869fc20d8
-  --sha256: 1lrzknw765pz2j97nvv9ip3l1mcpf2zr4n56hwlz0rk7wq7ls4cm
diff --git a/ouroboros-network-framework/src/Simulation/Network/Snocket.hs b/ouroboros-network-framework/src/Simulation/Network/Snocket.hs
@@ -722,9 +722,11 @@ mkSnocket state tr = Snocket { getLocalAddr
                                    (STBearerInfo bearerInfo))
             -- connection delay
             unmask (threadDelay (biConnectionDelay bearerInfo `min` connectTimeout))
-              `catch` \(_ :: SomeException) ->
+              `catch` \(e :: SomeAsyncException) -> do
                 atomically $ modifyTVar (nsConnections state)
                                         (Map.delete (normaliseId connId))
+                throwIO e
+
             traceWith tr (WithAddr (Just (localAddress connId))
                                    (Just remoteAddress)
                                    (STDebug "delay:done"))
@@ -741,7 +743,7 @@ mkSnocket state tr = Snocket { getLocalAddr
               case (efd, lstFd) of
                 -- error cases
                 (_, Nothing) ->
-                  return (Left (connectIOError connId "no suh listening socket"))
+                  return (Left (connectIOError connId "no such listening socket"))
                 (_, Just FDUninitialised {}) ->
                   return (Left (connectIOError connId "unitialised listening socket"))
                 (_, Just FDConnecting {}) ->
@@ -791,7 +793,7 @@ mkSnocket state tr = Snocket { getLocalAddr
                 -- wait for a connection to be accepted
                 timeoutVar <-
                   registerDelay (connectTimeout - biConnectionDelay bearerInfo)
-                r <- unmask $ atomically $ runFirstToFinish $
+                r <- unmask (atomically $ runFirstToFinish $
                   (FirstToFinish $ do
                     LazySTM.readTVar timeoutVar >>= check
                     return Nothing
@@ -809,6 +811,10 @@ mkSnocket state tr = Snocket { getLocalAddr
                                          ++ show (normaliseId connId)
                       Just Connection { connState } ->
                         Just <$> check (connState == Established))
+                     )
+                  `onException`
+                     atomically (modifyTVar (nsConnections state)
+                                            (Map.delete (normaliseId connId)))
 
                 case r of
                   Nothing -> do