Try #2249:

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -881,24 +881,28 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
                             , name = "Genesis Pool A"
                             , description = Nothing
                             , homepage = "https://iohk.io"
+                            , delisted = False
                             }
                         , StakePoolMetadata
                             { ticker = (StakePoolTicker "GPB")
                             , name = "Genesis Pool B"
                             , description = Nothing
                             , homepage = "https://iohk.io"
+                            , delisted = False
                             }
                         , StakePoolMetadata
                             { ticker = (StakePoolTicker "GPC")
                             , name = "Genesis Pool C"
                             , description = Just "Lorem Ipsum Dolor Sit Amet."
                             , homepage = "https://iohk.io"
+                            , delisted = False
                             }
                         , StakePoolMetadata
                             { ticker = (StakePoolTicker "GPD")
                             , name = "Genesis Pool D"
                             , description = Just "Lorem Ipsum Dolor Sit Amet."
                             , homepage = "https://iohk.io"
+                            , delisted = False
                             }
                         ]
 

lib/core/cardano-wallet-core.cabal

@@ -90,6 +90,7 @@ library
     , statistics
     , stm
     , streaming-commons
+    , string-interpolate
     , string-qq
     , template-haskell
     , text

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

@@ -49,6 +49,8 @@ import Data.Map.Strict
     ( Map )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Time.Clock.POSIX
+    ( POSIXTime )
 import Data.Word
     ( Word64 )
 import System.Random
@@ -211,6 +213,11 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
         -> stm ()
         -- ^ Remove all entries of slot ids newer than the argument
 
+    , delistPools
+        :: [PoolId]
+        -> stm ()
+        -- ^ Mark pools as delisted
+        --
     , removePools
         :: [PoolId]
         -> stm ()
@@ -249,6 +256,15 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
         -> stm ()
         -- ^ Modify the settings.
 
+    , readLastMetadataGC
+        :: stm POSIXTime
+        -- ^ Get the last metadata GC time.
+
+    , putLastMetadataGC
+        :: POSIXTime
+        -> stm ()
+        -- ^ Set the last metadata GC time.
+        --
     , cleanDB
         :: stm ()
         -- ^ Clean a database

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

@@ -26,19 +26,22 @@ import Cardano.Pool.DB.Model
     , emptyPoolDatabase
     , mCleanDatabase
     , mCleanPoolMetadata
+    , mDelistPools
     , mListHeaders
     , mListPoolLifeCycleData
     , mListRegisteredPools
     , mListRetiredPools
     , mPutFetchAttempt
     , mPutHeader
+    , mPutLastMetadataGC
     , mPutPoolMetadata
     , mPutPoolProduction
     , mPutPoolRegistration
     , mPutPoolRetirement
     , mPutSettings
     , mPutStakeDistribution
     , mReadCursor
+    , mReadLastMetadataGC
     , mReadPoolLifeCycleStatus
     , mReadPoolMetadata
     , mReadPoolProduction
@@ -146,6 +149,9 @@ newDBLayer timeInterpreter = do
         rollbackTo =
             void . alterPoolDB (const Nothing) db . mRollbackTo timeInterpreter
 
+        delistPools =
+            void . alterPoolDB (const Nothing) db . mDelistPools
+
         removePools =
             void . alterPoolDB (const Nothing) db . mRemovePools
 
@@ -165,6 +171,11 @@ newDBLayer timeInterpreter = do
         putSettings =
             void . alterPoolDB (const Nothing) db . mPutSettings
 
+        readLastMetadataGC = readPoolDB db mReadLastMetadataGC
+
+        putLastMetadataGC =
+            void . alterPoolDB (const Nothing) db . mPutLastMetadataGC
+
         cleanDB =
             void $ alterPoolDB (const Nothing) db mCleanDatabase
 

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

@@ -16,6 +16,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE UndecidableInstances #-}
 
