Skip to content

Commit

Permalink
Changed attenuation to adequate newtypes
Browse files Browse the repository at this point in the history
  • Loading branch information
@bolt12
bolt12 committed Nov 22, 2021
1 parent 42b6542 commit 8367d47
Showing 1 changed file with 72 additions and 47 deletions.
119 changes: 72 additions & 47 deletions ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs
View file
Expand Up @@ -123,7 +123,7 @@ import Test.Ouroboros.Network.ConnectionManager (verifyAbstractTransit
import Ouroboros.Network.Testing.Data.AbsBearerInfo
(NonFailingBearerInfoScript(..), AbsBearerInfo (..),
AbsDelay (..), AbsAttenuation (..), AbsSpeed (..),
AbsSDUSize (..))
AbsSDUSize (..), BearerInfoScript (BearerInfoScript))

tests :: TestTree
tests =
Expand Down Expand Up @@ -2012,11 +2012,12 @@ verifyRemoteTransitionOrder (h:t) = go t h
--
prop_connection_manager_valid_transitions :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_connection_manager_valid_transitions serverAcc (ArbDataFlow dataFlow)
absBi script@(MultiNodeScript l) =
(BearerInfoScript biScript)
script@(MultiNodeScript l) =
let trace = runSimTrace sim

abstractTransitionEvents :: Trace (SimResult ())
Expand Down Expand Up @@ -2072,7 +2073,7 @@ prop_connection_manager_valid_transitions serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
biScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
Expand All @@ -2082,11 +2083,12 @@ prop_connection_manager_valid_transitions serverAcc (ArbDataFlow dataFlow)
--
prop_connection_manager_no_invalid_traces :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_connection_manager_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
absBi (MultiNodeScript l) =
(BearerInfoScript biScript)
(MultiNodeScript l) =
let trace = runSimTrace sim

connectionManagerEvents :: Trace (SimResult ())
Expand Down Expand Up @@ -2121,7 +2123,7 @@ prop_connection_manager_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
biScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
Expand All @@ -2130,11 +2132,12 @@ prop_connection_manager_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
--
prop_connection_manager_valid_transition_order :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_connection_manager_valid_transition_order serverAcc (ArbDataFlow dataFlow)
absBi script@(MultiNodeScript l) =
(BearerInfoScript biScript)
script@(MultiNodeScript l) =
let trace = runSimTrace sim

abstractTransitionEvents :: Trace (SimResult ())
Expand All @@ -2156,10 +2159,10 @@ prop_connection_manager_valid_transition_order serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
biScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
-- | Check connection manager counters in `multinodeExperiment`.
--
-- Note: this test validates connection manager counters using an upper bound
-- approach since there's no reliable way to reconstruct the value that the
Expand All @@ -2172,10 +2175,12 @@ prop_connection_manager_valid_transition_order serverAcc (ArbDataFlow dataFlow)
-- aren't an issue.
--
prop_connection_manager_counters :: Int
-> ArbDataFlow
-> MultiNodeScript Int TestAddr
-> Property
-> ArbDataFlow
-> NonFailingBearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_connection_manager_counters serverAcc (ArbDataFlow dataFlow)
(NonFailingBearerInfoScript nfbiScript)
(MultiNodeScript l) =
let trace = runSimTrace sim

