Renamed BearerInfoScript to AbsBearerInfoScript

IntersectMBO · Nov 23, 2021 · 60726f0 · 60726f0
1 parent 3d2352d
commit 60726f0
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 46 deletions.
diff --git a/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs
@@ -118,9 +118,9 @@ import qualified Ouroboros.Network.Snocket as Snocket
 import           Simulation.Network.Snocket
 
 import           Ouroboros.Network.Testing.Data.AbsBearerInfo
-                   (NonFailingBearerInfoScript(..), AbsBearerInfo (..),
+                   (NonFailingAbsBearerInfoScript(..), AbsBearerInfo (..),
                     AbsDelay (..), AbsAttenuation (..), AbsSpeed (..),
-                    AbsSDUSize (..), BearerInfoScript (..))
+                    AbsSDUSize (..), AbsBearerInfoScript (..))
 import           Ouroboros.Network.Testing.Data.Script (singletonScript)
 import           Ouroboros.Network.Testing.Utils (genDelayWithPrecision)
 
@@ -856,7 +856,7 @@ unidirectionalExperiment timeouts snocket socket clientAndServerData = do
                 (property True)
                 $ zip rs (expectedResult clientAndServerData clientAndServerData)
 
-prop_unidirectional_Sim :: Script NonFailingBearerInfoScript
+prop_unidirectional_Sim :: Script NonFailingAbsBearerInfoScript
                         -> ClientAndServerData Int
                         -> Property
 prop_unidirectional_Sim script clientAndServerData =
@@ -1018,7 +1018,7 @@ bidirectionalExperiment
                 ))
 
 
-prop_bidirectional_Sim :: Script NonFailingBearerInfoScript -> ClientAndServerData Int -> ClientAndServerData Int -> Property
+prop_bidirectional_Sim :: Script NonFailingAbsBearerInfoScript -> ClientAndServerData Int -> ClientAndServerData Int -> Property
 prop_bidirectional_Sim script data0 data1 =
   simulatedPropertyWithTimeout 7200 $
     withSnocket sayTracer
@@ -2015,7 +2015,7 @@ verifyRemoteTransitionOrder (h:t) = go t h
 --
 prop_connection_manager_valid_transitions :: Int
                                           -> ArbDataFlow
-                                          -> Script BearerInfoScript
+                                          -> Script AbsBearerInfoScript
                                           -> MultiNodeScript Int TestAddr
                                           -> Property
 prop_connection_manager_valid_transitions serverAcc (ArbDataFlow dataFlow)
@@ -2086,7 +2086,7 @@ prop_connection_manager_valid_transitions serverAcc (ArbDataFlow dataFlow)
 --
 prop_connection_manager_no_invalid_traces :: Int
                                           -> ArbDataFlow
-                                          -> Script BearerInfoScript
+                                          -> Script AbsBearerInfoScript
                                           -> MultiNodeScript Int TestAddr
                                           -> Property
 prop_connection_manager_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
@@ -2135,7 +2135,7 @@ prop_connection_manager_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
 --
 prop_connection_manager_valid_transition_order :: Int
                                                -> ArbDataFlow
-                                               -> Script BearerInfoScript
+                                               -> Script AbsBearerInfoScript
                                                -> MultiNodeScript Int TestAddr
                                                -> Property
 prop_connection_manager_valid_transition_order serverAcc (ArbDataFlow dataFlow)
@@ -2179,7 +2179,7 @@ prop_connection_manager_valid_transition_order serverAcc (ArbDataFlow dataFlow)
 --
 prop_connection_manager_counters :: Int
                                -> ArbDataFlow
-                               -> Script NonFailingBearerInfoScript
+                               -> Script NonFailingAbsBearerInfoScript
                                -> MultiNodeScript Int TestAddr
                                -> Property
 prop_connection_manager_counters serverAcc (ArbDataFlow dataFlow)
@@ -2362,7 +2362,7 @@ prop_connection_manager_counters serverAcc (ArbDataFlow dataFlow)
 --
 prop_inbound_governor_valid_transitions :: Int
                                         -> ArbDataFlow
