Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Diffusion test for connection manager transitions #3629

Merged
merged 20 commits into from
Apr 25, 2022
Merged

Diffusion test for connection manager transitions #3629

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
20 commits
Select commit Hold shift + click to select a range
cfcaf5d
Refactored some Tracing utils like WithName
bolt12 Feb 15, 2022
c9f3cc7
Fixes #3605 by looking at inProgressPromoteCold.
bolt12 Feb 15, 2022
1b36c58
Refactor DiffusionScript generation and simulation
bolt12 Feb 15, 2022
fbbd1cb
Changed variable names
bolt12 Feb 28, 2022
e8e446f
Added haddock to Signal.keyedTimeout
bolt12 Feb 15, 2022
13fe99a
Fix ntnAddressType to be more exhaustive
bolt12 Feb 15, 2022
466b67d
Abstracted Diff.P2P.TracersExtra out of Node.run
bolt12 Feb 15, 2022
f9d4536
Added deriving Show
bolt12 Feb 15, 2022
17d2a6c
Added lifted governor established target local
bolt12 Feb 15, 2022
b6c7f68
Lift other local root peer properties to diffusion
bolt12 Feb 15, 2022
8605620
Fixed snocket not being shared
bolt12 Feb 18, 2022
0c0850b
Fixed keepAlive
bolt12 Mar 3, 2022
918303a
Fixed assertion error in MockChain
bolt12 Mar 3, 2022
93ecd43
Adjust command delays in diffscript generation
bolt12 Mar 17, 2022
daabfd4
Add no_livelock test.
bolt12 Mar 21, 2022
ee14be2
Refactored common functions into testlib
bolt12 Apr 20, 2022
dc398c5
Fixes #3627
bolt12 Feb 21, 2022
33ec631
Added CM Valid transition test
bolt12 Apr 20, 2022
3861d5a
Fix comments
bolt12 Apr 20, 2022
2406460
Added cm_verify_transition_order
bolt12 Apr 20, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 32 additions & 1 deletion ouroboros-network-framework/ouroboros-network-framework.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
cabal-version: >=1.10
cabal-version: 3.0
-- Initial package description 'typed-protocols-testing.cabal' generated by
-- 'cabal init'. For further documentation, see
-- http://haskell.org/cabal/users-guide/
Expand Down Expand Up @@ -115,6 +115,36 @@ library
-Wredundant-constraints
-Wno-unticked-promoted-constructors

library testlib
visibility: public
hs-source-dirs: testlib

exposed-modules: TestLib.ConnectionManager
TestLib.InboundGovernor
TestLib.Utils

other-modules:

build-depends: base
, bytestring
, containers

, QuickCheck

, io-sim
, ouroboros-network-framework

default-language: Haskell2010
ghc-options: -rtsopts
-threaded
-Wall
-Wcompat
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wpartial-fields
-Widentities
-Wredundant-constraints

test-suite test
type: exitcode-stdio-1.0
main-is: Main.hs
Expand Down Expand Up @@ -157,6 +187,7 @@ test-suite test
, network-mux
, monoidal-synchronisation
, ouroboros-network-framework
, ouroboros-network-framework:testlib
, ouroboros-network-testing
, typed-protocols
, typed-protocols-cborg
Expand Down
28 changes: 23 additions & 5 deletions ouroboros-network-framework/src/Simulation/Network/Snocket.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
Expand Down Expand Up @@ -771,10 +770,29 @@ mkSnocket state tr = Snocket { getLocalAddr
(Just remoteAddress)
(STBearerInfo bearerInfo))
-- connection delay
unmask (threadDelay (biConnectionDelay bearerInfo `min` connectTimeout))
`onException`
atomically (modifyTVar (nsConnections state)
(Map.delete $ normaliseId connId))
--
-- We need a way for a node to detect if the other end failed so
-- we keep an eye on the network state while waiting the full amount
-- of connection delay
-- TODO: Improve this see #3628
connDelayTimeoutVar <-
registerDelay (biConnectionDelay bearerInfo `min` connectTimeout)
unmask
(atomically $ runFirstToFinish $
coot marked this conversation as resolved.
Show resolved Hide resolved
FirstToFinish
(LazySTM.readTVar connDelayTimeoutVar >>= check)
<>
FirstToFinish (do
b <- not . Map.member (normaliseId connId)
<$> readTVar (nsConnections state)
check b
coot marked this conversation as resolved.
Show resolved Hide resolved
throwSTM $ connectIOError connId
$ "unknown connection: "
++ show (normaliseId connId))
)
`onException`
atomically (modifyTVar (nsConnections state)
(Map.delete (normaliseId connId)))

