Add Imp test to check that SPO votes are validated against tx witnesses (#5521)

* Enable Utxow tests in conformance

* Add Imp test to check SPO vote against tx witnesses

* Update formal spec

Author: carlostome

cabal.project

@@ -16,7 +16,7 @@ source-repository-package
   subdir: hs
   -- !WARNING!:
   -- MAKE SURE THIS POINTS TO A COMMIT IN `*-artifacts` BEFORE MERGE!
-  tag: 9291fe30190180631e79589c506a062e95123961
+  tag: 3da1ceec493ade9bc6347e342ca51054cc166e78
 
 source-repository-package
   type: git

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

@@ -34,11 +34,17 @@ import Cardano.Ledger.Conway.Core (
   ppCoinsPerUTxOByteL,
   txIdTx,
  )
+import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Conway.Rules (ConwayUtxowPredFailure (..))
+import Cardano.Ledger.Conway.TxBody
 import Cardano.Ledger.Credential (Credential (..), StakeReference)
+import Cardano.Ledger.Keys (asWitness, witVKeyHash)
 import Cardano.Ledger.Plutus (Language (..), SLanguage (..), hashPlutusScript)
 import Cardano.Ledger.TxIn (TxIn (..))
-import Lens.Micro ((&), (.~), (^.))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Set.NonEmpty as NES
+import Lens.Micro ((%~), (&), (.~), (^.))
 import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsWithDatum)
@@ -48,7 +54,9 @@ spec ::
   ConwayEraImp era =>
   SpecWith (ImpInit (LedgerSpec era))
 spec = do
-  it "Fails with PPViewHashesDontMatch before PV 11" . whenMajorVersionAtMost @10 $ do
+  -- https://github.com/IntersectMBO/formal-ledger-specifications/issues/1029
+  -- TODO: Re-enable after issue is resolved, by removing this override
+  disableInConformanceIt "Fails with PPViewHashesDontMatch before PV 11" . whenMajorVersionAtMost @10 $ do
     fixedTx <- fixupTx =<< setupBadPPViewHashTx
     badScriptIntegrityHash <- arbitrary
     tx <- substituteIntegrityHashAndFixWits badScriptIntegrityHash fixedTx
@@ -86,6 +94,35 @@ spec = do
         tx
         [ injectFailure $ ScriptIntegrityHashMismatch mismatch (SJust $ originalBytes scriptIntegrity)
         ]
+  it "Transaction containing SPO vote but no witness for it fails" $ do
+    spoKh <- freshKeyHash
+    registerPool spoKh
+    gaId <- mkProposal InfoAction >>= submitProposal
+    submitVote_ @era VoteYes (StakePoolVoter spoKh) gaId
+    let tx =
+          mkBasicTx mkBasicTxBody
+            & bodyTxL . votingProceduresTxBodyL
+              .~ VotingProcedures
+                ( Map.singleton
+                    (StakePoolVoter spoKh)
+                    ( Map.singleton
+                        gaId
+                        ( VotingProcedure
+                            { vProcVote = VoteYes
+                            , vProcAnchor = SNothing
+                            }
+                        )
+                    )
+                )
+    let isSPOWitness wit = witVKeyHash wit == asWitness spoKh
+    withPostFixup (pure . (witsTxL . addrTxWitsL %~ Set.filter (not . isSPOWitness))) $
+      submitFailingTx
+        tx
+        [ injectFailure $
+            MissingVKeyWitnessesUTXOW $
+              NES.singleton $
+                asWitness spoKh
+        ]
 
 setupBadPPViewHashTx ::
   forall era.

flake.lock

@@ -19,6 +19,7 @@ import Test.Cardano.Ledger.Conway.Imp.LedgerSpec qualified as Ledger
 import Test.Cardano.Ledger.Conway.Imp.RatifySpec qualified as Ratify
 import Test.Cardano.Ledger.Conway.Imp.UtxoSpec qualified as Utxo
 import Test.Cardano.Ledger.Conway.Imp.UtxosSpec qualified as Utxos
+import Test.Cardano.Ledger.Conway.Imp.UtxowSpec qualified as Utxow
 import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Imp.Common hiding (Args)
 import UnliftIO (evaluateDeep)
@@ -46,6 +47,7 @@ spec = do
             describe "LEDGER" Ledger.spec
             describe "RATIFY" Ratify.spec
             describe "UTXO" Utxo.spec
+            describe "UTXOW" Utxow.spec
             xdescribe "UTXOS" Utxos.spec
   describe "Imp (only spec)" $ do
     RatifySpec.spec