-                                        -> Script BearerInfoScript
+                                        -> Script AbsBearerInfoScript
                                         -> MultiNodeScript Int TestAddr
                                         -> Property
 prop_inbound_governor_valid_transitions serverAcc (ArbDataFlow dataFlow)
@@ -2404,7 +2404,7 @@ prop_inbound_governor_valid_transitions serverAcc (ArbDataFlow dataFlow)
 --
 prop_inbound_governor_no_unsupported_state :: Int
                                            -> ArbDataFlow
-                                           -> Script BearerInfoScript
+                                           -> Script AbsBearerInfoScript
                                            -> MultiNodeScript Int TestAddr
                                            -> Property
 prop_inbound_governor_no_unsupported_state serverAcc (ArbDataFlow dataFlow)
@@ -2457,7 +2457,7 @@ prop_inbound_governor_no_unsupported_state serverAcc (ArbDataFlow dataFlow)
 --
 prop_inbound_governor_no_invalid_traces :: Int
                                         -> ArbDataFlow
-                                        -> Script BearerInfoScript
+                                        -> Script AbsBearerInfoScript
                                         -> MultiNodeScript Int TestAddr
                                         -> Property
 prop_inbound_governor_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
@@ -2503,7 +2503,7 @@ prop_inbound_governor_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
 --
 prop_inbound_governor_valid_transition_order :: Int
                                              -> ArbDataFlow
-                                             -> Script BearerInfoScript
+                                             -> Script AbsBearerInfoScript
                                              -> MultiNodeScript Int TestAddr
                                              -> Property
 prop_inbound_governor_valid_transition_order serverAcc (ArbDataFlow dataFlow)
@@ -2542,7 +2542,7 @@ prop_inbound_governor_valid_transition_order serverAcc (ArbDataFlow dataFlow)
 --
 prop_inbound_governor_counters :: Int
                                -> ArbDataFlow
-                               -> Script NonFailingBearerInfoScript
+                               -> Script NonFailingAbsBearerInfoScript
                                -> MultiNodeScript Int TestAddr
                                -> Property
 prop_inbound_governor_counters serverAcc (ArbDataFlow dataFlow)
@@ -2641,7 +2641,7 @@ prop_inbound_governor_counters serverAcc (ArbDataFlow dataFlow)
 -- Manager.
 --
 prop_connection_manager_pruning :: Int
-                                -> Script NonFailingBearerInfoScript
+                                -> Script NonFailingAbsBearerInfoScript
                                 -> MultiNodePruningScript Int
                                 -> Property
 prop_connection_manager_pruning serverAcc
@@ -2712,7 +2712,7 @@ prop_connection_manager_pruning serverAcc
 -- Inbound Governor.
 --
 prop_inbound_governor_pruning :: Int
-                              -> Script NonFailingBearerInfoScript
+                              -> Script NonFailingAbsBearerInfoScript
                               -> MultiNodePruningScript Int
                               -> Property
 prop_inbound_governor_pruning serverAcc
@@ -2807,7 +2807,7 @@ prop_inbound_governor_pruning serverAcc
 --   the picked peers belong to the choice set.
 --
 prop_never_above_hardlimit :: Int
-                           -> Script NonFailingBearerInfoScript
+                           -> Script NonFailingAbsBearerInfoScript
                            -> MultiNodePruningScript Int
                            -> Property
 prop_never_above_hardlimit serverAcc
@@ -3012,7 +3012,7 @@ unit_connection_terminated_when_negotiating =
         Script
         $ NonEmpty.fromList
         $ replicate 4
-        $ BearerInfoScript
+        $ AbsBearerInfoScript
         $ Script
         $ NonEmpty.fromList
         $ repeat

diff --git a/ouroboros-network-framework/test/Test/Simulation/Network/Snocket.hs b/ouroboros-network-framework/test/Test/Simulation/Network/Snocket.hs
@@ -55,7 +55,7 @@ import           Ouroboros.Network.Channel
 import           Ouroboros.Network.Snocket
 import           Ouroboros.Network.Util.ShowProxy
 import           Ouroboros.Network.Testing.Utils (Delay (..))
