Fix active_epoch_no of PoolUpdate

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs

@@ -57,6 +57,7 @@ import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import           Data.Group (invert)
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Encoding.Error as Text
@@ -103,7 +104,7 @@ insertShelleyBlock tracer lenv blk lStateSnap details = do
                     , DB.blockOpCert = Just $ Generic.blkOpCert blk
                     }
 
-    zipWithM_ (insertTx tracer (leNetwork lenv) blkId (sdEpochNo details) (Generic.blkSlotNo blk)) [0 .. ] (Generic.blkTxs blk)
+    zipWithM_ (insertTx tracer (leNetwork lenv) lStateSnap blkId (sdEpochNo details) (Generic.blkSlotNo blk)) [0 .. ] (Generic.blkTxs blk)
 
     liftIO $ do
       let epoch = unEpochNo (sdEpochNo details)
@@ -168,9 +169,9 @@ insertOnNewEpoch tracer blkId slotNo epochNo newEpoch = do
 
 insertTx
     :: (MonadBaseControl IO m, MonadIO m)
-    => Trace IO Text -> Shelley.Network -> DB.BlockId -> EpochNo -> SlotNo -> Word64 -> Generic.Tx
+    => Trace IO Text -> Shelley.Network -> LedgerStateSnapshot -> DB.BlockId -> EpochNo -> SlotNo -> Word64 -> Generic.Tx
     -> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertTx tracer network blkId epochNo slotNo blockIndex tx = do
+insertTx tracer network lStateSnap blkId epochNo slotNo blockIndex tx = do
     let fees = unCoin $ Generic.txFees tx
         outSum = unCoin $ Generic.txOutSum tx
         withdrawalSum = unCoin $ Generic.txWithdrawalSum tx
@@ -200,7 +201,7 @@ insertTx tracer network blkId epochNo slotNo blockIndex tx = do
       Nothing -> pure ()
       Just md -> insertTxMetadata tracer txId md
 
-    mapM_ (insertCertificate tracer network txId epochNo slotNo) $ Generic.txCertificates tx
+    mapM_ (insertCertificate tracer lStateSnap network blkId txId epochNo slotNo) $ Generic.txCertificates tx
     mapM_ (insertWithdrawals tracer txId) $ Generic.txWithdrawals tx
 
     mapM_ (insertParamProposal tracer txId) $ Generic.txParamProposal tx
@@ -240,12 +241,12 @@ insertTxIn _tracer txInId (Generic.TxIn txId index) = do
 
 insertCertificate
     :: (MonadBaseControl IO m, MonadIO m)
-    => Trace IO Text -> Shelley.Network -> DB.TxId -> EpochNo -> SlotNo -> Generic.TxCertificate
+    => Trace IO Text -> LedgerStateSnapshot -> Shelley.Network -> DB.BlockId -> DB.TxId -> EpochNo -> SlotNo -> Generic.TxCertificate
     -> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertCertificate tracer network txId epochNo slotNo (Generic.TxCertificate idx cert) =
+insertCertificate tracer lStateSnap network blkId txId epochNo slotNo (Generic.TxCertificate idx cert) =
   case cert of
     Shelley.DCertDeleg deleg -> insertDelegCert tracer network txId idx epochNo slotNo deleg
-    Shelley.DCertPool pool -> insertPoolCert tracer network epochNo txId idx pool
+    Shelley.DCertPool pool -> insertPoolCert tracer lStateSnap network epochNo blkId txId idx pool
     Shelley.DCertMir mir -> insertMirCert tracer network txId idx mir
     Shelley.DCertGenesis _gen -> do
         -- TODO : Low priority
