From 68ecc2a48ebd808b243761df4dd2d27304bfc645 Mon Sep 17 00:00:00 2001
From: Neil Mayhew <neil.mayhew@iohk.io>
Date: Wed, 16 Oct 2024 16:19:23 -0600
Subject: [PATCH] Implement some of the tests in Alonzo.Imp.UtxowSpec.Valid

---
 eras/alonzo/impl/cardano-ledger-alonzo.cabal  |   2 +-
 .../Ledger/Alonzo/Imp/UtxowSpec/Valid.hs      | 104 +++++++++++++-----
 2 files changed, 78 insertions(+), 28 deletions(-)

diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal
index 8d992c7d5a0..9585cc13397 100644
--- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal
+++ b/eras/alonzo/impl/cardano-ledger-alonzo.cabal
@@ -84,7 +84,7 @@ library
         cardano-ledger-binary ^>=1.4,
         cardano-ledger-core ^>=1.15,
         cardano-ledger-mary ^>=1.7,
-        cardano-ledger-shelley >=1.14 && <1.15,
+        cardano-ledger-shelley ^>=1.15,
         cardano-slotting,
         cardano-strict-containers,
         containers,
diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs
index 73c846e52b8..0f4fccd567f 100644
--- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs
+++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs
@@ -1,36 +1,86 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Valid (spec) where
 
-import Test.Cardano.Ledger.Alonzo.ImpTest (ImpTestState)
+import Cardano.Ledger.Alonzo.Core
+import Cardano.Ledger.Alonzo.Rules (
+  AlonzoUtxosPredFailure,
+ )
+import Cardano.Ledger.Alonzo.Scripts (eraLanguages)
+import Cardano.Ledger.Credential (Credential (..))
+import Cardano.Ledger.Plutus (
+  hashPlutusScript,
+  withSLanguage,
+ )
+import Control.Monad ((<=<))
+import Lens.Micro ((&), (.~))
+import Test.Cardano.Ledger.Alonzo.ImpTest
 import Test.Cardano.Ledger.Imp.Common
+import Test.Cardano.Ledger.Plutus.Examples
 
 spec ::
   forall era.
+  ( AlonzoEraImp era
+  , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
+  ) =>
   SpecWith (ImpTestState era)
-spec = do
-  describe "Valid transactions" $ do
-    it "Validating SPEND script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Not validating SPEND script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Validating CERT script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Not validating CERT script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Validating WITHDRAWAL script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Not validating WITHDRAWAL script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Validating MINT script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Not validating MINT script" $ do
-      const $ pendingWith "not implemented yet"
-    it "Validating scripts everywhere" $ do
-      const $ pendingWith "not implemented yet"
-    it "Acceptable supplimentary datum" $ do
-      const $ pendingWith "not implemented yet"
-    it "Multiple identical certificates" $ do
-      const $ pendingWith "not implemented yet"
-    it "Non-script output with datum" $ do
-      const $ pendingWith "not implemented yet"
+spec = describe "Valid transactions" $ do
+  forM_ (eraLanguages @era) $ \lang ->
+    withSLanguage lang $ \slang ->
+      describe (show lang) $ do
+        let
+          alwaysSucceedsWithDatumHash = hashPlutusScript $ alwaysSucceedsWithDatum slang :: ScriptHash (EraCrypto era)
+          alwaysSucceedsNoDatumHash = hashPlutusScript $ alwaysSucceedsNoDatum slang :: ScriptHash (EraCrypto era)
+          alwaysFailsWithDatumHash = hashPlutusScript $ alwaysFailsWithDatum slang :: ScriptHash (EraCrypto era)
+
+        it "Validating SPEND script" $ do
+          txIn <- produceScript alwaysSucceedsWithDatumHash
+          expectTxSuccess <=< submitTx $
+            mkBasicTx $
+              mkBasicTxBody & inputsTxBodyL .~ [txIn]
+
+        it "Not validating SPEND script" $ do
+          txIn <- produceScript alwaysFailsWithDatumHash
+          expectTxSuccess <=< submitPhase2Invalid $
+            mkBasicTx $
+              mkBasicTxBody & inputsTxBodyL .~ [txIn]
+
+        it "Validating CERT script" $ do
+          txIn <- produceScript alwaysSucceedsWithDatumHash
+          let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash
+          expectTxSuccess <=< submitTx $
+            mkBasicTx $
+              mkBasicTxBody
+                & inputsTxBodyL .~ [txIn]
+                & certsTxBodyL .~ [txCert]
+
+        it "Not validating CERT script" $ do
+          txIn <- produceScript alwaysFailsWithDatumHash
+          let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash
+          expectTxSuccess <=< submitPhase2Invalid $
+            mkBasicTx $
+              mkBasicTxBody
+                & inputsTxBodyL .~ [txIn]
+                & certsTxBodyL .~ [txCert]
+
+  it "Validating WITHDRAWAL script" $ do
+    const $ pendingWith "not implemented yet"
+  it "Not validating WITHDRAWAL script" $ do
+    const $ pendingWith "not implemented yet"
+  it "Validating MINT script" $ do
+    const $ pendingWith "not implemented yet"
+  it "Not validating MINT script" $ do
+    const $ pendingWith "not implemented yet"
+  it "Validating scripts everywhere" $ do
+    const $ pendingWith "not implemented yet"
+  it "Acceptable supplimentary datum" $ do
+    const $ pendingWith "not implemented yet"
+  it "Multiple identical certificates" $ do
+    const $ pendingWith "not implemented yet"
+  it "Non-script output with datum" $ do
+    const $ pendingWith "not implemented yet"