-import           Simulation.Network.Snocket
+import           Simulation.Network.Snocket (FD, BearerInfo (..), withSnocket)
 
 import           Network.Mux
 import           Network.Mux.Types (SDUSize (..))
@@ -69,19 +69,19 @@ import           Test.Ouroboros.Network.Orphans ()  -- ShowProxy ReqResp instanc
 -- ShowProxy ReqResp instance
 import           Ouroboros.Network.Testing.Data.Script
                   (Script(..), singletonScript)
+import           Ouroboros.Network.Testing.Data.AbsBearerInfo
 
 import           Test.QuickCheck hiding (Result (..))
 import           Test.QuickCheck.Instances.ByteString
 import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.QuickCheck (testProperty)
-import Ouroboros.Network.Testing.Data.AbsBearerInfo
 
 
 tests :: TestTree
 tests =
     testGroup "Simulation.Network.Snocket"
-    [ testProperty "client-server" prop_client_server
-    ]
+      [ testProperty "client-server" prop_client_server
+      ]
 
 type TestAddr      = TestAddress Int
 type TestFD      m = FD m TestAddr
@@ -341,7 +341,7 @@ toBearerInfo abi =
 -- Properties
 --
 
-prop_client_server :: [ByteString] -> Script BearerInfoScript -> Property
+prop_client_server :: [ByteString] -> Script AbsBearerInfoScript -> Property
 prop_client_server payloads (Script script) =
     let tr = runSimTrace $ clientServerSimulation script' payloads
     in -- Debug.traceShow script $
@@ -360,7 +360,7 @@ prop_client_server payloads (Script script) =
          Right (Just b) -> property b
   where
     Script noAttenuationScript =
-      singletonScript (BearerInfoScript (singletonScript absNoAttenuation))
+      singletonScript (AbsBearerInfoScript (singletonScript absNoAttenuation))
     script' =
       (toBearerInfo <$>) . unBIScript <$> Script (script <> noAttenuationScript)
 