@@ -255,11 +256,11 @@ insertCertificate tracer network txId epochNo slotNo (Generic.TxCertificate idx
 
 insertPoolCert
     :: (MonadBaseControl IO m, MonadIO m)
-    => Trace IO Text -> Shelley.Network -> EpochNo -> DB.TxId -> Word16 -> Shelley.PoolCert StandardCrypto
+    => Trace IO Text -> LedgerStateSnapshot -> Shelley.Network -> EpochNo -> DB.BlockId -> DB.TxId -> Word16 -> Shelley.PoolCert StandardCrypto
     -> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertPoolCert tracer network epoch txId idx pCert =
+insertPoolCert tracer lStateSnap network epoch blkId txId idx pCert =
   case pCert of
-    Shelley.RegPool pParams -> insertPoolRegister tracer network epoch txId idx pParams
+    Shelley.RegPool pParams -> insertPoolRegister tracer lStateSnap network epoch blkId txId idx pParams
     Shelley.RetirePool keyHash epochNum -> insertPoolRetire txId epochNum idx keyHash
 
 insertDelegCert
@@ -274,44 +275,57 @@ insertDelegCert tracer network txId idx epochNo slotNo dCert =
 
 insertPoolRegister
     :: (MonadBaseControl IO m, MonadIO m)
-    => Trace IO Text -> Shelley.Network -> EpochNo -> DB.TxId -> Word16 -> Shelley.PoolParams StandardCrypto
+    => Trace IO Text -> LedgerStateSnapshot -> Shelley.Network -> EpochNo -> DB.BlockId -> DB.TxId -> Word16 -> Shelley.PoolParams StandardCrypto
     -> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertPoolRegister tracer network (EpochNo epoch) txId idx params = do
-  mdId <- case strictMaybeToMaybe $ Shelley._poolMD params of
-            Just md -> Just <$> insertMetaData txId md
-            Nothing -> pure Nothing
-
-  when (fromIntegral (Shelley.unCoin $ Shelley._poolPledge params) > maxLovelace) $
-    liftIO . logWarning tracer $
-      mconcat
-        [ "Bad pledge amount: ", textShow (Shelley.unCoin $ Shelley._poolPledge params)
-        , " > maxLovelace."
-        ]
-
-  when (fromIntegral (Shelley.unCoin $ Shelley._poolCost params) > maxLovelace) $
-    liftIO . logWarning tracer $
-      mconcat
-        [ "Bad fixed cost amount: ", textShow (Shelley.unCoin $ Shelley._poolCost params)
-        , " > maxLovelace."
-        ]
+insertPoolRegister tracer lStateSnap network (EpochNo epoch) blkId txId idx params = do
+    mdId <- case strictMaybeToMaybe $ Shelley._poolMD params of
+              Just md -> Just <$> insertMetaData txId md
+              Nothing -> pure Nothing
+
+    when (fromIntegral (Shelley.unCoin $ Shelley._poolPledge params) > maxLovelace) $
+      liftIO . logWarning tracer $
+        mconcat
+          [ "Bad pledge amount: ", textShow (Shelley.unCoin $ Shelley._poolPledge params)
+          , " > maxLovelace."
+          ]
+
+    when (fromIntegral (Shelley.unCoin $ Shelley._poolCost params) > maxLovelace) $
+      liftIO . logWarning tracer $
+        mconcat
+          [ "Bad fixed cost amount: ", textShow (Shelley.unCoin $ Shelley._poolCost params)
+          , " > maxLovelace."
+          ]
+
+    poolHashId <- insertPoolHash (Shelley._poolId params)
+
+    epochActivationDelay <- mkEpochActivationDelay poolHashId
+
+    poolUpdateId <- lift . DB.insertPoolUpdate $
+                      DB.PoolUpdate
+                        { DB.poolUpdateHashId = poolHashId
+                        , DB.poolUpdateCertIndex = idx
+                        , DB.poolUpdateVrfKeyHash = Crypto.hashToBytes (Shelley._poolVrf params)
+                        , DB.poolUpdatePledge = Generic.coinToDbLovelace (Shelley._poolPledge params)
+                        , DB.poolUpdateRewardAddr = Generic.serialiseRewardAcntWithNetwork network (Shelley._poolRAcnt params)
+                        , DB.poolUpdateActiveEpochNo = epoch + epochActivationDelay
+                        , DB.poolUpdateMetaId = mdId
+                        , DB.poolUpdateMargin = realToFrac $ Shelley.intervalValue (Shelley._poolMargin params)
+                        , DB.poolUpdateFixedCost = Generic.coinToDbLovelace (Shelley._poolCost params)
+                        , DB.poolUpdateRegisteredTxId = txId
+                        }
+
+    mapM_ (insertPoolOwner network poolHashId txId) $ toList (Shelley._poolOwners params)
+    mapM_ (insertPoolRelay poolUpdateId) $ toList (Shelley._poolRelays params)
 
-  poolHashId <- insertPoolHash (Shelley._poolId params)
-  poolUpdateId <- lift . DB.insertPoolUpdate $
-                    DB.PoolUpdate
-                      { DB.poolUpdateHashId = poolHashId
-                      , DB.poolUpdateCertIndex = idx
-                      , DB.poolUpdateVrfKeyHash = Crypto.hashToBytes (Shelley._poolVrf params)
-                      , DB.poolUpdatePledge = Generic.coinToDbLovelace (Shelley._poolPledge params)
-                      , DB.poolUpdateRewardAddr = Generic.serialiseRewardAcntWithNetwork network (Shelley._poolRAcnt params)
-                      , DB.poolUpdateActiveEpochNo = epoch + 2
-                      , DB.poolUpdateMetaId = mdId
-                      , DB.poolUpdateMargin = realToFrac $ Shelley.intervalValue (Shelley._poolMargin params)
-                      , DB.poolUpdateFixedCost = Generic.coinToDbLovelace (Shelley._poolCost params)
-                      , DB.poolUpdateRegisteredTxId = txId
-                      }
-
-  mapM_ (insertPoolOwner network poolHashId txId) $ toList (Shelley._poolOwners params)
-  mapM_ (insertPoolRelay poolUpdateId) $ toList (Shelley._poolRelays params)
+  where
+    mkEpochActivationDelay poolHashId = do
+      let wasPoolRegistered = Set.member (Shelley._poolId params) $ getPoolParams $ lssOldState lStateSnap
+      if wasPoolRegistered then return 3 else do
+        -- if the pool is not registered at the end of the previous block, check for
+        -- other registrations at the current block. If this is the first registration
+        -- then it's +2, else it's +3.
+        otherUpdates <- lift $ queryPoolUpdateByBlock blkId poolHashId
+        if otherUpdates then return 3 else return 2
 
 maxLovelace :: Word64
 maxLovelace = 45000000000000000

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs

@@ -14,6 +14,7 @@ module Cardano.DbSync.Era.Shelley.Query
 
   , queryStakeAddressIdPair
   , queryPoolHashIdPair
+  , queryPoolUpdateByBlock
   ) where
 
 import           Cardano.Prelude hiding (from, maybeToEither, on)
