Disallow empty treasury withdrawals

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.17.0.0
 
+* Add `EmptyTreasuryWithdrawals` to `ConwayGovPredFailure`
 * Add `ProtVer` argument to `TxInfo` functions:
   * `transTxCert`
   * `transScriptPurpose`

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs

@@ -193,6 +193,8 @@ data ConwayGovPredFailure era
       (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era)))
   | -- | Predicate failure for votes by entities that are not present in the ledger state
     VotersDoNotExist (NonEmpty (Voter (EraCrypto era)))
+  | -- | Treasury withdrawals that sum up to zero are not allowed
+    EmptyTreasuryWithdrawals
   deriving (Eq, Show, Generic)
 
 type instance EraRuleFailure "GOV" (ConwayEra c) = ConwayGovPredFailure (ConwayEra c)
@@ -222,6 +224,7 @@ instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where
     12 -> SumD DisallowedProposalDuringBootstrap <! From
     13 -> SumD DisallowedVotesDuringBootstrap <! From
     14 -> SumD VotersDoNotExist <! From
+    15 -> SumD EmptyTreasuryWithdrawals
     k -> Invalid k
 
 instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
@@ -260,6 +263,8 @@ instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
         Sum DisallowedVotesDuringBootstrap 13 !> To votes
       VotersDoNotExist voters ->
         Sum VotersDoNotExist 14 !> To voters
+      EmptyTreasuryWithdrawals ->
+        Sum EmptyTreasuryWithdrawals 15
 
 instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where
   toCBOR = toEraCBOR @era
@@ -461,6 +466,9 @@ govTransition = do
 
                   -- Policy check
                   runTest $ checkPolicy @era constitutionPolicy proposalPolicy
+
+                  -- The sum of all withdrawals must be positive
+                  mconcat (Map.elems wdrls) /= mempty ?! EmptyTreasuryWithdrawals
           UpdateCommittee _mPrevGovActionId membersToRemove membersToAdd _qrm -> do
             checkConflictingUpdate
             checkExpirationEpoch

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs

@@ -148,6 +148,7 @@ treasuryWithdrawalsSpec =
     it "Withdrawals exceeding treasury submitted in several proposals within the same epoch" $ do
       committeeCs <- registerInitialCommittee
       (drepC, _, _) <- setupSingleDRep 1_000_000
+      donateToTreasury $ Coin 5_000_000
       initialTreasury <- getTreasury
       numWithdrawals <- choose (1, 10)
       withdrawals <- genWithdrawalsExceeding initialTreasury numWithdrawals

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs

@@ -33,6 +33,7 @@ import Cardano.Ledger.Shelley.Scripts (
 import Cardano.Ledger.Val (zero, (<->))
 import Data.Default.Class (Default (..))
 import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
 import qualified Data.OMap.Strict as OMap
@@ -57,7 +58,7 @@ spec = do
   proposalsWithVotingSpec
   votingSpec
   policySpec
-  networkIdWithdrawalsSpec
+  withdrawalsSpec
   predicateFailuresSpec
   unknownCostModelsSpec
 
@@ -489,7 +490,16 @@ proposalsWithVotingSpec =
       returnAddr <- registerRewardAccount
       deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL
       ens <- getEnactState
-      withdrawals <- arbitrary
+      withdrawals <- do
+        accounts <- arbitrary :: ImpTestM era (NonEmpty (RewardAccount (EraCrypto era)))
+        pairs <-
+          traverse
+            ( \ac -> do
+                Positive n <- arbitrary
+                pure (ac, Coin n)
+            )
+            accounts
+        pure $ Map.fromList (NE.toList pairs)
       let
         mkProp name action = do
           ProposalProcedure
@@ -1133,14 +1143,14 @@ networkIdSpec =
               Testnet
         ]
 
-networkIdWithdrawalsSpec ::
+withdrawalsSpec ::
   forall era.
   ( ConwayEraImp era
   , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
   ) =>
   SpecWith (ImpTestState era)
-networkIdWithdrawalsSpec =
-  describe "Network ID" $ do
+withdrawalsSpec =
+  describe "Withdrawals" $ do
     it "Fails with invalid network ID in withdrawal addresses" $ do
       rewardAccount <- registerRewardAccount
       rewardCredential <- KeyHashObj <$> freshKeyHash
@@ -1166,6 +1176,28 @@ networkIdWithdrawalsSpec =
               Testnet
         ]
 
+    it "Fails for empty withdrawals" $ do
+      rwdAccount1 <- KeyHashObj <$> freshKeyHash >>= getRewardAccountFor
+      rwdAccount2 <- KeyHashObj <$> freshKeyHash >>= getRewardAccountFor
+      submitFailingGovAction
+        (TreasuryWithdrawals Map.empty SNothing)
+        [injectFailure $ EmptyTreasuryWithdrawals]
+
+      submitFailingGovAction
+        (TreasuryWithdrawals [(rwdAccount1, zero)] SNothing)
+        [injectFailure $ EmptyTreasuryWithdrawals]
+
+      submitFailingGovAction
+        (TreasuryWithdrawals [(rwdAccount1, zero), (rwdAccount2, zero)] SNothing)
+        [injectFailure $ EmptyTreasuryWithdrawals]
+
+      rwdAccountRegistered <- registerRewardAccount
+      submitFailingGovAction
+        (TreasuryWithdrawals [(rwdAccountRegistered, zero)] SNothing)
+        [injectFailure $ EmptyTreasuryWithdrawals]
+
+      void $ submitTreasuryWithdrawals [(rwdAccount1, zero), (rwdAccount2, Coin 100000)]
+
 proposalWithRewardAccount ::
   forall era.
   ConwayEraImp era =>

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs

@@ -807,6 +807,8 @@ votingSpec =
         it "AlwaysAbstain" $ do
           let getTreasury = getsNES (nesEsL . esAccountStateL . asTreasuryL)
 
+          donateToTreasury $ Coin 5_000_000
+
           (drep1, comMember, _) <- electBasicCommittee
           initialTreasury <- getTreasury
 

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs

@@ -27,6 +27,7 @@ import Lens.Micro
 
 import Constrained
 
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway (ConwayEra)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Crypto (StandardCrypto)
@@ -344,6 +345,7 @@ wfGovAction GovEnv {gePPolicy, geEpoch, gePParams} ps govAction =
     ( branch $ \withdrawMap policy ->
         [ forAll (dom_ withdrawMap) $ \rewAcnt ->
             match rewAcnt $ \net _ -> net ==. lit Testnet
+        , assert $ sum_ (rng_ withdrawMap) >. (lit (Coin 0))
         , assert $ policy ==. lit gePPolicy
         , assert $ not $ HardForks.bootstrapPhase (gePParams ^. ppProtocolVersionL)
         ]

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs

@@ -1552,6 +1552,7 @@ ppConwayGovPredFailure x = case x of
     ppSexp "DisallowedProposalDuringBootstrap" [pcProposalProcedure p]
   DisallowedVotesDuringBootstrap m -> ppSexp "DisallowedVotesDuringBootstrap" [prettyA m]
   VotersDoNotExist m -> ppSexp "VotersDoNotExist" [prettyA m]
+  EmptyTreasuryWithdrawals -> ppString "EmptyTreasuryWithdrawals"
 
 instance PrettyA (ConwayGovPredFailure era) where
   prettyA = ppConwayGovPredFailure