diff --git a/ouroboros-network-testing/src/Ouroboros/Network/Testing/Data/AbsBearerInfo.hs b/ouroboros-network-testing/src/Ouroboros/Network/Testing/Data/AbsBearerInfo.hs
@@ -3,9 +3,9 @@
 {-# LANGUAGE NumericUnderscores #-}
 
 module Ouroboros.Network.Testing.Data.AbsBearerInfo
-  ( BearerInfoScript(..)
+  ( AbsBearerInfoScript(..)
   , canFail
-  , NonFailingBearerInfoScript(..)
+  , NonFailingAbsBearerInfoScript(..)
   , AbsDelay (..)
   , delay
   , AbsSpeed (..)
@@ -241,8 +241,8 @@ instance Arbitrary AbsBearerInfo where
       | a <- shrink (abiSDUSize abi)
       ]
 
-newtype BearerInfoScript =
-  BearerInfoScript { unBIScript :: Script AbsBearerInfo }
+newtype AbsBearerInfoScript =
+  AbsBearerInfoScript { unBIScript :: Script AbsBearerInfo }
   deriving       Show via (Script AbsBearerInfo)
   deriving stock Eq
 
@@ -252,15 +252,15 @@ fixupAbsBearerInfos bis =
       then bis ++ [absNoAttenuation]
       else bis
 
-instance Arbitrary BearerInfoScript where
-  arbitrary = BearerInfoScript
+instance Arbitrary AbsBearerInfoScript where
+  arbitrary = AbsBearerInfoScript
             . Script
             . NonEmpty.fromList
             . fixupAbsBearerInfos
           <$> listOf1 arbitrary
 
-  shrink (BearerInfoScript (Script script)) =
-    [ BearerInfoScript (Script script')
+  shrink (AbsBearerInfoScript (Script script)) =
+    [ AbsBearerInfoScript (Script script')
     | script'
         <- map (NonEmpty.fromList . fixupAbsBearerInfos)
         . filter (not . List.null)
@@ -270,14 +270,14 @@ instance Arbitrary BearerInfoScript where
     , script' /= script
     ]
 
-newtype NonFailingBearerInfoScript =
-  NonFailingBearerInfoScript { unNFBIScript :: Script AbsBearerInfo }
+newtype NonFailingAbsBearerInfoScript =
+  NonFailingAbsBearerInfoScript { unNFBIScript :: Script AbsBearerInfo }
   deriving       Show via (Script AbsBearerInfo)
   deriving stock Eq
 
-toNonFailingBearerInfoScript :: BearerInfoScript -> NonFailingBearerInfoScript
-toNonFailingBearerInfoScript (BearerInfoScript script) =
-    NonFailingBearerInfoScript $ fmap unfail script
+toNonFailingAbsBearerInfoScript :: AbsBearerInfoScript -> NonFailingAbsBearerInfoScript
+toNonFailingAbsBearerInfoScript (AbsBearerInfoScript script) =
+    NonFailingAbsBearerInfoScript $ fmap unfail script
   where
     unfail :: AbsBearerInfo -> AbsBearerInfo
     unfail bi =
@@ -291,7 +291,7 @@ toNonFailingBearerInfoScript (BearerInfoScript script) =
     unfailAtt (SpeedAttenuation speed _ _) = NoAttenuation speed
     unfailAtt a = a
 
-instance Arbitrary NonFailingBearerInfoScript where
-  arbitrary = toNonFailingBearerInfoScript <$> arbitrary
-  shrink (NonFailingBearerInfoScript script) =
-    toNonFailingBearerInfoScript <$> shrink (BearerInfoScript script)
+instance Arbitrary NonFailingAbsBearerInfoScript where
+  arbitrary = toNonFailingAbsBearerInfoScript <$> arbitrary
+  shrink (NonFailingAbsBearerInfoScript script) =
+    toNonFailingAbsBearerInfoScript <$> shrink (AbsBearerInfoScript script)
diff --git a/ouroboros-network-testing/test/Test/Ouroboros/Network/Testing/Data/AbsBearerInfo.hs b/ouroboros-network-testing/test/Test/Ouroboros/Network/Testing/Data/AbsBearerInfo.hs
@@ -6,8 +6,8 @@ import qualified Data.List.NonEmpty as NonEmpty
 
 import           Ouroboros.Network.Testing.Data.AbsBearerInfo
                    ( AbsBearerInfo,
-                     BearerInfoScript(..),
-                     NonFailingBearerInfoScript(..), canFail )
+                     AbsBearerInfoScript(..),
+                     NonFailingAbsBearerInfoScript(..), canFail )
 import           Ouroboros.Network.Testing.Data.Script (Script(Script))
 
 import           Test.Tasty ( testGroup, TestTree )
@@ -29,13 +29,15 @@ prop_shrinker_AbsBearerInfo :: Fixed AbsBearerInfo -> Bool
 prop_shrinker_AbsBearerInfo (Fixed abi) =
     abi `notElem` shrink abi
 
-prop_shrinker_BearerInfoScript :: Fixed BearerInfoScript -> Bool
+prop_shrinker_BearerInfoScript :: Fixed AbsBearerInfoScript -> Bool
 prop_shrinker_BearerInfoScript (Fixed bis) =
-    all (\bis'@(BearerInfoScript (Script s)) ->
+    all (\bis'@(AbsBearerInfoScript (Script s)) ->
                   bis /= bis'
                && not (canFail (NonEmpty.last s))
         )
         (shrink bis)
 
-prop_generator_NonFailingBeararInfoScript :: NonFailingBearerInfoScript -> Bool
-prop_generator_NonFailingBeararInfoScript (NonFailingBearerInfoScript s) = not (any canFail s)
+prop_generator_NonFailingBeararInfoScript :: NonFailingAbsBearerInfoScript
+                                          -> Bool
+prop_generator_NonFailingBeararInfoScript (NonFailingAbsBearerInfoScript s) =
+  not (any canFail s)