test(cardano-chain-gen): Add a treasury withdrawal test

Author: sgillespie

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

@@ -19,6 +19,7 @@ module Cardano.Mock.Forging.Tx.Conway (
   consTxCertPool,
   mkPaymentTx,
   mkPaymentTx',
+  mkDonationTx,
   mkLockByScriptTx,
   mkUnlockScriptTx,
   mkUnlockScriptTxBabbage,
@@ -43,6 +44,7 @@ module Cardano.Mock.Forging.Tx.Conway (
   mkDelegTxCert,
   mkRegDelegTxCert,
   mkAddCommitteeTx,
+  mkTreasuryWithdrawalTx,
   mkGovActionProposalTx,
   mkGovVoteTx,
   Babbage.mkParamUpdateTx,
@@ -215,6 +217,11 @@ mkPaymentTx' inputIndex outputIndices fees state' = do
       addr <- resolveAddress outIx state'
       pure (BabbageTxOut addr val NoDatum SNothing)
 
+mkDonationTx :: Coin -> AlonzoTx StandardConway
+mkDonationTx amount = mkSimpleTx True txBody
+  where
+    txBody = mkDummyTxBody {ctbTreasuryDonation = amount}
+
 mkLockByScriptTx ::
   ConwayUTxOIndex ->
   [Babbage.TxOutScriptType] ->
@@ -522,6 +529,16 @@ mkNewConstitutionTx anchor = mkGovActionProposalTx govAction
     govAction = Governance.NewConstitution SNothing constitution
     constitution = Governance.Constitution anchor SNothing
 
+mkTreasuryWithdrawalTx ::
+  RewardAccount StandardCrypto ->
+  Coin ->
+  AlonzoTx StandardConway
+mkTreasuryWithdrawalTx rewardAccount amount = mkGovActionProposalTx govAction
+  where
+    govAction = Governance.TreasuryWithdrawals withdrawals hashProtection
+    withdrawals = Map.singleton rewardAccount amount
+    hashProtection = SNothing
+
 mkGovActionProposalTx ::
   Governance.GovAction StandardConway ->
   AlonzoTx StandardConway

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

@@ -10,6 +10,7 @@ module Cardano.Mock.Query (
   queryDRepDistrAmount,
   queryGovActionCounts,
   queryConstitutionAnchor,
+  queryRewardRests,
 ) where
 
 import qualified Cardano.Db as Db
@@ -139,3 +140,13 @@ queryConstitutionAnchor epochNo = do
     pure (anchor ^. Db.VotingAnchorUrl, anchor ^. Db.VotingAnchorDataHash)
 
   pure $ bimap (Db.unVoteUrl . unValue) unValue <$> res
+
+queryRewardRests ::
+  MonadIO io =>
+  ReaderT SqlBackend io [(Db.RewardSource, Word64)]
+queryRewardRests = do
+  res <- select $ do
+    reward <- from $ table @Db.RewardRest
+    pure (reward ^. Db.RewardRestType, reward ^. Db.RewardRestAmount)
+
+  pure $ map (bimap unValue (Db.unDbLovelace . unValue)) res

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

@@ -220,6 +220,7 @@ unitTests iom knownMigrations =
         [ test "drep distribution" Governance.drepDistr
         , test "new committee member" Governance.newCommittee
         , test "update constitution" Governance.updateConstitution
+        , test "treasury withdrawal" Governance.treasuryWithdrawal
         ]
     ]
   where

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

@@ -7,10 +7,14 @@ module Test.Cardano.Db.Mock.Unit.Conway.Governance (
   drepDistr,
   newCommittee,
   updateConstitution,
+  treasuryWithdrawal,
 ) where
 
+import qualified Cardano.Db as Db
 import Cardano.DbSync.Era.Shelley.Generic.Util (unCredentialHash)
-import Cardano.Ledger.BaseTypes (AnchorData (..), hashAnchorData, textToUrl)
+import Cardano.Ledger.Address (RewardAccount (..))
+import Cardano.Ledger.BaseTypes (AnchorData (..), Network (..), hashAnchorData, textToUrl)
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Governance (GovActionId (..), GovActionIx (..), Voter (..))
 import qualified Cardano.Ledger.Conway.Governance as Governance
 import Cardano.Ledger.Core (txIdTx)
@@ -175,3 +179,71 @@ updateConstitution =
       "Unexpected constution voting anchor"
   where
     testLabel = "conwayUpdateConstitution"
+
+treasuryWithdrawal :: IOManager -> [(Text, Text)] -> Assertion
+treasuryWithdrawal =
+  withFullConfig conwayConfigDir testLabel $ \interpreter server dbSync -> do
+    startDBSync dbSync
+
+    -- Add stake
+    void (Api.registerAllStakeCreds interpreter server)
+
+    -- Register a DRep and delegate votes to it
+    void (Api.registerDRepsAndDelegateVotes interpreter server)
+
+    -- DRep distribution is calculated at end of the current epoch
+    epoch0 <- Api.fillUntilNextEpoch interpreter server
+
+    -- Register committee hot credentials
+    -- TODO[sgillespie]: Let's get this in UnifiedApi or something
+    void $
+      Api.withConwayFindLeaderAndSubmit interpreter server $ \_ ->
+        mapM (uncurry Conway.mkCommitteeAuthTx) Forging.bootstrapCommitteeCreds
+
+    -- Make sure we have treasury to spend
+    void $
+      Api.withConwayFindLeaderAndSubmitTx interpreter server $ \_ ->
+        Right $ Conway.mkDonationTx (Coin 50_000)
+
+    -- Create and vote for a governance proposal
+    void $
+      Api.withConwayFindLeaderAndSubmit interpreter server $ \ledger -> do
+        rewardAccount <-
+          RewardAccount Testnet <$> Forging.resolveStakeCreds (StakeIndex 0) ledger
+
+        let
+          proposalTx =
+            Conway.mkTreasuryWithdrawalTx
+              rewardAccount
+              (Coin 10_000)
+
+          addVoteTx =
+            Conway.mkGovVoteTx
+              govActionId
+              ( DRepVoter (Prelude.head Forging.unregisteredDRepIds)
+                  : map (CommitteeVoter . snd) Forging.bootstrapCommitteeCreds
+              )
+
+          govActionId =
+            GovActionId
+              { gaidTxId = txIdTx proposalTx
+              , gaidGovActionIx = GovActionIx 0
+              }
+
+        pure [proposalTx, addVoteTx]
+
+    -- It takes 2 epochs to enact a proposal--ratification will happen on the next
+    -- epoch and enacted on the following.
+    epoch1 <- Api.fillEpochs interpreter server 2
+
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync (length (epoch0 <> epoch1) + 5)
+
+    -- Should now have a treasury reward
+    assertEqQuery
+      dbSync
+      Query.queryRewardRests
+      [(Db.RwdTreasury, 10_000)]
+      "Unexpected constution voting anchor"
+  where
+    testLabel = "conwayTreasuryWithdrawal"

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

@@ -0,0 +1 @@
+[12,16,18,21,24,30,31,32,33,40,41,42,43,47,52,60,62,70,80,84,86,92,98,100,106,109,110,111,112,127,134,138,146,149,154,166,168,178,183,188,193,194,198,200,202,220,222,223,224,225,231,239,242,247,261,282,283,288,289,301,302,303,308,313,315,316,320,331,334,344,345,363,364,368,369,375,377,381,389,394,407,418,422,425,430,437,438,439,440,447,450,453,454,456,458,461,467,492,499,507,516,524,538,541,544,546,550,567,573,576,577,579,580,586,589,595,597,603,605,609,616,618,619,623,624,634,636,643,644,659,664,665,672,678,692,705,711,712,719,726,730,739,740,743,747,749,751,754,759,762,763,765,767,773,777,786,788,789,794,801,806,807,829,830,832,849,851,853,869,871,874,875,878,882,888,893,895,896,898,899,903,906,908,911,912,913,922,930,932,938,941,944,950,960,963,966,968,972,977,985,986,988,990,991,994,997,1001,1005,1008,1014,1019,1020,1021,1026,1027,1031,1032,1033,1036,1037,1049,1050,1053,1057,1062,1067,1068,1070,1074,1083,1102,1104,1107,1111,1115,1117,1118,1120,1125,1127,1137,1149,1151,1155,1161,1164,1167,1174,1187,1200,1201,1206,1213,1218,1221,1237,1242,1248,1258,1263,1266,1272,1277,1286,1299,1300,1304,1309,1313,1317,1336,1338,1343,1356,1363,1366,1376,1377,1379,1390,1397,1401,1408,1409,1410,1418,1423,1424,1429,1432,1435,1438,1439,1442,1444,1449,1453,1454,1461,1462,1470,1473,1474,1481,1484,1486,1500]