when (biConnectionDelay bearerInfo >= connectTimeout) $ do
traceWith' fd (STConnectTimeout WaitingToConnect)
Expand Down
216 changes: 2 additions & 214 deletions ouroboros-network-framework/test/Test/Ouroboros/Network/ConnectionManager.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,18 +1,13 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnicodeSyntax #-}

-- 'TestAddress' 'Arbitrary' instance.
Expand All @@ -24,9 +19,6 @@

module Test.Ouroboros.Network.ConnectionManager
( tests
, verifyAbstractTransition
, validTransitionMap
, allValidTransitionsNames
) where

import Prelude hiding (read)
Expand Down Expand Up @@ -73,6 +65,8 @@ import Ouroboros.Network.Server.RateLimiting
import Ouroboros.Network.Snocket (Accept (..), Accepted (..),
AddressFamily (TestFamily), Snocket (..), TestAddress (..))

import TestLib.ConnectionManager (verifyAbstractTransition)



tests :: TestTree
Expand Down Expand Up @@ -653,212 +647,6 @@ type TestConnectionManagerTrace = ConnectionManagerTrace Addr ()
type TestTransitionTrace m = TransitionTrace Addr (TestConnectionState m)
type TestAbstractTransitionTrace = AbstractTransitionTrace Addr


verifyAbstractTransition :: AbstractTransition
-> Bool
verifyAbstractTransition Transition { fromState, toState } =
case (fromState, toState) of
--
-- Outbound
--

-- @Reserve@
(TerminatedSt, ReservedOutboundSt) -> True
(UnknownConnectionSt, ReservedOutboundSt) -> True
-- @Connected@
(ReservedOutboundSt, UnnegotiatedSt Outbound) -> True
-- @Negotiated^{Unidirectional}_{Outbound}@
(UnnegotiatedSt Outbound, OutboundUniSt) -> True
-- @Negotiated^{Duplex}_{Outbound}@
(UnnegotiatedSt Outbound, OutboundDupSt Ticking) -> True
(UnnegotiatedSt _, TerminatingSt) -> True

