wip

IntersectMBO · Jan 5, 2025 · 8510535 · 8510535
1 parent c933e56
commit 8510535
Showing 1 changed file with 13 additions and 4 deletions.
diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs
@@ -1440,20 +1440,29 @@ prop_diffusion_dns_can_recover ioSimTrace traceNumber =
     verify toRecover ttlMap recovered time ((t, ev):evs) =
       case ev of
         DiffusionLocalRootPeerTrace
-          (TraceLocalRootFailure dap failure) | notIOError failure ->
-            let dns = extractDomainName dap
+          failure | isFailure failure && notIOError failure ->
+            let dns = extractDomainName failure
                 ttl = fromMaybe 0 $ Map.lookup dns ttlMap
-                ttl' = case failure of
+                ttl' = case failReason failure of
                          Just (DNSError err) -> ttlForDnsError err ttl
                          _otherwise          -> clipTTLAbove (ttl * 2 + 5)
                 ttlMap' = Map.insert dns ttl' ttlMap
              in verify (Map.insert dns (addTime ttl' t) toRecover)
                         ttlMap'
                         recovered t evs
           where
+            failReason = \case
+              TraceLocalRootFailure _ reason -> reason
+              TraceLocalRootFailureVia _ _ reason -> reason
+              _otherwise -> error "impossible!"
             notIOError = \case
-              Just (DNSActions.IOError {}) -> False
+              TraceLocalRootFailure _ failure | Just (DNSActions.IOError {}) <- failure -> False
+              TraceLocalRootFailureVia _ _ failure | Just (DNSActions.IOError {}) <- failure -> False
               _otherwise -> True
+            isFailure (TraceLocalRootFailure {}) = True
+            isFailure (TraceLocalRootFailureVia {}) = True
+            isFailure _ = False
+
         DiffusionLocalRootPeerTrace
           (TraceLocalRootReconfigured _ _) ->
             verify Map.empty ttlMap recovered t evs