Fix handling of proposal states

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

@@ -9,6 +9,7 @@ module Cardano.DbSync.Era.Shelley.Generic.EpochUpdate (
 import Cardano.DbSync.Era.Shelley.Generic.ProtoParams
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util
+import Cardano.Ledger.BaseTypes (StrictMaybe)
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import Cardano.Ledger.Conway.Governance
 import qualified Cardano.Ledger.Shelley.API.Wallet as Shelley
@@ -28,9 +29,9 @@ data NewEpoch = NewEpoch
   { neEpoch :: !EpochNo
   , neIsEBB :: !Bool
   , neAdaPots :: !(Maybe Shelley.AdaPots)
-  , neDRepState :: !(Maybe (DRepPulsingState StandardConway))
-  , neEnacted :: !(Maybe (EnactState StandardConway))
   , neEpochUpdate :: !EpochUpdate
+  , neDRepState :: !(Maybe (DRepPulsingState StandardConway))
+  , neEnacted :: !(Maybe (GovRelation StrictMaybe StandardConway))
   }
 
 data EpochUpdate = EpochUpdate

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -Wall -fno-warn-deprecations #-}
 
 module Cardano.DbSync.Era.Shelley.Generic.Tx.Types (
   Tx (..),
@@ -177,7 +176,7 @@ instance DBScriptPurpose StandardAlonzo where
     AlonzoSpending a -> Just $ Left (AlonzoSpending a, Nothing)
     AlonzoMinting a -> Just $ Left (AlonzoMinting a, Nothing)
     AlonzoRewarding a -> Just $ Left (AlonzoRewarding a, Nothing)
-    AlonzoCertifying a -> Just $ Left (AlonzoCertifying a, strictMaybeToMaybe (redeemerPointer txBody pp))
+    AlonzoCertifying a -> Just $ Left (AlonzoCertifying a, strictMaybeToMaybe (alonzoRedeemerPointer txBody pp))
 
 instance DBScriptPurpose StandardBabbage where
   getPurpose = \case
@@ -190,7 +189,7 @@ instance DBScriptPurpose StandardBabbage where
     AlonzoSpending a -> Just $ Left (AlonzoSpending a, Nothing)
     AlonzoMinting a -> Just $ Left (AlonzoMinting a, Nothing)
     AlonzoRewarding a -> Just $ Left (AlonzoRewarding a, Nothing)
-    AlonzoCertifying a -> Just $ Left (AlonzoCertifying a, strictMaybeToMaybe (redeemerPointer txBody pp))
+    AlonzoCertifying a -> Just $ Left (AlonzoCertifying a, strictMaybeToMaybe (alonzoRedeemerPointer txBody pp))
 
 instance DBScriptPurpose StandardConway where
   getPurpose = \case

cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs

@@ -28,7 +28,7 @@ import Cardano.DbSync.Cache (queryOrInsertStakeAddress, queryPoolKeyOrInsert)
 import Cardano.DbSync.Cache.Types (Cache, CacheNew (..))
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Universal.Insert.Certificate (insertPots)
-import Cardano.DbSync.Era.Universal.Insert.GovAction (insertCostModel, insertDrepDistr, updateEnacted)
+import Cardano.DbSync.Era.Universal.Insert.GovAction (insertCostModel, insertDrepDistr, updateEnacted, updateExpired, updateRatified)
 import Cardano.DbSync.Era.Universal.Insert.Other (toDouble)
 import Cardano.DbSync.Error
 import Cardano.DbSync.Ledger.Event (LedgerEvent (..))
@@ -73,10 +73,11 @@ insertOnNewEpoch tracer iopts blkId slotNo epochNo newEpoch = do
   whenStrictJust (Generic.neDRepState newEpoch) $ \dreps -> when (ioGov iopts) $ do
     let (drepSnapshot, ratifyState) = finishDRepPulser dreps
     lift $ insertDrepDistr epochNo drepSnapshot
-    updateEnacted False epochNo (rsEnactState ratifyState)
+    updateRatified epochNo (toList $ rsEnacted ratifyState)
+    updateExpired epochNo (toList $ rsExpired ratifyState)
   whenStrictJust (Generic.neEnacted newEpoch) $ \enactedSt ->
     when (ioGov iopts) $
-      updateEnacted True epochNo enactedSt
+      updateEnacted epochNo enactedSt
   where
     epochUpdate :: Generic.EpochUpdate
     epochUpdate = Generic.neEpochUpdate newEpoch

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

@@ -20,6 +20,8 @@ module Cardano.DbSync.Era.Universal.Insert.GovAction (
   insertCommitteeHash,
   insertVotingAnchor,
   resolveGovActionProposal,
+  updateRatified,
+  updateExpired,
   updateEnacted,
 )
 where
@@ -60,7 +62,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.Map.Strict as Map
 import qualified Data.Text.Encoding as Text
 import Database.Persist.Sql (SqlBackend)
-import Lens.Micro ((^.))
 import Ouroboros.Consensus.Cardano.Block (StandardConway, StandardCrypto)
 
 insertGovActionProposal ::
@@ -377,12 +378,49 @@ insertCostModel _blkId cms =
       , DB.costModelCosts = Text.decodeUtf8 $ LBS.toStrict $ Aeson.encode cms
       }
 
-updateEnacted :: forall m. (MonadBaseControl IO m, MonadIO m) => Bool -> EpochNo -> EnactState StandardConway -> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-updateEnacted isEnacted epochNo enactedState = do
-  whenJust (strictMaybeToMaybe (enactedState ^. ensPrevPParamUpdateL)) $ \prevId -> do
+updateRatified ::
+  forall m.
+  (MonadBaseControl IO m, MonadIO m) =>
+  EpochNo ->
+  [GovActionState StandardConway] ->
+  ExceptT SyncNodeError (ReaderT SqlBackend m) ()
+updateRatified epochNo ratifiedActions = do
+  forM_ ratifiedActions $ \action -> do
+    gaId <- resolveGovActionProposal $ gasId action
+    lift $ DB.updateGovActionRatified gaId (unEpochNo epochNo)
+
+updateExpired ::
+  forall m.
+  (MonadBaseControl IO m, MonadIO m) =>
+  EpochNo ->
+  [GovActionId StandardCrypto] ->
+  ExceptT SyncNodeError (ReaderT SqlBackend m) ()
+updateExpired epochNo ratifiedActions = do
+  forM_ ratifiedActions $ \action -> do
+    gaId <- resolveGovActionProposal action
+    lift $ DB.updateGovActionRatified gaId (unEpochNo epochNo)
+
+updateEnacted ::
+  forall m.
+  (MonadBaseControl IO m, MonadIO m) =>
+  EpochNo ->
+  GovRelation StrictMaybe StandardConway ->
+  ExceptT SyncNodeError (ReaderT SqlBackend m) ()
+updateEnacted epochNo enactedState = do
+  whenJust (strictMaybeToMaybe (grPParamUpdate enactedState)) $ \prevId -> do
+    gaId <- resolveGovActionProposal $ getPrevId prevId
+    lift $ DB.updateGovActionEnacted gaId (unEpochNo epochNo)
+
+  whenJust (strictMaybeToMaybe (grHardFork enactedState)) $ \prevId -> do
+    gaId <- resolveGovActionProposal $ getPrevId prevId
+    lift $ DB.updateGovActionEnacted gaId (unEpochNo epochNo)
+
+  whenJust (strictMaybeToMaybe (grCommittee enactedState)) $ \prevId -> do
+    gaId <- resolveGovActionProposal $ getPrevId prevId
+    lift $ DB.updateGovActionEnacted gaId (unEpochNo epochNo)
+
+  whenJust (strictMaybeToMaybe (grConstitution enactedState)) $ \prevId -> do
     gaId <- resolveGovActionProposal $ getPrevId prevId
-    if isEnacted
-      then lift $ DB.updateGovActionEnacted gaId (unEpochNo epochNo)
-      else lift $ DB.updateGovActionRatified gaId (unEpochNo epochNo)
+    lift $ DB.updateGovActionEnacted gaId (unEpochNo epochNo)
   where
     getPrevId = unGovPurposeId

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

@@ -90,6 +90,8 @@ insertBlockLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
           lift $ validateEpochRewards tracer ntw (subFromCurrentEpoch 2) currentEpochNo rwd
         LedgerAdaPots _ ->
           pure () -- These are handled separately by insertBlock
+        LedgerGovInfo en ex uncl -> do
+          pure () -- TODO: Conway
         LedgerMirDist rwd -> do
           unless (Map.null rwd) $ do
             let rewards = Map.toList rwd

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

@@ -41,7 +41,7 @@ import Cardano.DbSync.Era.Universal.Insert.Other (
 import Cardano.DbSync.Era.Universal.Insert.Pool (IsPoolMember)
 import Cardano.DbSync.Era.Util (liftLookupFail, safeDecodeToJson)
 import Cardano.DbSync.Error
-import Cardano.DbSync.Ledger.Types (ApplyResult (..), getCommittee, getGovExpiresAt, lookupDepositsMap)
+import Cardano.DbSync.Ledger.Types (ApplyResult (..), getGovExpiresAt, lookupDepositsMap)
 import Cardano.DbSync.Util
 import Cardano.DbSync.Util.Cbor (serialiseTxMetadataToCbor)
 import Cardano.Ledger.BaseTypes
@@ -175,7 +175,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
           Generic.txExtraKeyWitnesses tx
 
       when (ioGov iopts) $ do
-        mapM_ (insertGovActionProposal cache blkId txId (getGovExpiresAt applyResult epochNo) (getCommittee applyResult)) $ zip [0 ..] (Generic.txProposalProcedure tx)
+        mapM_ (insertGovActionProposal cache blkId txId (getGovExpiresAt applyResult epochNo) (apCommittee applyResult)) $ zip [0 ..] (Generic.txProposalProcedure tx)
         mapM_ (insertVotingProcedures tracer cache txId) (Generic.txVotingProcedure tx)
 
       let !txIns = map (prepareTxIn txId redeemers) resolvedInputs

cardano-db-sync/src/Cardano/DbSync/Ledger/Event.hs

@@ -24,9 +24,11 @@ import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Shelley.Generic.Tx.Shelley
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util
+import Cardano.Ledger.Address (RewardAccount)
 import qualified Cardano.Ledger.Allegra.Rules as Allegra
 import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyEvent (..), AlonzoUtxoEvent (..), AlonzoUtxowEvent (..))
 import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
+import Cardano.Ledger.Api (GovActionId, GovActionState (..), ProposalProcedure (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Rules as Conway
 import qualified Cardano.Ledger.Core as Ledger
@@ -70,11 +72,20 @@ data LedgerEvent
   | LedgerRestrainedRewards !EpochNo !Generic.Rewards !(Set StakeCred)
   | LedgerTotalRewards !EpochNo !(Map StakeCred (Set (Ledger.Reward StandardCrypto)))
   | LedgerAdaPots !AdaPots
+  | LedgerGovInfo [GovActionRefunded] [GovActionRefunded] (Set (GovActionId StandardCrypto))
   | LedgerDeposits (SafeHash StandardCrypto Ledger.EraIndependentTxBody) Coin
   | LedgerStartAtEpoch !EpochNo
   | LedgerNewEpoch !EpochNo !SyncState
   deriving (Eq)
 
+data GovActionRefunded = GovActionRefunded
+  { garGovActionId :: GovActionId StandardCrypto
+  , garDeposit :: Coin
+  , garReturnAddr :: RewardAccount StandardCrypto
+  , garIsEnacted :: Bool -- True for enacted, False for retired, possibly redundant
+  }
+  deriving (Eq)
+
 instance Ord LedgerEvent where
   a <= b = toOrdering a <= toOrdering b
 
@@ -87,9 +98,10 @@ toOrdering ev = case ev of
   LedgerRestrainedRewards {} -> 4
   LedgerTotalRewards {} -> 5
   LedgerAdaPots {} -> 6
-  LedgerDeposits {} -> 7
-  LedgerStartAtEpoch {} -> 8
-  LedgerNewEpoch {} -> 9
+  LedgerGovInfo {} -> 7
+  LedgerDeposits {} -> 8
+  LedgerStartAtEpoch {} -> 9
+  LedgerNewEpoch {} -> 10
 
 convertAuxLedgerEvent :: Bool -> OneEraLedgerEvent (CardanoEras StandardCrypto) -> Maybe LedgerEvent
 convertAuxLedgerEvent hasRewards = toLedgerEvent hasRewards . wrappedAuxLedgerEvent
@@ -104,6 +116,7 @@ ledgerEventName le =
     LedgerRestrainedRewards {} -> "LedgerRestrainedRewards"
     LedgerTotalRewards {} -> "LedgerTotalRewards"
     LedgerAdaPots {} -> "LedgerAdaPots"
+    LedgerGovInfo {} -> "LedgerGovInfo"
     LedgerDeposits {} -> "LedgerDeposits"
     LedgerStartAtEpoch {} -> "LedgerStartAtEpoch"
     LedgerNewEpoch {} -> "LedgerNewEpoch"
@@ -234,7 +247,27 @@ toLedgerEventConway evt hasRewards =
       ( TickNewEpochEvent
           (Conway.TotalAdaPotsEvent p)
         ) -> Just $ LedgerAdaPots p
+    ShelleyLedgerEventTICK
+      ( TickNewEpochEvent
+          ( Conway.EpochEvent
+              (Conway.GovInfoEvent en ex uncl)
+            )
+        ) ->
+        Just $
+          LedgerGovInfo
+            (toGovActionRefunded True <$> toList en)
+            (toGovActionRefunded False <$> toList ex)
+            uncl
     _ -> Nothing
+  where
+    toGovActionRefunded :: EraCrypto era ~ StandardCrypto => Bool -> GovActionState era -> GovActionRefunded
+    toGovActionRefunded isEnacted gas =
+      GovActionRefunded
+        { garGovActionId = gasId gas
+        , garDeposit = pProcDeposit $ gasProposalProcedure gas
+        , garReturnAddr = pProcReturnAddr $ gasProposalProcedure gas
+        , garIsEnacted = isEnacted
+        }
 
 instance All ConvertLedgerEvent xs => ConvertLedgerEvent (HardForkBlock xs) where
   toLedgerEvent hasRewards =

cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs

@@ -70,6 +70,7 @@ import qualified Data.ByteString.Base16 as Base16
 
 import Cardano.DbSync.Api.Types (InsertOptions (..), LedgerEnv (..), SyncOptions (..))
 import Cardano.DbSync.Error (SyncNodeError (..), fromEitherSTM)
+import Cardano.Ledger.BaseTypes (StrictMaybe)
 import Cardano.Ledger.Conway.Core as Shelley
 import Cardano.Ledger.Conway.Governance
 import qualified Cardano.Ledger.Conway.Governance as Shelley
@@ -125,7 +126,7 @@ import qualified Ouroboros.Network.Point as Point
 import System.Directory (doesFileExist, listDirectory, removeFile)
 import System.FilePath (dropExtension, takeExtension, (</>))
 import System.Mem (performMajorGC)
-import Prelude (String, error, id)
+import Prelude (String, id)
 
 -- Note: The decision on whether a ledger-state is written to disk is based on the block number
 -- rather than the slot number because while the block number is fully populated (for every block
@@ -245,7 +246,7 @@ applyBlock env blk = do
                 , apSlotDetails = details
                 , apStakeSlice = getStakeSlice env newState False
                 , apEvents = ledgerEvents
-                , apEnactState = getEnacted newLedgerState
+                , apCommittee = getCommittee newLedgerState
                 , apDepositsMap = DepositsMap deposits
                 }
             else defaultApplyResult details
@@ -270,7 +271,7 @@ applyBlock env blk = do
                     , Generic.neIsEBB = isJust $ blockIsEBB blk
                     , Generic.neAdaPots = maybeToStrict mPots
                     , Generic.neEpochUpdate = Generic.epochUpdate newState
-                    , Generic.neDRepState = maybeToStrict $ getDrepDistr newState
+                    , Generic.neDRepState = maybeToStrict $ getDrepState newState
                     , Generic.neEnacted = maybeToStrict $ getEnacted newState
                     }
 
@@ -281,16 +282,22 @@ applyBlock env blk = do
     applyToEpochBlockNo _ _ GenesisEpochBlockNo = EpochBlockNo 0
     applyToEpochBlockNo _ _ EBBEpochBlockNo = EpochBlockNo 0
 
-getDrepDistr :: ExtLedgerState CardanoBlock -> Maybe (DRepPulsingState StandardConway)
-getDrepDistr ls = case ledgerState ls of
+getEnacted :: ExtLedgerState CardanoBlock -> Maybe (GovRelation StrictMaybe StandardConway)
+getEnacted ls = case ledgerState ls of
+  LedgerStateConway cls ->
+    Just $ govStatePrevGovActionIds $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateGovStateL
+  _ -> Nothing
+
+getDrepState :: ExtLedgerState CardanoBlock -> Maybe (DRepPulsingState StandardConway)
+getDrepState ls = case ledgerState ls of
   LedgerStateConway cls ->
     Just $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateDRepPulsingStateL
   _ -> Nothing
 
-getEnacted :: ExtLedgerState CardanoBlock -> Maybe (EnactState StandardConway)
-getEnacted ls = case ledgerState ls of
+getCommittee :: ExtLedgerState CardanoBlock -> Maybe (StrictMaybe (Committee StandardConway))
+getCommittee ls = case ledgerState ls of
   LedgerStateConway cls ->
-    Just $ Consensus.shelleyLedgerState cls ^. (Shelley.nesEsL . Shelley.esLStateL . Shelley.lsUTxOStateL . Shelley.utxosGovStateL . error "getEnacted") -- TODO: Conway
+    Just $ Consensus.shelleyLedgerState cls ^. (Shelley.newEpochStateGovStateL . cgsCommitteeL)
   _ -> Nothing
 
 getStakeSlice :: HasLedgerEnv -> CardanoLedgerState -> Bool -> Generic.StakeSliceRes

cardano-db-sync/src/Cardano/DbSync/Ledger/Types.hs

@@ -22,6 +22,7 @@ import Cardano.DbSync.Types (
   SlotDetails,
  )
 import Cardano.Ledger.Alonzo.Scripts (Prices)
+import Cardano.Ledger.BaseTypes (StrictMaybe)
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Conway.Governance
@@ -40,7 +41,6 @@ import Control.Concurrent.STM.TBQueue (TBQueue)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Strict.Maybe as Strict
-import Lens.Micro
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..))
 import Ouroboros.Consensus.Cardano.Block (StandardConway, StandardCrypto)
 import Ouroboros.Consensus.Ledger.Abstract (getTipSlot)