@@ -165,3 +166,13 @@ queryPoolHashIdPair pkh = do
     convert :: Value PoolHashId -> (Shelley.KeyHash 'Shelley.StakePool StandardCrypto, PoolHashId)
     convert (Value phid) = (pkh, phid)
 
+-- Check if there are other PoolUpdates in the same blocks for the same pool
+queryPoolUpdateByBlock :: MonadIO m => BlockId -> PoolHashId -> ReaderT SqlBackend m Bool
+queryPoolUpdateByBlock blkId poolHashId = do
+    res <- select . from $ \ (poolUpdate `InnerJoin` tx `InnerJoin` blk) -> do
+      on (blk ^. BlockId ==. tx ^. TxBlockId)
+      on (tx ^. TxId ==. poolUpdate ^. PoolUpdateRegisteredTxId)
+      where_ (poolUpdate ^. PoolUpdateHashId ==. val poolHashId)
+      where_ (blk ^. BlockId ==. val blkId)
+      pure $ blk ^. BlockEpochNo
+    pure $ not $ null res

cardano-sync/src/Cardano/Sync/LedgerState.hs

@@ -24,6 +24,7 @@ module Cardano.Sync.LedgerState
   , findStateFromPoint
   , loadLedgerAtPoint
   , getHeaderHash
+  , getPoolParams
   ) where
 
 import           Cardano.Binary (DecoderError)
