Provide model implementation of listRetiredPools operation.

cardano-foundation · Aug 13, 2020 · 7910adf · 7910adf
1 parent 9554eba
commit 7910adf
Showing 1 changed file with 41 additions and 1 deletion.
diff --git a/lib/core/src/Cardano/Pool/DB/Model.hs b/lib/core/src/Cardano/Pool/DB/Model.hs
@@ -55,31 +55,39 @@ module Cardano.Pool.DB.Model
 
 import Prelude
 
+import Cardano.Pool.DB
+    ( determinePoolLifeCycleStatus )
 import Cardano.Wallet.Primitive.Slotting
     ( TimeInterpreter, epochOf )
 import Cardano.Wallet.Primitive.Types
     ( BlockHeader (..)
     , CertificatePublicationTime
     , EpochNo (..)
     , PoolId
+    , PoolLifeCycleStatus (..)
     , PoolOwner (..)
     , PoolRegistrationCertificate (..)
     , PoolRetirementCertificate (..)
     , SlotNo (..)
     , StakePoolMetadata
     , StakePoolMetadataHash
     , StakePoolMetadataUrl
+    , getPoolRetirementCertificate
     )
 import Data.Bifunctor
     ( first )
 import Data.Foldable
     ( fold )
+import Data.Function
+    ( (&) )
 import Data.Functor.Identity
     ( Identity (..) )
 import Data.Generics.Internal.VL.Lens
     ( view )
 import Data.Map.Strict
     ( Map )
+import Data.Maybe
+    ( catMaybes )
 import Data.Ord
     ( Down (..) )
 import Data.Quantity
@@ -265,7 +273,39 @@ mListRetiredPools
     :: EpochNo
     -> PoolDatabase
     -> ([PoolRetirementCertificate], PoolDatabase)
-mListRetiredPools _epochNo db = ([], db)
+mListRetiredPools epochNo db = (retiredPools, db)
+  where
+    allKnownPoolIds :: [PoolId]
+    allKnownPoolIds =
+        L.nub $ snd <$> Map.keys registrations
+
+    retiredPools :: [PoolRetirementCertificate]
+    retiredPools = activeRetirementCertificates
+        & filter ((<= epochNo) . view #retiredIn)
+
+    activeRetirementCertificates :: [PoolRetirementCertificate]
+    activeRetirementCertificates =
+        allKnownPoolIds
+        & fmap lookupLifeCycleStatus
+        & fmap getPoolRetirementCertificate
+        & catMaybes
+
+    lookupLifeCycleStatus :: PoolId -> PoolLifeCycleStatus
+    lookupLifeCycleStatus poolId =
+        determinePoolLifeCycleStatus
+            (lookupLatestCertificate poolId registrations)
+            (lookupLatestCertificate poolId retirements)
+
+    lookupLatestCertificate
+        :: PoolId
+        -> Map (publicationTime, PoolId) certificate
+        -> Maybe (publicationTime, certificate)
+    lookupLatestCertificate poolId certMap =
+        fmap (first fst)
+        $ Map.lookupMax
+        $ Map.filterWithKey (\(_, k) _ -> k == poolId) certMap
+
+    PoolDatabase {registrations, retirements} = db
 
 mUnfetchedPoolMetadataRefs
     :: Int