From 4476caf1bf6db9b18d5bc6381149bf1b2fd3a372 Mon Sep 17 00:00:00 2001
From: Lucsanszky <daniel.lucsanszky@iohk.io>
Date: Mon, 7 Oct 2024 21:12:36 +0200
Subject: [PATCH] Fix `txCertKey` to check for delegatee key as well

Until now we discarded the delegatee cases. This led to the
generation of signals where a delegatee key was already unregistered
in the same signal, resulting in a `DelegateeDRepNotRegisteredDELEG`
or a `DelegateeStakePoolNotRegisteredDELEG` failure.
---
 .../Ledger/Constrained/Conway/Certs.hs        | 43 ++++++++++++-------
 .../Constrained/Conway/LedgerTypes/Specs.hs   |  6 ++-
 2 files changed, 33 insertions(+), 16 deletions(-)

diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Certs.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Certs.hs
index 6e3cfbccb0a..c1f15c2dfff 100644
--- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Certs.hs
+++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Certs.hs
@@ -147,20 +147,33 @@ data CertKey c
   | ColdKey !(Credential 'ColdCommitteeRole c)
   deriving (Eq, Show, Ord)
 
--- | Compute the aggregate key type of a Certificater
-txCertKey :: ConwayTxCert era -> CertKey (EraCrypto era)
-txCertKey (ConwayTxCertDeleg (ConwayRegCert x _)) = StakeKey x
-txCertKey (ConwayTxCertDeleg (ConwayUnRegCert x _)) = StakeKey x
-txCertKey (ConwayTxCertDeleg (ConwayDelegCert x _)) = StakeKey x
-txCertKey (ConwayTxCertDeleg (ConwayRegDelegCert x _ _)) = StakeKey x
-txCertKey (ConwayTxCertPool (RegPool x)) = PoolKey (ppId x)
-txCertKey (ConwayTxCertPool (RetirePool x _)) = PoolKey x
-txCertKey (ConwayTxCertGov (ConwayRegDRep x _ _)) = DRepKey x
-txCertKey (ConwayTxCertGov (ConwayUnRegDRep x _)) = DRepKey x
-txCertKey (ConwayTxCertGov (ConwayUpdateDRep x _)) = DRepKey x
-txCertKey (ConwayTxCertGov (ConwayAuthCommitteeHotKey x _)) = ColdKey x
-txCertKey (ConwayTxCertGov (ConwayResignCommitteeColdKey x _)) = ColdKey x
-
 noSameKeys :: [ConwayTxCert era] -> [ConwayTxCert era]
 noSameKeys [] = []
-noSameKeys (x : xs) = x : noSameKeys (filter (\y -> txCertKey x /= txCertKey y) xs)
+noSameKeys (cert : certs) = cert : noSameKeys (filter (check cert) certs)
+  where
+    check :: ConwayTxCert era -> ConwayTxCert era -> Bool
+    check x y@(ConwayTxCertDeleg (ConwayDelegCert a b)) =
+      txCertKey x /= txCertKey y && txCertKey x /= txCertDelegateeKey a b
+    check x y@(ConwayTxCertDeleg (ConwayRegDelegCert a b _)) =
+      txCertKey x /= txCertKey y && txCertKey x /= txCertDelegateeKey a b
+    check x y = txCertKey x /= txCertKey y
+
+    -- \| Compute the aggregate key type of a Certificater
+    txCertKey :: ConwayTxCert era -> CertKey (EraCrypto era)
+    txCertKey (ConwayTxCertDeleg (ConwayRegCert x _)) = StakeKey x
+    txCertKey (ConwayTxCertDeleg (ConwayUnRegCert x _)) = StakeKey x
+    txCertKey (ConwayTxCertDeleg (ConwayDelegCert x _)) = StakeKey x
+    txCertKey (ConwayTxCertDeleg (ConwayRegDelegCert x _ _)) = StakeKey x
+    txCertKey (ConwayTxCertPool (RegPool x)) = PoolKey (ppId x)
+    txCertKey (ConwayTxCertPool (RetirePool x _)) = PoolKey x
+    txCertKey (ConwayTxCertGov (ConwayRegDRep x _ _)) = DRepKey x
+    txCertKey (ConwayTxCertGov (ConwayUnRegDRep x _)) = DRepKey x
+    txCertKey (ConwayTxCertGov (ConwayUpdateDRep x _)) = DRepKey x
+    txCertKey (ConwayTxCertGov (ConwayAuthCommitteeHotKey x _)) = ColdKey x
+    txCertKey (ConwayTxCertGov (ConwayResignCommitteeColdKey x _)) = ColdKey x
+
+    txCertDelegateeKey :: Credential 'Staking c -> Delegatee c -> CertKey c
+    txCertDelegateeKey _ (DelegStakeVote _ (DRepCredential y)) = DRepKey y
+    txCertDelegateeKey _ (DelegVote (DRepCredential y)) = DRepKey y
+    txCertDelegateeKey _ (DelegStake y) = PoolKey y
+    txCertDelegateeKey x _ = StakeKey x
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/Specs.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/Specs.hs
index 914e24616d1..159eeb77cc0 100644
--- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/Specs.hs
+++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/Specs.hs
@@ -383,7 +383,11 @@ dstateSpec acct poolreg dreps = constrained $ \ [var| ds |] ->
       , assertExplain (pure "The delegations delegate to actual pools") $
           forAll (rng_ sPoolMap) (\ [var|keyhash|] -> member_ keyhash (dom_ poolreg))
       , assertExplain (pure "dom sPoolMap is a subset of dom rdMap") $ dom_ sPoolMap `subset_` dom_ rdMap
-      , forAll' dreps $
+      , -- NOTE: Consider if this assertion and the `dependsOn` check below it can be removed.
+        -- Commit `21215b03a - Add delegations field to the DRep state` added a TODO
+        -- to add a constraint that delegs are in the UMap. The below does that but it wasn't
+        -- the cause for the conformance test failures.
+        forAll' dreps $
           \_ dRepState -> match dRepState $ \_ _ _ delegs ->
             assertExplain
               (pure "Delegs are present in the UMap")