Expand Down Expand Up @@ -2326,7 +2331,7 @@ prop_connection_manager_counters serverAcc (ArbDataFlow dataFlow)
sim = do
mb <- timeout 7200
( withSnocket nullTracer
(singletonScript noAttenuation)
(toBearerInfo <$> nfbiScript)
$ \snocket getUniverse ->
multinodeExperiment (sayTracer <> Tracer traceM)
(sayTracer <> Tracer traceM)
Expand All @@ -2351,11 +2356,12 @@ prop_connection_manager_counters serverAcc (ArbDataFlow dataFlow)
--
prop_inbound_governor_valid_transitions :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_inbound_governor_valid_transitions serverAcc (ArbDataFlow dataFlow)
absBi script@(MultiNodeScript l) =
(BearerInfoScript biScript)
script@(MultiNodeScript l) =
let trace = runSimTrace sim

remoteTransitionTraceEvents :: Trace (SimResult ())
Expand Down Expand Up @@ -2383,7 +2389,7 @@ prop_inbound_governor_valid_transitions serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
biScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
Expand All @@ -2392,11 +2398,12 @@ prop_inbound_governor_valid_transitions serverAcc (ArbDataFlow dataFlow)
--
prop_inbound_governor_no_unsupported_state :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_inbound_governor_no_unsupported_state serverAcc (ArbDataFlow dataFlow)
absBi script@(MultiNodeScript l) =
(BearerInfoScript biScript)
script@(MultiNodeScript l) =
let trace = runSimTrace sim

inboundGovernorEvents :: Trace (SimResult ())
Expand Down Expand Up @@ -2434,7 +2441,7 @@ prop_inbound_governor_no_unsupported_state serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
biScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
Expand All @@ -2444,11 +2451,12 @@ prop_inbound_governor_no_unsupported_state serverAcc (ArbDataFlow dataFlow)
--
prop_inbound_governor_no_invalid_traces :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_inbound_governor_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
absBi (MultiNodeScript l) =
(BearerInfoScript absBi)
(MultiNodeScript l) =
let trace = runSimTrace sim

inboundGovernorEvents :: Trace (SimResult ()) (InboundGovernorTrace SimAddr)
Expand Down Expand Up @@ -2480,7 +2488,7 @@ prop_inbound_governor_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
absBi
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
Expand All @@ -2489,11 +2497,12 @@ prop_inbound_governor_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
--
prop_inbound_governor_valid_transition_order :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> BearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_inbound_governor_valid_transition_order serverAcc (ArbDataFlow dataFlow)
absBi script@(MultiNodeScript l) =
(BearerInfoScript biScript)
script@(MultiNodeScript l) =
let trace = runSimTrace sim

remoteTransitionTraceEvents :: Trace (SimResult ()) (RemoteTransitionTrace SimAddr)
Expand All @@ -2518,18 +2527,20 @@ prop_inbound_governor_valid_transition_order serverAcc (ArbDataFlow dataFlow)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(Script (toBearerInfo absBi :| [noAttenuation]))
biScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment`.
-- | Check inbound governor counters in `multinodeExperiment`.
--
-- Note: this test validates inbound governor counters.
--
prop_inbound_governor_counters :: Int
-> ArbDataFlow
-> NonFailingBearerInfoScript
-> MultiNodeScript Int TestAddr
-> Property
prop_inbound_governor_counters serverAcc (ArbDataFlow dataFlow)
(NonFailingBearerInfoScript nfbiScript)
script@(MultiNodeScript l) =
let trace = runSimTrace sim

Expand Down Expand Up @@ -2620,7 +2631,7 @@ prop_inbound_governor_counters serverAcc (ArbDataFlow dataFlow)

sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
(singletonScript noAttenuation)
nfbiScript
maxAcceptedConnectionsLimit l

-- | Property wrapping `multinodeExperiment` that has a generator optimized for triggering
Expand All @@ -2630,8 +2641,12 @@ prop_inbound_governor_counters serverAcc (ArbDataFlow dataFlow)
-- connections hard limit we do not end up triggering any illegal transition in Connection
-- Manager.
--
prop_connection_manager_pruning :: Int -> MultiNodePruningScript Int -> Property
prop_connection_manager_pruning :: Int
-> NonFailingBearerInfoScript
-> MultiNodePruningScript Int
-> Property
prop_connection_manager_pruning serverAcc
(NonFailingBearerInfoScript nfbiScript)
(MultiNodePruningScript acceptedConnLimit l) =
let trace = runSimTrace sim

Expand Down Expand Up @@ -2686,7 +2701,7 @@ prop_connection_manager_pruning serverAcc
$ abstractTransitionEvents
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc Duplex (singletonScript noAttenuation)
sim = multiNodeSim serverAcc Duplex nfbiScript
acceptedConnLimit l

-- | Property wrapping `multinodeExperiment` that has a generator optimized for triggering
Expand All @@ -2696,8 +2711,12 @@ prop_connection_manager_pruning serverAcc
-- connections hard limit we do not end up triggering any illegal transition in the
-- Inbound Governor.
--
prop_inbound_governor_pruning :: Int -> MultiNodePruningScript Int -> Property
prop_inbound_governor_pruning :: Int
-> NonFailingBearerInfoScript
-> MultiNodePruningScript Int
-> Property
prop_inbound_governor_pruning serverAcc
(NonFailingBearerInfoScript nfbiScript)
(MultiNodePruningScript acceptedConnLimit l) =
let trace = runSimTrace sim

Expand Down Expand Up @@ -2774,16 +2793,20 @@ prop_inbound_governor_pruning serverAcc
$ (remoteTransitionTraceEvents, inboundGovernorEvents)
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc Duplex (singletonScript noAttenuation)
sim = multiNodeSim serverAcc Duplex nfbiScript
acceptedConnLimit l

-- | Property wrapping `multinodeExperiment` that has a generator optimized for triggering
-- pruning, and random generated number of connections hard limit.
--
-- We test that we never go above hard limit of incoming connections.
--
prop_never_above_hardlimit :: Int -> MultiNodePruningScript Int -> Property
prop_never_above_hardlimit :: Int
-> NonFailingBearerInfoScript
-> MultiNodePruningScript Int
-> Property
prop_never_above_hardlimit serverAcc
(NonFailingBearerInfoScript nfbiScript)
(MultiNodePruningScript
acceptedConnLimit@AcceptedConnectionsLimit
{ acceptedConnectionsHardLimit = hardlimit }
Expand All @@ -2806,7 +2829,6 @@ prop_never_above_hardlimit serverAcc
inboundGovernorEvents = traceWithNameTraceEvents trace

in tabulate "ConnectionEvents" (map showConnectionEvents l)
-- . counterexample (ppTrace_ trace)
. counterexample (ppScript (MultiNodeScript l))
. counterexample (Trace.ppTrace show show connectionManagerEvents)
. counterexample (Trace.ppTrace show show abstractTransitionEvents)
Expand Down Expand Up @@ -2834,7 +2856,7 @@ prop_never_above_hardlimit serverAcc
$ connectionManagerEvents
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc Duplex (singletonScript noAttenuation)
sim = multiNodeSim serverAcc Duplex nfbiScript
acceptedConnLimit l


Expand Down Expand Up @@ -2935,14 +2957,15 @@ unit_server_accept_error ioErrType ioErrThrowOrReturn =
multiNodeSim :: (Serialise req, Show req, Eq req, Typeable req)
=> req
-> DataFlow
-> Script BearerInfo
-> Script AbsBearerInfo
-> AcceptedConnectionsLimit
-> [ConnectionEvent req TestAddr]
-> IOSim s ()
multiNodeSim serverAcc dataFlow script acceptedConnLimit l = do
multiNodeSim serverAcc dataFlow script
acceptedConnLimit l = do
mb <- timeout 7200
( withSnocket nullTracer
script
(toBearerInfo <$> script)
$ \snocket _ ->
multinodeExperiment (Tracer traceM)
(Tracer traceM)
Expand All @@ -2966,14 +2989,16 @@ unit_connection_terminated_when_negotiating :: Property
unit_connection_terminated_when_negotiating =
let arbDataFlow = ArbDataFlow Unidirectional
absBearerInfo =
AbsBearerInfo
{ abiConnectionDelay = SmallDelay
, abiInboundAttenuation = NoAttenuation FastSpeed
, abiOutboundAttenuation = NoAttenuation FastSpeed
, abiInboundWriteFailure = Nothing
, abiOutboundWriteFailure = Just 3
, abiSDUSize = LargeSDU
}
BearerInfoScript
$ singletonScript
$ AbsBearerInfo
{ abiConnectionDelay = SmallDelay
, abiInboundAttenuation = NoAttenuation FastSpeed
, abiOutboundAttenuation = NoAttenuation FastSpeed
, abiInboundWriteFailure = Nothing
, abiOutboundWriteFailure = Just 3
, abiSDUSize = LargeSDU
}
multiNodeScript =
MultiNodeScript
[ StartServer 0 (TestAddr {unTestAddr = TestAddress 24}) 0
Expand Down

0 comments on commit 8367d47

Please sign in to comment.