+-- `const` isn't more readable than lambdas. Our language is based on
+-- lambda calculus and we shouldn't feel ashamed to use them. They also
+-- have different strictness properties.
+{-# HLINT ignore "Use const" #-}
+
 -- |
 -- Copyright: © 2018-2020 IOHK
 -- License: Apache-2.0
@@ -60,9 +65,12 @@ module Cardano.Pool.DB.Model
     , mRollbackTo
     , mReadCursor
     , mRemovePools
+    , mDelistPools
     , mRemoveRetiredPools
     , mReadSettings
     , mPutSettings
+    , mPutLastMetadataGC
+    , mReadLastMetadataGC
     ) where
 
 import Prelude
@@ -75,18 +83,22 @@ import Cardano.Wallet.Primitive.Types
     ( BlockHeader (..)
     , CertificatePublicationTime
     , EpochNo (..)
+    , InternalState (..)
     , PoolId
     , PoolLifeCycleStatus (..)
     , PoolOwner (..)
     , PoolRegistrationCertificate (..)
     , PoolRetirementCertificate (..)
     , Settings
     , SlotNo (..)
-    , StakePoolMetadata
+    , StakePoolMetadata (..)
     , StakePoolMetadataHash
     , StakePoolMetadataUrl
+    , defaultInternalState
     , defaultSettings
     )
+import Control.Monad
+    ( forM_ )
 import Control.Monad.Trans.Class
     ( lift )
 import Control.Monad.Trans.State.Strict
@@ -109,6 +121,8 @@ import Data.Ord
     ( Down (..) )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Time.Clock.POSIX
+    ( POSIXTime )
 import Data.Word
     ( Word64 )
 import GHC.Generics
@@ -156,6 +170,10 @@ data PoolDatabase = PoolDatabase
     -- ^ Store headers during syncing
 
     , settings :: Settings
+
+    , internalState :: InternalState
+    -- ^ Various internal states that need to persist across
+    -- wallet restarts.
     } deriving (Generic, Show, Eq)
 
 data SystemSeed
@@ -173,7 +191,7 @@ instance Eq SystemSeed where
 emptyPoolDatabase :: PoolDatabase
 emptyPoolDatabase =
     PoolDatabase mempty mempty mempty mempty mempty mempty mempty NotSeededYet
-        mempty defaultSettings
+        mempty defaultSettings defaultInternalState
 
 {-------------------------------------------------------------------------------
                                   Model Operation Types
@@ -414,6 +432,13 @@ mRollbackTo ti point = do
         | point' <= getPoint point = Just v
         | otherwise = Nothing
 
+mDelistPools :: [PoolId] -> ModelOp ()
+mDelistPools poolsToDelist =
+    forM_ poolsToDelist $ \pool -> do
+        mhash <- (>>= (fmap snd . poolMetadata . snd)) <$> mReadPoolRegistration pool
+        forM_ mhash $ \hash -> modify #metadata
+            $ Map.adjust (\m -> m { delisted = True }) hash
+
 mRemovePools :: [PoolId] -> ModelOp ()
 mRemovePools poolsToRemove = do
     modify #distributions
@@ -448,15 +473,20 @@ mReadSettings
     :: ModelOp Settings
 mReadSettings = get #settings
 
--- `const` isn't more readable than lambdas. Our language is based on
--- lambda calculus and we shouldn't feel ashamed to use them. They also
--- have different strictness properties.
-{- HLINT ignore mPutSettings "Use const" -}
 mPutSettings
     :: Settings
     -> ModelOp ()
 mPutSettings s = modify #settings (\_ -> s)
 
+mReadLastMetadataGC
+    :: ModelOp POSIXTime
+mReadLastMetadataGC = get (#internalState . #lastMetadataGC)
+
+mPutLastMetadataGC
+    :: POSIXTime
+    -> ModelOp ()
+mPutLastMetadataGC t = modify (#internalState . #lastMetadataGC) (\_ -> t)
+
 --------------------------------------------------------------------------------
 -- Utilities
 --------------------------------------------------------------------------------