test(cardano-chain-gen): Add a Conway DRep distribution test

Author: sgillespie

cardano-chain-gen/cardano-chain-gen.cabal

@@ -158,6 +158,7 @@ test-suite cardano-chain-gen
                         Test.Cardano.Db.Mock.Unit.Conway.CommandLineArg.ForceIndex
                         Test.Cardano.Db.Mock.Unit.Conway.Config.Parse
                         Test.Cardano.Db.Mock.Unit.Conway.Config.MigrateConsumedPruneTxOut
+                        Test.Cardano.Db.Mock.Unit.Conway.Governance
                         Test.Cardano.Db.Mock.Unit.Conway.InlineAndReference
                         Test.Cardano.Db.Mock.Unit.Conway.Other
                         Test.Cardano.Db.Mock.Unit.Conway.Plutus

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -29,12 +30,14 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkScriptDCertTx,
   mkMultiAssetsScriptTx,
   mkDepositTxPools,
+  mkRegisterDRepTx,
   mkDummyRegisterTx,
   mkDummyTxBody,
   mkTxDelegCert,
   mkRegTxCert,
   mkUnRegTxCert,
   mkDelegTxCert,
+  mkRegDelegTxCert,
   Babbage.mkParamUpdateTx,
   mkFullTx,
   mkScriptMint',
@@ -436,6 +439,14 @@ mkDepositTxPools inputIndex deposit state' = do
         (allPoolStakeCert' state')
         (Withdrawals mempty)
 
+mkRegisterDRepTx ::
+  Credential 'DRepRole StandardCrypto ->
+  Either ForgingError (AlonzoTx StandardConway)
+mkRegisterDRepTx cred = mkDCertTx [cert] (Withdrawals mempty) Nothing
+  where
+    cert = ConwayTxCertGov (ConwayRegDRep cred deposit SNothing)
+    deposit = Coin 500_000_000
+
 mkDummyRegisterTx :: Int -> Int -> Either ForgingError (AlonzoTx StandardConway)
 mkDummyRegisterTx n m = mkDCertTx consDelegCert (Withdrawals mempty) Nothing
   where
@@ -459,6 +470,14 @@ mkUnRegTxCert ::
   ConwayTxCert StandardConway
 mkUnRegTxCert coin' = mkTxDelegCert $ \cred -> ConwayUnRegCert cred coin'
 
+mkRegDelegTxCert ::
+  Coin ->
+  Delegatee StandardCrypto ->
+  StakeCredential StandardCrypto ->
+  ConwayTxCert StandardConway
+mkRegDelegTxCert deposit delegatee =
+  mkTxDelegCert $ \cred -> ConwayRegDelegCert cred delegatee deposit
+
 mkDelegTxCert ::
   Delegatee StandardCrypto ->
   StakeCredential StandardCrypto ->

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -6,10 +6,11 @@ module Cardano.Mock.Query (
   queryNullTxDepositExists,
   queryMultiAssetCount,
   queryTxMetadataCount,
+  queryDRepDistrAmount,
 ) where
 
 import qualified Cardano.Db as Db
-import Cardano.Prelude hiding (from)
+import Cardano.Prelude hiding (from, on)
 import Database.Esqueleto.Experimental
 import Prelude ()
 
@@ -68,3 +69,23 @@ queryTxMetadataCount = do
     pure countRows
 
   pure $ maybe 0 unValue res
+
+queryDRepDistrAmount ::
+  MonadIO io =>
+  ByteString ->
+  Word64 ->
+  ReaderT SqlBackend io Word64
+queryDRepDistrAmount drepHash epochNo = do
+  res <- selectOne $ do
+    (distr :& hash) <-
+      from
+        $ table @Db.DrepDistr
+          `innerJoin` table @Db.DrepHash
+        `on` (\(distr :& hash) -> (hash ^. Db.DrepHashId) ==. (distr ^. Db.DrepDistrHashId))
+
+    where_ $ hash ^. Db.DrepHashRaw ==. just (val drepHash)
+    where_ $ distr ^. Db.DrepDistrEpochNo ==. val epochNo
+
+    pure (distr ^. Db.DrepDistrAmount)
+
+  pure $ maybe 0 unValue res

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs

@@ -7,6 +7,7 @@ import qualified Test.Cardano.Db.Mock.Unit.Conway.CommandLineArg.EpochDisabled a
 import qualified Test.Cardano.Db.Mock.Unit.Conway.CommandLineArg.ForceIndex as ForceIndex
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Config.MigrateConsumedPruneTxOut as MigrateConsumedPruneTxOut
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Config.Parse as Config
+import qualified Test.Cardano.Db.Mock.Unit.Conway.Governance as Governance
 import qualified Test.Cardano.Db.Mock.Unit.Conway.InlineAndReference as InlineRef
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Other as Other
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Plutus as Plutus
@@ -214,6 +215,10 @@ unitTests iom knownMigrations =
         , test "fork from Babbage to Conway and rollback" Other.rollbackFork
         , test "fork with protocol change proposal" Other.forkParam
         ]
+    , testGroup
+        "Governance"
+        [ test "drep distribution" Governance.drepDistr
+        ]
     ]
   where
     test :: String -> (IOManager -> [(Text, Text)] -> Assertion) -> TestTree

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Cardano.Db.Mock.Unit.Conway.Governance (
+  drepDistr,
+) where
+
+import Cardano.DbSync.Era.Shelley.Generic.Util (unCredentialHash)
+import Cardano.Ledger.Address (Withdrawals (..))
+import Cardano.Ledger.Conway.TxCert (Delegatee (..))
+import Cardano.Ledger.Credential (Credential (..))
+import Cardano.Ledger.DRep (DRep (..))
+import Cardano.Ledger.Keys (KeyHash (..))
+import Cardano.Mock.ChainSync.Server (IOManager)
+import qualified Cardano.Mock.Forging.Tx.Conway as Conway
+import Cardano.Mock.Forging.Tx.Generic (resolveStakeCreds)
+import Cardano.Mock.Forging.Types
+import qualified Cardano.Mock.Query as Query
+import Cardano.Prelude
+import Test.Cardano.Db.Mock.Config
+import qualified Test.Cardano.Db.Mock.UnifiedApi as Api
+import Test.Cardano.Db.Mock.Validate
+import Test.Tasty.HUnit (Assertion)
+import Prelude ()
+
+drepDistr :: IOManager -> [(Text, Text)] -> Assertion
+drepDistr =
+  withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter server dbSync -> do
+    startDBSync dbSync
+
+    -- Add stake
+    void (Api.registerAllStakeCreds interpreter server)
+
+    -- Delegate funds to a stake address
+    void $
+      Api.withConwayFindLeaderAndSubmitTx interpreter server $ \state' ->
+        let utxoStake = UTxOAddressNewWithStake 0 (StakeIndex 4)
+         in Conway.mkPaymentTx (UTxOIndex 0) utxoStake 10_000 500 state'
+
+    -- Register a DRep
+    let drepHash = "0d94e174732ef9aae73f395ab44507bfa983d65023c11a951f0c32e4"
+        drepId = KeyHashObj (KeyHash drepHash)
+
+    void $
+      Api.withConwayFindLeaderAndSubmitTx interpreter server $
+        const (Conway.mkRegisterDRepTx drepId)
+
+    -- Delegate votes to the drep above
+    void $
+      Api.withConwayFindLeaderAndSubmitTx interpreter server $ \state' -> do
+        stakeCreds <- resolveStakeCreds (StakeIndex 4) state'
+        let regDelegCert =
+              Conway.mkDelegTxCert (DelegVote $ DRepCredential drepId) stakeCreds
+
+        Conway.mkDCertTx [regDelegCert] (Withdrawals mempty) Nothing
+
+    -- DRep distribution is calculated at end of the current epoch
+    epoch1 <- Api.fillUntilNextEpoch interpreter server
+
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync (length epoch1 + 4)
+
+    -- Should now have a DRep distribution
+    assertEqQuery
+      dbSync
+      (Query.queryDRepDistrAmount (unCredentialHash drepId) 1)
+      10_000
+      "Unexpected drep distribution amount"
+
+    pure ()
+  where
+    testLabel = "conwayDrepDistr"

cardano-chain-gen/test/testfiles/fingerprint/conwayDrepDistr

@@ -0,0 +1 @@
+[5,11,15,21,22,23,28,33,34,36,42,43,48,52,62,82,88,92,102,106,109,111,116,133,134,143,151,153,157,161,162,171,182,183,193,195,196,197,200,206,208,216,219,222,238,245,250,262,271,272,275,282,286,296,301,310,311,314,325,340,347,354,355,365,376,379,382,384,389,390,391,392,393,398,404,407,414,418,419,422,424,446,448,450,457,465,476,478,485,486,488,499,500]