@@ -137,7 +137,7 @@ data ApplyResult = ApplyResult
   , apSlotDetails :: !SlotDetails
   , apStakeSlice :: !Generic.StakeSliceRes
   , apEvents :: ![LedgerEvent]
-  , apEnactState :: !(Maybe (EnactState StandardConway))
+  , apCommittee :: !(Maybe (StrictMaybe (Committee StandardConway)))
   , apDepositsMap :: !DepositsMap
   }
 
@@ -153,7 +153,7 @@ defaultApplyResult slotDetails =
     , apSlotDetails = slotDetails
     , apStakeSlice = Generic.NoSlices
     , apEvents = []
-    , apEnactState = Nothing
+    , apCommittee = Nothing
     , apDepositsMap = emptyDepositsMap
     }
 
@@ -162,11 +162,6 @@ getGovExpiresAt applyResult e = case apGovExpiresAfter applyResult of
   Strict.Just ei -> Just $ Ledger.addEpochInterval e ei
   Strict.Nothing -> Nothing
 
-getCommittee :: ApplyResult -> Maybe (Ledger.StrictMaybe (Committee StandardConway))
-getCommittee ar = case apEnactState ar of
-  Nothing -> Nothing
-  Just es -> Just $ es ^. ensCommitteeL
-
 -- TODO reuse this function rom ledger after it's exported.
 updatedCommittee ::
   Set.Set (Credential 'ColdCommitteeRole StandardCrypto) ->

doc/configuration.md

@@ -286,6 +286,8 @@ When this flag is enabled:
  * `drep_distr` is left empty
  * `governance_action.x_epoch` is left null
  * `governance_action.expiration` is left null
+ * `stake_registration.deposit` is left null
+ * `pool_update.deposit` is left null
 
 Warning: Running db-sync with this setting and restarting it with a different one will cause crashes
 and should be avoided.