Introduce CertificatePublicationTime type.

The `CertificatePublicationTime` type represents an abstract notion of a
certificate publication time.

Certificates published at later times take precedence over certificates
published at earlier times.

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

@@ -14,6 +14,7 @@ module Cardano.Pool.DB
     ( -- * Interface
       DBLayer (..)
 
+    , CertificatePublicationTime
     , PoolRegistrationStatus (..)
     , determinePoolRegistrationStatus
     , readPoolRegistrationStatus
@@ -107,7 +108,7 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
         -- This is useful for the @NetworkLayer@ to know how far we have synced.
 
     , putPoolRegistration
-        :: SlotIndex
+        :: CertificatePublicationTime
         -> PoolRegistrationCertificate
         -> stm ()
         -- ^ Add a mapping between stake pools and their corresponding
@@ -116,19 +117,21 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
 
     , readPoolRegistration
         :: PoolId
-        -> stm (Maybe (SlotIndex, PoolRegistrationCertificate))
-        -- ^ Find a registration certificate associated to a given pool
+        -> stm (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
+        -- ^ Find the /latest/ registration certificate for the given pool,
+        -- along with the point in time that the certificate was added.
 
     , putPoolRetirement
-        :: SlotIndex
+        :: CertificatePublicationTime
         -> PoolRetirementCertificate
         -> stm ()
         -- ^ Add a retirement certificate for a particular pool.
 
     , readPoolRetirement
         :: PoolId
-        -> stm (Maybe (SlotIndex, PoolRetirementCertificate))
-        -- ^ Find a retirement certificate for a particular pool.
+        -> stm (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
+        -- ^ Find the /latest/ retirement certificate for the given pool,
+        -- along with the point in time that the certificate was added.
 
     , unfetchedPoolMetadataRefs
         :: Int
@@ -184,8 +187,18 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
         -- For a Sqlite DB, this would be "run a query inside a transaction".
     }
 
-type SlotIndex = (SlotId, SlotInternalIndex)
+-- | Represents an abstract notion of a certificate publication time.
+--
+-- Certificates published at later times take precedence over certificates
+-- published at earlier times.
+--
+type CertificatePublicationTime = (SlotId, SlotInternalIndex)
 
+-- | Indicates the current registration status of a pool.
+--
+-- Use the 'readPoolRegistrationStatus' function to query the registration
+-- status for a particular pool and database backend.
+--
 data PoolRegistrationStatus
     = PoolNotRegistered
         -- ^ Indicates that a pool is not registered.
@@ -199,9 +212,12 @@ data PoolRegistrationStatus
         -- ^ Indicates that a pool is registered AND ALSO marked for retirement.
         -- Records the latest registration and retirement certificates.
 
+-- | Given the latest registration and retirement certificates for a pool,
+-- determine the pool's current registration status based on the relative
+-- order in which the certificates were published.
 determinePoolRegistrationStatus
-    :: Maybe (SlotIndex, PoolRegistrationCertificate)
-    -> Maybe (SlotIndex, PoolRetirementCertificate)
+    :: Maybe (CertificatePublicationTime, PoolRegistrationCertificate)
+    -> Maybe (CertificatePublicationTime, PoolRetirementCertificate)
     -> PoolRegistrationStatus
 determinePoolRegistrationStatus = f
   where
@@ -215,6 +231,10 @@ determinePoolRegistrationStatus = f
         | otherwise =
             PoolRegisteredAndRetired regCert retCert
 
+-- | Reads the current registration status of a pool.
+--
+-- See 'PoolRegistrationStatus' for more details.
+--
 readPoolRegistrationStatus
     :: DBLayer m
     -> PoolId

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

@@ -53,6 +53,8 @@ module Cardano.Pool.DB.Model
 
 import Prelude
 
+import Cardano.Pool.DB
+    ( CertificatePublicationTime )
 import Cardano.Wallet.Primitive.Types
     ( BlockHeader (..)
     , EpochNo (..)
@@ -61,7 +63,6 @@ import Cardano.Wallet.Primitive.Types
     , PoolRegistrationCertificate (..)
     , PoolRetirementCertificate (..)
     , SlotId (..)
-    , SlotInternalIndex (..)
     , StakePoolMetadata
     , StakePoolMetadataHash
     , StakePoolMetadataUrl
@@ -91,8 +92,6 @@ import qualified Data.Set as Set
                             Model Database Types
 -------------------------------------------------------------------------------}
 
-type SlotIndex = (SlotId, SlotInternalIndex)
-
 data PoolDatabase = PoolDatabase
     { pools :: !(Map PoolId [BlockHeader])
     -- ^ Information of what blocks were produced by which stake pools
@@ -104,11 +103,11 @@ data PoolDatabase = PoolDatabase
     -- ^ Mapping between pool ids and owners
 
     , registrations
-        :: !(Map (SlotIndex, PoolId) PoolRegistrationCertificate)
+        :: !(Map (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
     -- ^ On-chain registrations associated with pools
 
     , retirements
-        :: !(Map (SlotIndex, PoolId) PoolRetirementCertificate)
+        :: !(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
     -- ^ On-chain retirements associated with pools
 
     , metadata :: !(Map StakePoolMetadataHash StakePoolMetadata)
@@ -194,7 +193,7 @@ mReadStakeDistribution epoch db@PoolDatabase{distributions} =
     )
 
 mPutPoolRegistration
-    :: SlotIndex
+    :: CertificatePublicationTime
     -> PoolRegistrationCertificate
     -> ModelPoolOp ()
 mPutPoolRegistration sp registration db =
@@ -209,7 +208,8 @@ mPutPoolRegistration sp registration db =
 
 mReadPoolRegistration
     :: PoolId
-    -> ModelPoolOp (Maybe (SlotIndex, PoolRegistrationCertificate))
+    -> ModelPoolOp
+        (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
 mReadPoolRegistration poolId db =
     ( Right
         $ fmap (first fst)
@@ -222,7 +222,7 @@ mReadPoolRegistration poolId db =
     only k (_, k') _ = k == k'
 
 mPutPoolRetirement
-    :: SlotIndex
+    :: CertificatePublicationTime
     -> PoolRetirementCertificate
     -> ModelPoolOp ()
 mPutPoolRetirement sp retirement db =
@@ -235,7 +235,8 @@ mPutPoolRetirement sp retirement db =
 
 mReadPoolRetirement
     :: PoolId
-    -> ModelPoolOp (Maybe (SlotIndex, PoolRetirementCertificate))
+    -> ModelPoolOp
+        (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
 mReadPoolRetirement poolId db =
     ( Right
         $ fmap (first fst)
@@ -259,7 +260,8 @@ mUnfetchedPoolMetadataRefs n db@PoolDatabase{registrations,metadata} =
     , db
     )
   where
-    unfetched :: Map (SlotIndex, PoolId) PoolRegistrationCertificate
+    unfetched
+        :: Map (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
     unfetched = flip Map.filter registrations $ \r ->
         case poolMetadata r of
             Nothing -> False

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

@@ -16,7 +16,7 @@ import Cardano.BM.Trace
 import Cardano.DB.Sqlite
     ( DBLog (..), SqliteContext )
 import Cardano.Pool.DB
-    ( DBLayer (..), ErrPointAlreadyExists (..) )
+    ( CertificatePublicationTime, DBLayer (..), ErrPointAlreadyExists (..) )
 import Cardano.Pool.DB.Arbitrary
     ( StakePoolsFixture (..), genStakePoolMetadata )
 import Cardano.Pool.DB.Sqlite
@@ -27,7 +27,6 @@ import Cardano.Wallet.Primitive.Types
     , PoolId
     , PoolRegistrationCertificate (..)
     , SlotId (..)
-    , SlotInternalIndex (..)
     )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
@@ -409,12 +408,10 @@ prop_poolRegistration DBLayer {..} entries =
             ]
         assert (pools == expected)
 
-type SlotIndex = (SlotId, SlotInternalIndex)
-
 prop_rollbackRegistration
     :: DBLayer IO
     -> SlotId
-    -> [(SlotIndex, PoolRegistrationCertificate)]
+    -> [(CertificatePublicationTime, PoolRegistrationCertificate)]
     -> Property
 prop_rollbackRegistration DBLayer{..} rollbackPoint entries =
     monadicIO (setup >> prop)