Compute the correct committee on proposal

Author: kderme

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

@@ -39,7 +39,7 @@ import Cardano.DbSync.Era.Shelley.Generic.ParamProposal
 import Cardano.DbSync.Era.Universal.Insert.Other (toDouble)
 import Cardano.DbSync.Era.Util (liftLookupFail)
 import Cardano.DbSync.Error
-import Cardano.DbSync.Ledger.Types
+import Cardano.DbSync.Ledger.State
 import Cardano.DbSync.Util
 import Cardano.DbSync.Util.Bech32 (serialiseDrepToBech32)
 import Cardano.Ledger.BaseTypes
@@ -74,10 +74,10 @@ insertGovActionProposal ::
   DB.BlockId ->
   DB.TxId ->
   Maybe EpochNo ->
-  Maybe (StrictMaybe (Committee StandardConway)) ->
-  (Word64, ProposalProcedure StandardConway) ->
+  Maybe (ConwayGovState StandardConway) ->
+  (Word64, (GovActionId StandardCrypto, ProposalProcedure StandardConway)) ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertGovActionProposal trce cache blkId txId govExpiresAt mmCommittee (index, pp) = do
+insertGovActionProposal trce cache blkId txId govExpiresAt mcgs (index, (govId, pp)) = do
   addrId <-
     lift $ queryOrInsertRewardAccount trce cache UpdateCache $ pProcReturnAddr pp
   votingAnchorId <- lift $ insertVotingAnchor blkId DB.GovActionAnchor $ pProcAnchor pp
@@ -110,7 +110,7 @@ insertGovActionProposal trce cache blkId txId govExpiresAt mmCommittee (index, p
           }
   case pProcGovAction pp of
     TreasuryWithdrawals mp _ -> lift $ mapM_ (insertTreasuryWithdrawal govActionProposalId) (Map.toList mp)
-    UpdateCommittee _ removed added q -> lift $ insertNewCommittee (Just govActionProposalId) removed added q
+    UpdateCommittee {} -> lift $ insertNewCommittee govActionProposalId
     NewConstitution _ constitution -> lift $ void $ insertConstitution blkId (Just govActionProposalId) constitution
     _ -> pure ()
   where
@@ -133,26 +133,22 @@ insertGovActionProposal trce cache blkId txId govExpiresAt mmCommittee (index, p
           }
 
     insertNewCommittee ::
