From e7e957cbd57e3347111b74a3e1973717a86a37b3 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Thu, 2 Sep 2021 14:54:04 +0100 Subject: [PATCH] Fixes async exceptions in connectionLoop - Tweaks in the MultiNodeScriptPruning generator; --- .../test/Test/Ouroboros/Network/Server2.hs | 60 ++++++++++++------- 1 file changed, 38 insertions(+), 22 deletions(-) diff --git a/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs index 5b847b4f292..76133657e2c 100644 --- a/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs +++ b/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs @@ -23,11 +23,9 @@ module Test.Ouroboros.Network.Server2 ( tests - , prop ) where -import Control.Applicative ((<|>)) -import Control.Exception (AssertionFailed) +import Control.Exception (AssertionFailed, SomeAsyncException (SomeAsyncException)) import Control.Monad (replicateM, when, (>=>)) import Control.Monad.Class.MonadAsync import Control.Monad.Class.MonadThrow @@ -113,8 +111,6 @@ import Test.Ouroboros.Network.Orphans () -- ShowProxy ReqResp instanc import Test.Simulation.Network.Snocket hiding (tests) import Test.Ouroboros.Network.ConnectionManager (verifyAbstractTransition) -import qualified Debug.Trace as Debug - tests :: TestTree tests = testGroup "Ouroboros.Network.Server2" @@ -122,7 +118,8 @@ tests = , testProperty "unidirectional_Sim" prop_unidirectional_Sim , testProperty "bidirectional_IO" prop_bidirectional_IO , testProperty "bidirectional_Sim" prop_bidirectional_Sim - , testProperty "multinode_Sim_Pruning" prop_multinode_Sim_Pruning + , testProperty "multinode_Sim_Pruning_Transitions" + prop_multinode_Sim_Pruning_Transitions , testProperty "multinode_Sim" prop_multinode_Sim , testProperty "unit_connection_terminated_when_negotiating" unit_connection_terminated_when_negotiating @@ -598,7 +595,7 @@ withBidirectionalConnectionManager name timeouts `catch` \(e :: SomeException) -> do throwIO e where - -- for a bidirectional mux we need to define 'Mu.xMiniProtocolInfo' for each + -- for a bidirectional mux we need to define 'Mux.MiniProtocolInfo' for each -- protocol for each direction. serverMiniProtocolBundle :: Mux.MiniProtocolBundle InitiatorResponderMode serverMiniProtocolBundle = Mux.MiniProtocolBundle @@ -1258,8 +1255,7 @@ prop_generator_MultiNodeScript (MultiNodeScript script) = instance Arbitrary req => Arbitrary (MultiNodeScriptPruning req) where arbitrary = do - -- Positive len <- scale (* 3) arbitrary - Positive len <- scale ((* 2) . (`div` 3)) arbitrary + Positive len <- scale (* 3) arbitrary MultiNodeScriptPruning <$> go (ScriptState [] [] [] [] []) (len :: Integer) where -- Divide delays by 100 to avoid running in to protocol and SDU timeouts if waiting @@ -1277,10 +1273,10 @@ instance Arbitrary req => [ (4, InboundConnection <$> delay <*> elements possibleInboundConnections) | not $ null possibleInboundConnections] ++ [ (4, OutboundConnection <$> delay <*> elements possibleOutboundConnections) | not $ null possibleOutboundConnections] ++ [ (4, CloseInboundConnection <$> delay <*> elements inboundConnections) | not $ null inboundConnections ] ++ - [ (16, CloseOutboundConnection <$> delay <*> elements outboundConnections) | not $ null outboundConnections ] ++ + [ (20, CloseOutboundConnection <$> delay <*> elements outboundConnections) | not $ null outboundConnections ] ++ [ (16, InboundMiniprotocols <$> delay <*> elements inboundConnections <*> genBundle) | not $ null inboundConnections ] ++ - [ (16, OutboundMiniprotocols <$> delay <*> elements outboundConnections <*> genBundle) | not $ null outboundConnections ] ++ - [ (2, ShutdownClientServer <$> delay <*> elements possibleStoppable) | not $ null possibleStoppable ] + [ (4, OutboundMiniprotocols <$> delay <*> elements outboundConnections <*> genBundle) | not $ null outboundConnections ] ++ + [ (1, ShutdownClientServer <$> delay <*> elements possibleStoppable) | not $ null possibleStoppable ] case event of StartServer _ c _ -> do inboundConnection <- InboundConnection <$> delay <*> pure c @@ -1604,7 +1600,10 @@ multinodeExperiment inboundTrTracer trTracer cmTracer inboundTracer TokWarm -> "warm" TokEstablished -> "cold" q <$ labelTQueue q ("protoVar." ++ temp ++ "@" ++ show localAddr) - connHandle <- try @_ @SomeException + connHandle <- tryJust (\(e :: SomeException) -> + case fromException e of + Just SomeAsyncException {} -> Nothing + _ -> Just e) $ requestOutboundConnection cm remoteAddr case connHandle of Left _ -> @@ -1633,12 +1632,20 @@ multinodeExperiment inboundTrTracer trTracer cmTracer inboundTracer -- We want to throw because the generator invariant should never put us in -- this case Nothing -> throwIO (NoActiveConnection localAddr remoteAddr) - Just (Handle mux muxBundle _) -> + Just (Handle mux muxBundle _) -> do -- TODO: -- At times this throws 'ProtocolAlreadyRunning'. - void $ try @_ @SomeException + r <- tryJust (\(e :: SomeException) -> + case fromException e of + Just SomeAsyncException {} -> Nothing -- rethrown + _ -> Just e) $ runInitiatorProtocols muxMode mux muxBundle - go unregister connMap + case r of + -- Lost connection to peer + Left {} -> do + atomically $ modifyTVar connVar (Map.delete (connId remoteAddr)) + go unregister (Map.delete remoteAddr connMap) + Right {} -> go unregister connMap Shutdown -> return () where connId remoteAddr = ConnectionId { localAddress = localAddr @@ -1734,6 +1741,12 @@ mkProperty TestProperty { tpProperty . tabulate "Transitions" (map ppTransition tpTransitions) $ tpProperty +mkPropertyPruning :: TestProperty -> Property +mkPropertyPruning tp@TestProperty { tpNumberOfPrunings = Sum numberOfPrunings_ } = + cover 25 (numberOfPrunings_ > 0) "Prunings" + . mkProperty + $ tp + newtype AllProperty = AllProperty { getAllProperty :: Property } instance Semigroup AllProperty where @@ -2093,11 +2106,14 @@ prop_multinode_Sim serverAcc (ArbDataFlow dataFlow) absBi script@(MultiNodeScrip Nothing -> IdleConn Just {} -> ActiveConn -prop = prop_multinode_Sim_Pruning 0 (Small 10) (MultiNodeScriptPruning [StartServer 0 (TestAddr {unTestAddr = TestAddress 46}) 0,OutboundConnection 0 (TestAddr {unTestAddr = TestAddress 46}),StartServer 0 (TestAddr {unTestAddr = TestAddress 73}) 0,InboundConnection 0 (TestAddr {unTestAddr = TestAddress 73}),OutboundConnection 0 (TestAddr {unTestAddr = TestAddress 73}),InboundMiniprotocols 0 (TestAddr {unTestAddr = TestAddress 73}) (Bundle {withHot = WithHot [], withWarm = WithWarm [], withEstablished = WithEstablished [0]}),StartServer 0 (TestAddr {unTestAddr = TestAddress 100}) 0,OutboundConnection 0 (TestAddr {unTestAddr = TestAddress 100}),CloseOutboundConnection 0 (TestAddr {unTestAddr = TestAddress 73}),OutboundMiniprotocols 0 (TestAddr {unTestAddr = TestAddress 46}) (Bundle {withHot = WithHot [], withWarm = WithWarm [], withEstablished = WithEstablished []})]) - --- | Property wrapping `multinodeExperiment` that has a generator optimized for triggering pruning. -prop_multinode_Sim_Pruning :: Int -> Small Word32 -> MultiNodeScriptPruning Int -> Property -prop_multinode_Sim_Pruning serverAcc (Small bound) (MultiNodeScriptPruning l) = +-- | Property wrapping `multinodeExperiment` that has a generator optimized for triggering +-- pruning, and random generated number of connections hard limit. +-- +-- This test tests if with a higher chance of pruning happening and a smaller number of +-- connections hard limit we do not end up triggering any illegal transition. +-- +prop_multinode_Sim_Pruning_Transitions :: Int -> Small Word32 -> MultiNodeScriptPruning Int -> Property +prop_multinode_Sim_Pruning_Transitions serverAcc (Small bound) (MultiNodeScriptPruning l) = let trace = runSimTrace sim where sim :: IOSim s () @@ -2142,7 +2158,7 @@ prop_multinode_Sim_Pruning serverAcc (Small bound) (MultiNodeScriptPruning l) = . counterexample (ppScript (MultiNodeScript l)) . counterexample ("\nAbstractTransition Trace\n" ++ (intercalate "\n" . map show $ Octopus.toList evs)) . counterexample ("\nConnectionManager Trace\n" ++ (intercalate "\n" . map show $ Octopus.toList evs')) - . mkProperty + . mkPropertyPruning . bifoldMap ( \ case MainReturn {} -> mempty