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

Jump to bottom

Diffusion test for inbound governor transitions #3633

Merged
merged 8 commits into from
Apr 26, 2022
+1,184 −740
Merged

Diffusion test for inbound governor transitions #3633

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
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
662c9e6
Added IG Valid Transitions test
bolt12 Feb 22, 2022
45371bd
Added IG Valid Transition order test
bolt12 Feb 22, 2022
ee0f8d5
Reduce time on diffusion tests
bolt12 Apr 26, 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 $
FirstToFinish
(LazySTM.readTVar connDelayTimeoutVar >>= check)
<>
FirstToFinish (do
b <- not . Map.member (normaliseId connId)
<$> readTVar (nsConnections state)
check b
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