Rename delistPools to putDelistedPools.

This operation completely replaces the set of delisted pools, rather
than augmenting it. Therefore, the name `delistPools` is slightly
misleading, as it gives the impression that the existing set will be
augmented, which is no longer true.

In response to review feedback:

#2277 (comment)

Author: jonathanknowles

lib/core/src/Cardano/Pool/DB.hs

@@ -213,14 +213,15 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
         -> stm ()
         -- ^ Remove all entries of slot ids newer than the argument
 
-    , delistPools
+    , putDelistedPools
         :: [PoolId]
         -> stm ()
-        -- ^ Mark pools as delisted, e.g. due to non-compliance.
-        -- This is stored as an attribute in the pool_registration table.
+        -- ^ Overwrite the set of delisted pools with a completely new set.
+        -- Pools may be delisted for reasons such as non-compliance.
 
     , readDelistedPools
         :: stm [PoolId]
+        -- ^ Fetch the set of delisted pools.
 
     , removePools
         :: [PoolId]

lib/core/src/Cardano/Pool/DB/MVar.hs

@@ -26,11 +26,11 @@ import Cardano.Pool.DB.Model
     , emptyPoolDatabase
     , mCleanDatabase
     , mCleanPoolMetadata
-    , mDelistPools
     , mListHeaders
     , mListPoolLifeCycleData
     , mListRegisteredPools
     , mListRetiredPools
+    , mPutDelistedPools
     , mPutFetchAttempt
     , mPutHeader
     , mPutLastMetadataGC
@@ -150,8 +150,8 @@ newDBLayer timeInterpreter = do
         rollbackTo =
             void . alterPoolDB (const Nothing) db . mRollbackTo timeInterpreter
 
-        delistPools =
-            void . alterPoolDB (const Nothing) db . mDelistPools
+        putDelistedPools =
+            void . alterPoolDB (const Nothing) db . mPutDelistedPools
 
         readDelistedPools =
             readPoolDB db mReadDelistedPools

lib/core/src/Cardano/Pool/DB/Model.hs

@@ -51,6 +51,7 @@ module Cardano.Pool.DB.Model
     , mPutPoolRetirement
     , mReadPoolRetirement
     , mUnfetchedPoolMetadataRefs
+    , mPutDelistedPools
     , mPutFetchAttempt
     , mPutPoolMetadata
     , mListPoolLifeCycleData
@@ -61,7 +62,6 @@ module Cardano.Pool.DB.Model
     , mRollbackTo
     , mReadCursor
     , mRemovePools
-    , mDelistPools
     , mReadDelistedPools
     , mRemoveRetiredPools
     , mReadSettings
@@ -431,8 +431,8 @@ mRollbackTo ti point = do
         | point' <= getPoint point = Just v
         | otherwise = Nothing
 
-mDelistPools :: [PoolId] -> ModelOp ()
-mDelistPools = modify #delisted . const . Set.fromList
+mPutDelistedPools :: [PoolId] -> ModelOp ()
+mPutDelistedPools = modify #delisted . const . Set.fromList
 
 mReadDelistedPools :: ModelOp [PoolId]
 mReadDelistedPools = Set.toList <$> get #delisted

lib/core/src/Cardano/Pool/DB/Sqlite.hs

@@ -491,7 +491,7 @@ newDBLayer trace fp timeInterpreter = do
             deleteWhere [ BlockSlot >. point ]
             -- TODO: remove dangling metadata no longer attached to a pool
 
-        delistPools pools = do
+        putDelistedPools pools = do
             deleteWhere ([] :: [Filter PoolDelistment])
             insertMany_ $ fmap PoolDelistment pools
 

lib/core/test/unit/Cardano/Pool/DB/Properties.hs

@@ -223,10 +223,10 @@ properties = do
             (property . prop_modSettingsReadSettings)
         it "putLastMetadataGC . readLastMetadataGC == id"
             (property . prop_putLastMetadataGCReadLastMetadataGC)
-        it "delistPools >> readDelistedPools shows the pool as delisted"
-            (property . prop_delistPools)
+        it "putDelistedPools >> readDelistedPools shows the pool as delisted"
+            (property . prop_putDelistedPools)
         it "delisting a pools persists even if a new certificate is registered"
-            (property . prop_delistPoolsPersists)
+            (property . prop_putDelistedPoolsPersists)
 
 {-------------------------------------------------------------------------------
                                     Properties
@@ -1459,11 +1459,11 @@ prop_putLastMetadataGCReadLastMetadataGC DBLayer{..} posixTime = do
         assertWith "Setting sync time and reading afterwards works"
             (time == Just posixTime)
 
-prop_delistPools
+prop_putDelistedPools
     :: DBLayer IO
     -> [(CertificatePublicationTime, PoolRegistrationCertificate)]
     -> Property
-prop_delistPools DBLayer {..} entries =
+prop_putDelistedPools DBLayer {..} entries =
     monadicIO (setup >> prop)
   where
     setup = run $ atomically cleanDB
@@ -1486,7 +1486,7 @@ prop_delistPools DBLayer {..} entries =
 
         -- delist pools
         let poolsToDelist = L.sort $ fmap (view #poolId . snd) entriesIn
-        run $ atomically $ delistPools poolsToDelist
+        run $ atomically $ putDelistedPools poolsToDelist
         poolsDelisted <- L.sort <$> run (atomically readDelistedPools)
         monitor $ counterexample $ unlines
             [ "Pools to delist: "
@@ -1497,11 +1497,11 @@ prop_delistPools DBLayer {..} entries =
         assertWith "poolsToDelist == poolsDelisted"
             $ poolsToDelist == poolsDelisted
 
-prop_delistPoolsPersists
+prop_putDelistedPoolsPersists
     :: DBLayer IO
     -> (CertificatePublicationTime, PoolRegistrationCertificate)
     -> Property
-prop_delistPoolsPersists DBLayer {..} cert =
+prop_putDelistedPoolsPersists DBLayer {..} cert =
     monadicIO (setup >> prop)
   where
     setup = run $ atomically cleanDB
@@ -1510,7 +1510,7 @@ prop_delistPoolsPersists DBLayer {..} cert =
 
         let poolid = view #poolId . snd $ cert
         -- delist pool
-        run $ atomically $ delistPools [poolid]
+        run $ atomically $ putDelistedPools [poolid]
         delisted <- run $ atomically readDelistedPools
         let expected = [poolid]
         assertWith "expected == delisted"

lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs

@@ -830,7 +830,7 @@ gcDelistedPools gcStatus tr DBLayer{..} fetchDelisted = forever $ do
         STM.atomically $ writeTVar gcStatus (HasRun currentTime)
         atomically $ do
             putLastMetadataGC currentTime
-            delistPools delistedPools
+            putDelistedPools delistedPools
 
     -- Sleep for 60 seconds. This is useful in case
     -- something else is modifying the last sync time