-      Maybe DB.GovActionProposalId ->
-      Set (Ledger.Credential 'ColdCommitteeRole StandardCrypto) ->
-      Map (Ledger.Credential 'ColdCommitteeRole StandardCrypto) EpochNo ->
-      UnitInterval ->
+      DB.GovActionProposalId ->
       ReaderT SqlBackend m ()
-    insertNewCommittee gapId removed added q = do
-      void $ insertCommittee' gapId (updatedCommittee removed added q <$> mmCommittee) q
+    insertNewCommittee govActionProposalId = do
+      whenJust mcgs $ \cgs ->
+        case findProposedCommittee govId cgs of
+          Right (Just committee) -> void $ insertCommittee (Just govActionProposalId) committee
+          other ->
+            liftIO $ logWarning trce $ textShow other <> ": Failed to find committee for " <> textShow pp
 
 insertCommittee :: (MonadIO m, MonadBaseControl IO m) => Maybe DB.GovActionProposalId -> Committee StandardConway -> ReaderT SqlBackend m DB.CommitteeId
 insertCommittee mgapId committee = do
-  insertCommittee' mgapId (Just committee) (committeeThreshold committee)
-
-insertCommittee' :: (MonadIO m, MonadBaseControl IO m) => Maybe DB.GovActionProposalId -> Maybe (Committee StandardConway) -> UnitInterval -> ReaderT SqlBackend m DB.CommitteeId
-insertCommittee' mgapId mcommittee q = do
   committeeId <- insertCommitteeDB
-  whenJust mcommittee $ \committee ->
-    mapM_ (insertNewMember committeeId) (Map.toList $ committeeMembers committee)
+  mapM_ (insertNewMember committeeId) (Map.toList $ committeeMembers committee)
   pure committeeId
   where
-    r = unboundRational q -- TODO work directly with Ratio Word64. This is not currently supported in ledger
+    r = unboundRational $ committeeThreshold committee -- TODO work directly with Ratio Word64. This is not currently supported in ledger
     insertNewMember committeeId (cred, e) = do
       chId <- insertCommitteeHash cred
       void . DB.insertCommitteeMember $

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

@@ -184,7 +184,7 @@ insertTx syncEnv isMember blkId epochNo slotNo applyResult blockIndex tx grouped
           Generic.txExtraKeyWitnesses tx
 
       when (ioGov iopts) $ do
-        mapM_ (insertGovActionProposal tracer cache blkId txId (getGovExpiresAt applyResult epochNo) (apCommittee applyResult)) $ zip [0 ..] (snd <$> Generic.txProposalProcedure tx)
+        mapM_ (insertGovActionProposal tracer cache blkId txId (getGovExpiresAt applyResult epochNo) (apGovActionState applyResult)) $ zip [0 ..] (Generic.txProposalProcedure tx)
         mapM_ (insertVotingProcedures tracer cache blkId txId) (Generic.txVotingProcedure tx)
 
       let !txIns = map (prepareTxIn txId redeemers) resolvedInputs

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

@@ -248,7 +248,7 @@ applyBlock env blk = do
                 , apSlotDetails = details
                 , apStakeSlice = getStakeSlice env newState False
                 , apEvents = ledgerEvents
-                , apCommittee = getCommittee newLedgerState
+                , apGovActionState = getGovState newLedgerState
                 , apDepositsMap = DepositsMap deposits
                 }
             else defaultApplyResult details
@@ -277,7 +277,7 @@ applyBlock env blk = do
             , Generic.neAdaPots = maybeToStrict mPots
             , Generic.neEpochUpdate = Generic.epochUpdate newState
             , Generic.neDRepState = maybeToStrict $ getDrepState newState
-            , Generic.neEnacted = maybeToStrict $ getEnacted newState
+            , Generic.neEnacted = maybeToStrict $ getGovState newState
             }
 
     applyToEpochBlockNo :: Bool -> Bool -> EpochBlockNo -> EpochBlockNo
@@ -294,18 +294,12 @@ applyBlock env blk = do
     finaliseDrepDistr ledger =
       ledger & newEpochStateT %~ forceDRepPulsingState @StandardConway
 
-getEnacted :: ExtLedgerState CardanoBlock -> Maybe (ConwayGovState StandardConway)
-getEnacted ls = case ledgerState ls of
+getGovState :: ExtLedgerState CardanoBlock -> Maybe (ConwayGovState StandardConway)
+getGovState ls = case ledgerState ls of
   LedgerStateConway cls ->
     Just $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateGovStateL
   _ -> Nothing
 
-getCommittee :: ExtLedgerState CardanoBlock -> Maybe (StrictMaybe (Committee StandardConway))
-getCommittee ls = case ledgerState ls of
-  LedgerStateConway cls ->
-    Just $ Consensus.shelleyLedgerState cls ^. (Shelley.newEpochStateGovStateL . cgsCommitteeL)
-  _ -> Nothing
-
 getStakeSlice :: HasLedgerEnv -> CardanoLedgerState -> Bool -> Generic.StakeSliceRes
 getStakeSlice env cls isMigration =
   case clsEpochBlockNo cls of
@@ -860,32 +854,33 @@ findAdaPots = go
     go (_ : rest) = go rest
 
 -- | Given an committee action id and the current GovState, return the proposed committee.
