server-test: fail property if protocol does not complete

IntersectMBO · Oct 14, 2021 · 7a98cfa · 7a98cfa
1 parent c052323
commit 7a98cfa
Showing 1 changed file with 6 additions and 6 deletions.
diff --git a/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs
@@ -800,9 +800,9 @@ unidirectionalExperiment snocket socket clientAndServerData = do
                   )
             pure $
               foldr
-                (\(r, expected) acc ->
+                (\ (r, expected) acc ->
                   case r of
-                    Left _ -> acc
+                    Left err -> counterexample (show err) False
                     Right a -> a === expected .&&. acc)
                 (property True)
                 $ zip rs (expectedResult clientAndServerData clientAndServerData)
@@ -923,17 +923,17 @@ bidirectionalExperiment
 
               pure $
                 foldr
-                  (\(r, expected) acc ->
+                  (\ (r, expected) acc ->
                     case r of
-                      Left _ -> acc
+                      Left err -> counterexample (show err) False
                       Right a -> a === expected .&&. acc)
                   (property True)
                   (zip rs0 (expectedResult clientAndServerData0 clientAndServerData1))
                 .&&.
                 foldr
-                  (\(r, expected) acc ->
+                  (\ (r, expected) acc ->
                     case r of
-                      Left _ -> acc
+                      Left err -> counterexample (show err) False
                       Right a -> a === expected .&&. acc)
                   (property True)
                   (zip rs1 (expectedResult clientAndServerData1 clientAndServerData0))