-- @DemotedToCold^{Unidirectional}_{Local}@
(OutboundUniSt, OutboundIdleSt Unidirectional) -> True
-- @TimeoutExpired@
(OutboundDupSt Ticking, OutboundDupSt Expired) -> True
-- @DemotedToCold^{Duplex}_{Local}@
(OutboundDupSt Expired, OutboundIdleSt Duplex) -> True
-- identity transition executed by 'demotedToColdRemote'
(OutboundIdleSt dataFlow, OutboundIdleSt dataFlow') -> dataFlow == dataFlow'

--
-- Outbound ↔ Inbound
--

-- @DemotedToCold^{Duplex}_{Local}@
(OutboundDupSt Ticking, InboundIdleSt Duplex) -> True
-- @Awake^{Duplex}_{Local}
(InboundIdleSt Duplex, OutboundDupSt Ticking) -> True
-- @PromotedToWarm^{Duplex}_{Remote}@
(OutboundDupSt Ticking, DuplexSt) -> True
(OutboundDupSt Expired, DuplexSt) -> True
-- can be executed by 'demotedToColdRemote'
(OutboundDupSt expired, OutboundDupSt expired')
-> expired == expired'
-- @PromotedToWarm^{Duplex}_{Local}@
(InboundSt Duplex, DuplexSt) -> True
-- @DemotedToCold^{Duplex}_{Remote}@
(DuplexSt, OutboundDupSt Ticking) -> True
-- @DemotedToCold^{Duplex}_{Local}@
(DuplexSt, InboundSt Duplex) -> True

--
-- Inbound
--

-- @Accepted@
(TerminatedSt, UnnegotiatedSt Inbound) -> True
(UnknownConnectionSt, UnnegotiatedSt Inbound) -> True
-- @Overwritten@
(ReservedOutboundSt, UnnegotiatedSt Inbound) -> True
-- @Negotiated^{Duplex}_{Inbound}
(UnnegotiatedSt Inbound, InboundIdleSt Duplex) -> True
-- @Negotiated^{Unidirectional}_{Inbound}
(UnnegotiatedSt Inbound, InboundIdleSt Unidirectional) -> True

-- 'unregisterOutboundConnection' and 'demotedToColdRemote' might perfrom
(InboundIdleSt Duplex, InboundIdleSt Duplex) -> True
-- @Awake^{Duplex}_{Remote}
(InboundIdleSt Duplex, InboundSt Duplex) -> True
-- @Commit^{Duplex}
(InboundIdleSt Duplex, TerminatingSt) -> True
-- @DemotedToCold^{Duplex}_{Local}
(InboundSt Duplex, InboundIdleSt Duplex) -> True

-- @Awake^{Unidirectional}_{Remote}
(InboundIdleSt Unidirectional, InboundSt Unidirectional) -> True
-- @Commit^{Unidirectional}
(InboundIdleSt Unidirectional, TerminatingSt) -> True
-- @DemotedToCold^{Unidirectional}_{Local}
(InboundSt Unidirectional, InboundIdleSt Unidirectional) -> True

--
-- OutboundIdleSt
--

(OutboundIdleSt Duplex, InboundSt Duplex) -> True
(OutboundIdleSt _dataFlow, TerminatingSt) -> True

--
-- Terminate
--

-- @Terminate@
(TerminatingSt, TerminatedSt) -> True

-- explicit prohibition of reflexive terminate transition
(TerminatedSt, TerminatedSt) -> False
-- implicit terminate transition
(_, TerminatedSt) -> True

-- explicit prohibition of reflexive unknown transition
(UnknownConnectionSt, UnknownConnectionSt) -> False
(_, UnknownConnectionSt) -> True

-- We accept connection in 'TerminatingSt'
(TerminatingSt, UnnegotiatedSt Inbound) -> True

_ -> False

-- | Maps each valid transition into one number. Collapses all invalid transition into a
-- single number.
--
-- NOTE: Should be in sync with 'verifyAbstractTransition'
--
validTransitionMap :: AbstractTransition
-> (Int, String)
validTransitionMap t@Transition { fromState, toState } =
case (fromState, toState) of
(TerminatedSt , ReservedOutboundSt) -> (01, show t)
(UnknownConnectionSt , ReservedOutboundSt) -> (02, show t)
(ReservedOutboundSt , UnnegotiatedSt Outbound) -> (03, show t)
(UnnegotiatedSt Outbound , OutboundUniSt) -> (04, show t)
(UnnegotiatedSt Outbound , OutboundDupSt Ticking) -> (05, show t)
(OutboundUniSt , OutboundIdleSt Unidirectional) -> (06, show t)
(OutboundDupSt Ticking , OutboundDupSt Expired) -> (07, show t)
(OutboundDupSt Expired , OutboundIdleSt Duplex) -> (08, show t)
(OutboundIdleSt dataFlow , OutboundIdleSt dataFlow')
| dataFlow == dataFlow' -> (09, show t)
(OutboundDupSt Ticking , InboundIdleSt Duplex) -> (10, show t)
(InboundIdleSt Duplex , OutboundDupSt Ticking) -> (11, show t)
(OutboundDupSt Ticking , DuplexSt) -> (12, show t)
(OutboundDupSt Expired , DuplexSt) -> (13, show t)
(OutboundDupSt expired , OutboundDupSt expired')
| expired == expired' -> (14, show t)
(InboundSt Duplex , DuplexSt) -> (15, show t)
(DuplexSt , OutboundDupSt Ticking) -> (16, show t)
(DuplexSt , InboundSt Duplex) -> (17, show t)
(TerminatedSt , UnnegotiatedSt Inbound) -> (18, show t)
(UnknownConnectionSt , UnnegotiatedSt Inbound) -> (19, show t)
(ReservedOutboundSt , UnnegotiatedSt Inbound) -> (20, show t)
(UnnegotiatedSt Inbound , InboundIdleSt Duplex) -> (21, show t)
(UnnegotiatedSt Inbound , InboundIdleSt Unidirectional) -> (22, show t)
(InboundIdleSt Duplex , InboundIdleSt Duplex) -> (23, show t)
(InboundIdleSt Duplex , InboundSt Duplex) -> (24, show t)
(InboundIdleSt Duplex , TerminatingSt) -> (25, show t)
(InboundSt Duplex , InboundIdleSt Duplex) -> (26, show t)
(InboundIdleSt Unidirectional , InboundSt Unidirectional) -> (27, show t)
(InboundIdleSt Unidirectional , TerminatingSt) -> (28, show t)
(InboundSt Unidirectional , InboundIdleSt Unidirectional) -> (29, show t)
(OutboundIdleSt Duplex , InboundSt Duplex) -> (30, show t)
(OutboundIdleSt _dataFlow , TerminatingSt) -> (31, show t)
(TerminatingSt , TerminatedSt) -> (32, show t)
(_ , TerminatedSt) -> (33, show t)
(_ , UnknownConnectionSt) -> (34, show t)
(TerminatingSt , UnnegotiatedSt Inbound) -> (35, show t)
_ -> (99, show t)

-- | List of all valid transition's names.
--
-- NOTE: Should be in sync with 'verifyAbstractTransition', but due to #3516
-- abrupt terminating transitions and identity transitions are trimmed for now,
-- until we tweak the generators to include more connection errors.
--
allValidTransitionsNames :: [String]
allValidTransitionsNames =
map show
[ Transition UnknownConnectionSt ReservedOutboundSt
-- , Transition TerminatedSt ReservedOutboundSt
, Transition ReservedOutboundSt (UnnegotiatedSt Outbound)
, Transition (UnnegotiatedSt Outbound) OutboundUniSt
, Transition (UnnegotiatedSt Outbound) (OutboundDupSt Ticking)
, Transition OutboundUniSt (OutboundIdleSt Unidirectional)
, Transition (OutboundDupSt Ticking) (OutboundDupSt Expired)
-- , Transition (OutboundDupSt Expired) (OutboundIdleSt Duplex)
-- , Transition (OutboundIdleSt Unidirectional) (OutboundIdleSt Unidirectional)
-- , Transition (OutboundIdleSt Duplex) (OutboundIdleSt Duplex)
, Transition (OutboundDupSt Ticking) (InboundIdleSt Duplex)
, Transition (InboundIdleSt Duplex) (OutboundDupSt Ticking)
, Transition (OutboundDupSt Ticking) DuplexSt
-- , Transition (OutboundDupSt Expired) DuplexSt
-- , Transition (OutboundDupSt Ticking) (OutboundDupSt Ticking)
-- , Transition (OutboundDupSt Expired) (OutboundDupSt Expired)
, Transition (InboundSt Duplex) DuplexSt
, Transition DuplexSt (OutboundDupSt Ticking)
, Transition DuplexSt (InboundSt Duplex)
-- , Transition TerminatedSt (UnnegotiatedSt Inbound)
, Transition UnknownConnectionSt (UnnegotiatedSt Inbound)
, Transition ReservedOutboundSt (UnnegotiatedSt Inbound)
, Transition (UnnegotiatedSt Inbound) (InboundIdleSt Duplex)
, Transition (UnnegotiatedSt Inbound) (InboundIdleSt Unidirectional)
-- , Transition (InboundIdleSt Duplex) (InboundIdleSt Duplex)
, Transition (InboundIdleSt Duplex) (InboundSt Duplex)
-- , Transition (InboundIdleSt Duplex) TerminatingSt
-- , Transition (InboundSt Duplex) (InboundIdleSt Duplex)
-- , Transition (InboundIdleSt Unidirectional) (InboundSt Unidirectional)
-- , Transition (InboundIdleSt Unidirectional) TerminatingSt
-- , Transition (InboundSt Unidirectional) (InboundIdleSt Unidirectional)
-- , Transition (OutboundIdleSt Duplex) (InboundSt Duplex)
-- , Transition (OutboundIdleSt Unidirectional) TerminatingSt
-- , Transition (OutboundIdleSt Duplex) TerminatingSt
, Transition TerminatingSt TerminatedSt
-- , Transition TerminatedSt UnknownConnectionSt
-- , Transition TerminatingSt (UnnegotiatedSt Inbound)
-- , Transition (_) (TerminatedSt)
-- , Transition (_) (UnknownConnectionSt)
]

newtype SkewedBool = SkewedBool Bool
deriving Show

Expand Down
Loading