Add test to check deposits in translation of (un)reg certificates

IntersectMBO · Sep 12, 2024 · 6289cc0 · 6289cc0
1 parent 5f01cf8
commit 6289cc0
Show file tree

Hide file tree

Showing 3 changed files with 70 additions and 0 deletions.
diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal
@@ -195,6 +195,7 @@ test-suite tests
         Test.Cardano.Ledger.Conway.GenesisSpec
         Test.Cardano.Ledger.Conway.GovActionReorderSpec
         Test.Cardano.Ledger.Conway.Plutus.PlutusSpec
+        Test.Cardano.Ledger.Conway.TxInfoSpec
         Paths_cardano_ledger_conway
 
     default-language: Haskell2010
@@ -221,4 +222,5 @@ test-suite tests
         containers,
         data-default-class,
         microlens,
+        plutus-ledger-api,
         testlib
diff --git a/eras/conway/impl/test/Main.hs b/eras/conway/impl/test/Main.hs
@@ -17,6 +17,7 @@ import qualified Test.Cardano.Ledger.Conway.Imp as Imp
 import Test.Cardano.Ledger.Conway.Plutus.PlutusSpec as PlutusSpec
 import qualified Test.Cardano.Ledger.Conway.Proposals as Proposals
 import qualified Test.Cardano.Ledger.Conway.Spec as Spec
+import qualified Test.Cardano.Ledger.Conway.TxInfoSpec as TxInfo
 import Test.Cardano.Ledger.Core.JSON (roundTripJsonEraSpec)
 
 main :: IO ()
@@ -41,3 +42,4 @@ main =
       describe "Plutus" $ do
         PlutusSpec.spec
       Regression.spec @Conway
+      TxInfo.spec
diff --git a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/TxInfoSpec.hs b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/TxInfoSpec.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Cardano.Ledger.Conway.TxInfoSpec (spec) where
+
+import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Conway (Conway)
+import Cardano.Ledger.Conway.Core
+import Cardano.Ledger.Conway.TxCert
+import Cardano.Ledger.Conway.TxInfo
+import Cardano.Ledger.Credential (StakeCredential)
+import qualified PlutusLedgerApi.V2 as PV2
+import qualified PlutusLedgerApi.V3 as PV3
+import Test.Cardano.Ledger.Common
+import Test.Cardano.Ledger.Conway.Genesis ()
+
+spec :: Spec
+spec = do
+  describe "TxInfo" $ do
+    let transV9 = transTxCert @Conway (ProtVer (natVersion @9) 0)
+        transV10 = transTxCert @Conway (ProtVer (natVersion @10) 0)
+
+    prop "Deposit in registration certs" $
+      \(cred :: StakeCredential (EraCrypto Conway))
+       (coin :: Coin) -> do
+          expectNoDeposit $ transV9 $ ConwayTxCertDeleg $ ConwayRegCert cred (SJust coin)
+          expectNoDeposit $ transV9 $ RegDepositTxCert cred coin
+          expectNoDeposit $ transV9 $ ConwayTxCertDeleg $ ConwayRegCert cred SNothing
+
+          expectDeposit coin $ transV10 $ ConwayTxCertDeleg $ ConwayRegCert cred (SJust coin)
+          expectDeposit coin $ transV10 $ RegDepositTxCert cred coin
+          expectNoDeposit $ transV10 $ ConwayTxCertDeleg $ ConwayRegCert cred SNothing
+
+    prop "Deposit in unregistration certs" $
+      \(cred :: StakeCredential (EraCrypto Conway))
+       (coin :: Coin) -> do
+          expectNoDeposit $ transV9 $ ConwayTxCertDeleg $ ConwayUnRegCert cred (SJust coin)
+          expectNoDeposit $ transV9 $ UnRegDepositTxCert cred coin
+          expectNoDeposit $ transV9 $ ConwayTxCertDeleg $ ConwayUnRegCert cred SNothing
+
+          expectDeposit coin $ transV10 $ ConwayTxCertDeleg $ ConwayUnRegCert cred (SJust coin)
+          expectDeposit coin $ transV10 $ UnRegDepositTxCert cred coin
+          expectNoDeposit $ transV10 $ ConwayTxCertDeleg $ ConwayUnRegCert cred SNothing
+  where
+    expectDeposit :: Coin -> PV3.TxCert -> IO ()
+    expectDeposit (Coin c) =
+      \case
+        PV3.TxCertRegStaking _ (Just d) -> PV2.Lovelace c `shouldBe` d
+        PV3.TxCertUnRegStaking _ (Just d) -> PV2.Lovelace c `shouldBe` d
+        txcert ->
+          expectationFailure $
+            "Deposit: " <> show (Coin c) <> " expected in: " <> show txcert <> ", but not found"
+    expectNoDeposit :: PV3.TxCert -> IO ()
+    expectNoDeposit =
+      \case
+        PV3.TxCertRegStaking _ Nothing -> pure ()
+        PV3.TxCertUnRegStaking _ Nothing -> pure ()
+        txcert ->
+          expectationFailure $
+            "Deposit not expected, but found in: " <> show txcert