Check remaining points after intersection

input-output-hk · Feb 8, 2023 · 3a18ea4 · 3a18ea4
1 parent 6042acb
commit 3a18ea4
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 32 deletions.
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs
@@ -390,26 +390,29 @@ headerSyncIntersectExpectNotFound points = runMarloweHeaderSyncClient
     , recvMsgIntersectFound = \_ -> fail "Expected intersect not found, got intersect found"
     }
 
-headerSyncIntersectExpectFound_ :: [BlockHeader] -> BlockHeader -> Integration ()
-headerSyncIntersectExpectFound_ points expectedPoint =
-  headerSyncIntersectExpectFound points expectedPoint
-    $ pure
-    $ HeaderSync.SendMsgDone ()
-
 headerSyncIntersectExpectFound
   :: [BlockHeader]
   -> BlockHeader
-  -> Integration (HeaderSync.ClientStIdle Integration a)
-  -> Integration a
-headerSyncIntersectExpectFound points expectedPoint next = runMarloweHeaderSyncClient
+  -> [BlockHeader]
+  -> Integration ()
+headerSyncIntersectExpectFound points expectedIntersection remainingPoints = runMarloweHeaderSyncClient
   $ HeaderSync.MarloweHeaderSyncClient
   $ pure
   $ HeaderSync.SendMsgIntersect points HeaderSync.ClientStIntersect
     { recvMsgIntersectNotFound = fail "Expected intersect found, got intersect not found"
-    , recvMsgIntersectFound = \actualPoint -> do
-        liftIO $ actualPoint `shouldBe` expectedPoint
-        next
+    , recvMsgIntersectFound = \actualIntersection -> do
+        liftIO $ actualIntersection `shouldBe` expectedIntersection
+        expectRemainingPoints remainingPoints
     }
+  where
+    expectRemainingPoints [] = pure
+      $ headerSyncRequestNextExpectWait
+      $ pure
+      $ HeaderSync.SendMsgCancel
+      $ HeaderSync.SendMsgDone ()
+    expectRemainingPoints (x : xs) = HeaderSync.SendMsgRequestNext <$> headerSyncExpectNewHeaders \block _ -> do
+      liftIO $ block `shouldBe` x
+      expectRemainingPoints xs
 
 marloweSyncIntersectExpectNotFound :: ContractId -> [BlockHeader] -> Integration ()
 marloweSyncIntersectExpectNotFound contractId points = runMarloweSyncClient
@@ -420,31 +423,30 @@ marloweSyncIntersectExpectNotFound contractId points = runMarloweSyncClient
     , recvMsgIntersectFound = \_ -> fail "Expected intersect not found, got intersect found"
     }
 
-marloweSyncIntersectExpectFound_
-  :: ContractId
-  -> [BlockHeader]
-  -> BlockHeader
-  -> Integration ()
-marloweSyncIntersectExpectFound_ contractId points expectedPoint =
-  marloweSyncIntersectExpectFound contractId points expectedPoint
-    $ pure
-    $ MarloweSync.SendMsgDone ()
-
 marloweSyncIntersectExpectFound
   :: ContractId
   -> [BlockHeader]
   -> BlockHeader
-  -> Integration (MarloweSync.ClientStIdle 'V1 Integration a)
-  -> Integration a
-marloweSyncIntersectExpectFound contractId points expectedPoint next = runMarloweSyncClient
+  -> [BlockHeader]
+  -> Integration ()
+marloweSyncIntersectExpectFound contractId points expectedIntersection remainingPoints = runMarloweSyncClient
   $ MarloweSync.MarloweSyncClient
   $ pure
   $ MarloweSync.SendMsgIntersect contractId MarloweV1 points MarloweSync.ClientStIntersect
     { recvMsgIntersectNotFound = fail "Expected intersect found, got intersect not found"
-    , recvMsgIntersectFound = \actualPoint -> do
-        liftIO $ actualPoint `shouldBe` expectedPoint
-        next
+    , recvMsgIntersectFound = \actualIntersection -> do
+        liftIO $ actualIntersection `shouldBe` expectedIntersection
+        expectRemainingPoints remainingPoints
     }
+  where
+    expectRemainingPoints [] = pure
+      $ marloweSyncRequestNextExpectWait
+      $ pure
+      $ MarloweSync.SendMsgCancel
+      $ MarloweSync.SendMsgDone ()
+    expectRemainingPoints (x : xs) = MarloweSync.SendMsgRequestNext <$> marloweSyncExpectRollForward \block _ -> do
+      liftIO $ block `shouldBe` x
+      expectRemainingPoints xs
 
 marloweSyncPollExpectWait
   :: MonadFail m => m (MarloweSync.ClientStWait v m a)

diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Intersections.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Intersections.hs
@@ -43,10 +43,10 @@ spec = it "Intersections" $ withLocalMarloweRuntime $ runIntegrationTest do
   marloweSyncIntersectExpectNotFound idA []
   -- 12. Do a MarloweSync Intersect with points [A0..A3]
   -- 13. Expect Intersect found @ A3
-  marloweSyncIntersectExpectFound_ idA [pA0, pA1, pA2, pA3] pA3
+  marloweSyncIntersectExpectFound idA [pA0, pA1, pA2, pA3] pA3 [pA4, pA5]
   -- 14. Do a MarloweSync Intersect with points [A2..A4]
   -- 15. Expect Intersect found @ A4
-  marloweSyncIntersectExpectFound_ idA [pA2, pA3, pA4] pA4
+  marloweSyncIntersectExpectFound idA [pA2, pA3, pA4] pA4 [pA5]
   -- 16. Do a MarloweSync Intersect with points [B0,A1-A5]
   -- 17. Expect Intersect not found
   marloweSyncIntersectExpectNotFound idA [pB0, pA1, pA2, pA3, pA4, pA5]
@@ -55,10 +55,10 @@ spec = it "Intersections" $ withLocalMarloweRuntime $ runIntegrationTest do
   headerSyncIntersectExpectNotFound []
   -- 20. Do a MarloweHeaderSync with points [A0, B0, C0]
   -- 21. Expect Intersect found @ C0
-  headerSyncIntersectExpectFound_ [pA0, pB0, pC0] pC0
+  headerSyncIntersectExpectFound [pA0, pB0, pC0] pC0 []
   -- 22. Do a MarloweHeaderSync with points [A0, B0]
   -- 23. Expect Intersect found @ B0
-  headerSyncIntersectExpectFound_ [pA0, pB0] pB0
+  headerSyncIntersectExpectFound [pA0, pB0] pB0 [pC0]
   -- 24. Do a MarloweHeaderSync with points [X, A0, B0, C0]
   -- 25. Expect Intersect not found
   headerSyncIntersectExpectNotFound [pX, pA0, pB0, pC0]