@@ -32,6 +33,7 @@ import qualified Cardano.Binary as Serialize
 import qualified Cardano.Db as DB
 
 import           Cardano.Ledger.Coin (Coin)
+import           Cardano.Ledger.Era
 import           Cardano.Ledger.Shelley.Constraints (UsesValue)
 import qualified Cardano.Ledger.Val as Val
 
@@ -59,14 +61,14 @@ import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.ByteString.Short as BSS
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Strict.Maybe as Strict
 import qualified Data.Text as Text
 
 import           Ouroboros.Consensus.Block (CodecConfig, WithOrigin (..), blockHash, blockIsEBB,
                    blockPrevHash, withOrigin)
 import           Ouroboros.Consensus.Block.Abstract (ConvertRawHash (..))
 import           Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardCrypto)
-
 import           Ouroboros.Consensus.Cardano.CanHardFork ()
 import           Ouroboros.Consensus.Config (TopLevelConfig (..), configCodec, configLedger)
 import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
@@ -86,6 +88,7 @@ import           Ouroboros.Network.Block (HeaderHash, Point (..))
 import qualified Ouroboros.Network.Point as Point
 
 import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
+import           Shelley.Spec.Ledger.Keys (KeyHash (..), KeyRole(..))
 import           Shelley.Spec.Ledger.LedgerState (AccountState, EpochState, UTxOState)
 import qualified Shelley.Spec.Ledger.LedgerState as Shelley
 import qualified Shelley.Spec.Ledger.Rewards as Shelley
@@ -158,6 +161,7 @@ data LedgerStateFile = LedgerStateFile
 
 data LedgerStateSnapshot = LedgerStateSnapshot
   { lssState :: !CardanoLedgerState
+  , lssOldState :: !CardanoLedgerState
   , lssNewEpoch :: !(Strict.Maybe Generic.NewEpoch) -- Only Just for a single block at the epoch boundary
   , lssSlotDetails :: !SlotDetails
   , lssEvents :: ![LedgerEvent]
@@ -219,6 +223,7 @@ applyBlock env blk details =
       events <- generateEvents env oldEventState  details newState
       pure $ LedgerStateSnapshot
                 { lssState = newState
+                , lssOldState = oldState
                 , lssNewEpoch = maybeToStrict $ mkNewEpoch oldState newState
                 , lssSlotDetails = details
                 , lssEvents = events
@@ -573,6 +578,22 @@ writeLedgerState env st = atomically $ writeTVar (leStateVar env) (CardanoLedger
 safeRemoveFile :: FilePath -> IO ()
 safeRemoveFile fp = handle (\(_ :: IOException) -> pure ()) $ removeFile fp
 
+getPoolParams :: CardanoLedgerState -> Set.Set (KeyHash 'StakePool StandardCrypto)
+getPoolParams st =
+    case ledgerState $ clsState st of
+      LedgerStateByron _ -> Set.empty
+      LedgerStateShelley sts -> getPoolParamsShelley sts
+      LedgerStateAllegra sts -> getPoolParamsShelley sts
+      LedgerStateMary sts -> getPoolParamsShelley sts
+
+getPoolParamsShelley
+    :: forall era. (Crypto era ~ StandardCrypto)
+    => LedgerState (ShelleyBlock era)
+    -> Set.Set (KeyHash 'StakePool StandardCrypto)
+getPoolParamsShelley lState =
+  Map.keysSet $ Shelley._pParams $ Shelley._pstate $ Shelley._delegationState
+              $ Shelley.esLState $ Shelley.nesEs $ Consensus.shelleyLedgerState lState
+
 -- We only compute 'AdaPots' for later eras. This is a time consuming
 -- function and we only want to run it on epoch boundaries.
 getAdaPots :: CardanoLedgerState -> Maybe Generic.AdaPots