Simplify property prop_readPoolLifeCycleStatus.

cardano-foundation · Aug 13, 2020 · 3c4c614 · 3c4c614
1 parent bf697df
commit 3c4c614
Showing 1 changed file with 21 additions and 25 deletions.
diff --git a/lib/core/test/unit/Cardano/Pool/DB/Properties.hs b/lib/core/test/unit/Cardano/Pool/DB/Properties.hs
@@ -650,15 +650,10 @@ prop_readPoolLifeCycleStatus
   where
     setup = run $ atomically cleanDB
 
-    expectedStatus = determinePoolLifeCycleStatus
-        mFinalRegistration
-        mFinalRetirement
-
     prop = do
-        actualStatus <-
-            run $ atomically $ do
-                mapM_ (uncurry putCertificate) certificatePublications
-                readPoolLifeCycleStatus sharedPoolId
+        actualStatus <- run $ atomically $ do
+            mapM_ (uncurry putCertificate) certificatePublications
+            readPoolLifeCycleStatus sharedPoolId
         poolsMarkedToRetire <-
             run $ atomically $ listRetiredPools $ EpochNo maxBound
         monitor $ counterexample $ unlines
@@ -688,35 +683,36 @@ prop_readPoolLifeCycleStatus
                 PoolRegisteredAndRetired _regCert retCert ->
                     poolsMarkedToRetire == [retCert]
 
-    certificatePublications :: [(CertificatePublicationTime, PoolCertificate)]
-    certificatePublications = publicationTimes `zip` certificates
+    expectedStatus = determinePoolLifeCycleStatus
+        mFinalRegistration
+        mFinalRetirement
 
-    mFinalRegistration = certificatePublications
-        & reverse
-        & fmap (traverse toRegistrationCertificate)
-        & catMaybes
-        & listToMaybe
+    mFinalRegistration = lookupFinalCertificateMatching $ \case
+        Registration c -> Just c
+        _ -> Nothing
+
+    mFinalRetirement = lookupFinalCertificateMatching $ \case
+        Retirement c -> Just c
+        _ -> Nothing
 
-    mFinalRetirement = certificatePublications
+    lookupFinalCertificateMatching
+        :: (PoolCertificate -> Maybe certificate)
+        -> Maybe (CertificatePublicationTime, certificate)
+    lookupFinalCertificateMatching match = certificatePublications
         & reverse
-        & fmap (traverse toRetirementCertificate)
+        & fmap (traverse match)
         & catMaybes
         & listToMaybe
 
+    certificatePublications :: [(CertificatePublicationTime, PoolCertificate)]
+    certificatePublications = publicationTimes `zip` certificates
+
     publicationTimes =
         [ CertificatePublicationTime (SlotNo sn) ii
         | sn <- [0 .. 3]
         , ii <- [0 .. 3]
         ]
 
-    toRegistrationCertificate = \case
-        Registration cert -> Just cert
-        Retirement _ -> Nothing
-
-    toRetirementCertificate = \case
-        Retirement cert -> Just cert
-        Registration _ -> Nothing
-
     putCertificate cpt = \case
         Registration cert ->
             putPoolRegistration cpt cert