@@ -1,3 +1,9 @@
1+-- Test the TCP transport using QuickCheck generated scripts
2+--
3+-- TODO: This is not quite working yet. The main problem, I think, is the
4+-- allocation of "bundle ID"s to connections. The problem is exposed by the
5+-- aptly-named regression test script_Foo (to be renamed once I figure out what
6+-- bug that test is actually exposing :)
17module Main
28 ( main
39 -- Shush the compiler about unused definitions
@@ -123,9 +129,12 @@ data ExpEvent =
123129 deriving Show
124130
125131data RunState = RunState {
126− _endPoints :: [EndPoint]
127− , _connections :: [(Connection, ConnectionInfo)]
128− , _expectedEvents :: Map EndPointAddress [ExpEvent]
132+ _endPoints :: [EndPoint]
133+ , _connections :: [(Connection, ConnectionInfo)]
134+ , _expectedEvents :: Map EndPointAddress [ExpEvent]
135+ -- | For each endpoint we create we create a thread that forwards the events
136+ -- of that endpoint to a central channel. We collect the thread IDs so that
137+ -- we can kill these thread when we are done.
129138 , _forwardingThreads :: [ThreadId]
130139 -- | When a connection from A to be may break, we add both (A, B, n)
131140 -- and (B, A, n) to _mayBreak. Then once we detect that from A to B
@@ -135,12 +144,12 @@ data RunState = RunState {
135144 -- has broken in the other direction.
136145 --
137146 -- | Invariant: not mayBreak && broken
138− , _mayBreak :: Set (EndPointAddress, EndPointAddress, BundleId)
139− , _broken :: Set (EndPointAddress, EndPointAddress, BundleId)
147+ , _mayBreak :: Set (EndPointAddress, EndPointAddress, BundleId)
148+ , _broken :: Set (EndPointAddress, EndPointAddress, BundleId)
140149 -- | Current bundle ID between two endpoints
141150 --
142151 -- Invariant: For all keys (A, B), A <= B
143− , _currentBundle :: Map (EndPointAddress, EndPointAddress) BundleId
152+ , _currentBundle :: Map (EndPointAddress, EndPointAddress) BundleId
144153 }
145154
146155initialRunState :: RunState
@@ -177,8 +186,8 @@ verify (transport, transportInternals) script = do
177186 endPointB <- address <$> get (endPointAtIx j)
178187 mConn <- liftIO $ connect endPointA endPointB ReliableOrdered defaultConnectHints
179188 let bundleId = currentBundle (address endPointA) endPointB
180− connBroken = broken (address endPointA) endPointB
181− connMayBreak = mayBreak (address endPointA) endPointB
189+ connBroken = broken (address endPointA) endPointB
190+ connMayBreak = mayBreak (address endPointA) endPointB
182191 case mConn of
183192 Right conn -> do
184193 bundleBroken <- get bundleId >>= get . connBroken
@@ -224,6 +233,9 @@ verify (transport, transportInternals) script = do
224233 else
225234 liftIO $ throwIO err
226235 append (expectedEventsAt (target connInfo)) (ExpReceived connInfo payload)
236+ -- TODO: This will only work if a connection between 'i' and 'j' has
237+ -- already been established. We would need to modify the mock network
238+ -- layer to support breaking "future" connections
227239 runCmd (BreakAfterReads n i j) = do
228240 endPointA <- address <$> get (endPointAtIx i)
229241 endPointB <- address <$> get (endPointAtIx j)