Merge pull request #5285 from IntersectMBO/jj/testing-plutus-scripts

Added a new test Plutus script

Author: lehins

libs/plutus-preprocessor/src/Cardano/Ledger/Plutus/Preprocessor/Binary/V3.hs

@@ -29,6 +29,7 @@ $datumIsWellformedQ
 $inputsOutputsAreNotEmptyNoDatumQ
 $inputsOutputsAreNotEmptyWithDatumQ
 $inputsOverlapsWithRefInputsQ
+$ensureTreasuryReserveQ
 
 -- ================================================================
 -- Compile and serialize the real functions as Plutus scripts.
@@ -117,3 +118,9 @@ inputsOverlapsWithRefInputsBytes =
   ( inputsOverlapsWithRefInputsQ
   , PlutusBinary $ PV3.serialiseCompiledCode $$(P.compile [||inputsOverlapsWithRefInputs||])
   )
+
+ensureTreasuryReserveBytes :: (Q [Dec], PlutusBinary)
+ensureTreasuryReserveBytes =
+  ( ensureTreasuryReserveQ
+  , PlutusBinary $ PV3.serialiseCompiledCode $$(P.compile [||ensureTreasuryReserve||])
+  )

libs/plutus-preprocessor/src/Cardano/Ledger/Plutus/Preprocessor/Source/V3.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Cardano.Ledger.Plutus.Preprocessor.Source.V3 where
@@ -223,3 +224,25 @@ inputsOverlapsWithRefInputsQ =
               PV3D.txInfoInputs txInfo
           _ -> False
     |]
+
+-- | This ensures that a single TreasuryWithdrawal can't withdraw enough to
+-- make the treasury have less ADA than the specified reserve amount.
+ensureTreasuryReserveQ :: Q [Dec]
+ensureTreasuryReserveQ =
+  [d|
+    ensureTreasuryReserve :: P.BuiltinData -> P.BuiltinUnit
+    ensureTreasuryReserve context =
+      P.check $
+        case unsafeFromBuiltinData context of
+          PV3D.ScriptContext
+            txInfo
+            _
+            (PV3D.ProposingScript _ (PV3D.ProposalProcedure _ _ (PV3D.TreasuryWithdrawals withdrawals _))) ->
+              let
+                totalWithdrawal = PAMD.foldr (P.+) 0 withdrawals
+               in
+                case PV3D.txInfoCurrentTreasuryAmount txInfo of
+                  Just treasury -> treasury P.- totalWithdrawal P.>= 100_000_000
+                  _ -> False
+          _ -> False
+    |]