--- If the id is not included in the proposals, return Nothing.
-findProposedCommittee :: GovActionId StandardCrypto -> ConwayGovState StandardConway -> Maybe (Committee StandardConway)
+-- If it's not a Committee action or is not included in the proposals, return Nothing.
+findProposedCommittee :: GovActionId StandardCrypto -> ConwayGovState StandardConway -> Either Text (Maybe (Committee StandardConway))
 findProposedCommittee gaId cgs = do
   (rootCommittee, updateList) <- findRoot gaId
   computeCommittee rootCommittee updateList
   where
     ps = cgsProposals cgs
     findRoot = findRootRecursively []
 
-    findRootRecursively :: [GovAction StandardConway] -> GovActionId StandardCrypto -> Maybe (StrictMaybe (Committee StandardConway), [GovAction StandardConway])
+    findRootRecursively :: [GovAction StandardConway] -> GovActionId StandardCrypto -> Either Text (StrictMaybe (Committee StandardConway), [GovAction StandardConway])
     findRootRecursively acc gid = do
-      gas <- proposalsLookupId gid ps
+      gas <- fromNothing ("Didn't find proposal " <> textShow gid) $ proposalsLookupId gid ps
       let ga = pProcGovAction (gasProposalProcedure gas)
       case ga of
-        NoConfidence _ -> Just (Ledger.SNothing, acc)
-        UpdateCommittee Ledger.SNothing _ _ _ -> Just (cgsCommittee cgs, ga : acc)
+        NoConfidence _ -> Right (Ledger.SNothing, acc)
+        UpdateCommittee Ledger.SNothing _ _ _ -> Right (cgsCommittee cgs, ga : acc)
         UpdateCommittee gpid _ _ _
           | gpid == ps ^. pRootsL . grCommitteeL . prRootL ->
-              Just (cgsCommittee cgs, ga : acc)
+              Right (cgsCommittee cgs, ga : acc)
         UpdateCommittee (Ledger.SJust gpid) _ _ _ -> findRootRecursively (ga : acc) (unGovPurposeId gpid)
-        _ -> Nothing
+        _ -> Left "Found invalid gov action referenced by committee"
 
-    computeCommittee :: StrictMaybe (Committee StandardConway) -> [GovAction StandardConway] -> Maybe (Committee StandardConway)
+    computeCommittee :: StrictMaybe (Committee StandardConway) -> [GovAction StandardConway] -> Either Text (Maybe (Committee StandardConway))
     computeCommittee sCommittee actions =
-      Ledger.strictMaybeToMaybe $ foldl applyCommitteeUpdate sCommittee actions
+      Ledger.strictMaybeToMaybe <$> foldM applyCommitteeUpdate sCommittee actions
 
     applyCommitteeUpdate scommittee = \case
-      UpdateCommittee _ toRemove toAdd q -> Ledger.SJust $ updatedCommittee toRemove toAdd q scommittee
-      _ -> Ledger.SNothing -- Should never happen since the accumulator only gets UpdateCommittee
+      UpdateCommittee _ toRemove toAdd q -> Right $ Ledger.SJust $ updatedCommittee toRemove toAdd q scommittee
+      _ -> Left "Unexpected gov action." -- Should never happen since the accumulator only includes UpdateCommittee
+    fromNothing err = maybe (Left err) Right

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

@@ -23,7 +23,6 @@ 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
@@ -143,7 +142,7 @@ data ApplyResult = ApplyResult
   , apSlotDetails :: !SlotDetails
   , apStakeSlice :: !Generic.StakeSliceRes
   , apEvents :: ![LedgerEvent]
-  , apCommittee :: !(Maybe (StrictMaybe (Committee StandardConway)))
+  , apGovActionState :: !(Maybe (ConwayGovState StandardConway))
   , apDepositsMap :: !DepositsMap
   }
 
@@ -159,7 +158,7 @@ defaultApplyResult slotDetails =
     , apSlotDetails = slotDetails
     , apStakeSlice = Generic.NoSlices
     , apEvents = []
-    , apCommittee = Nothing
+    , apGovActionState = Nothing
     , apDepositsMap = emptyDepositsMap
     }