{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Test.Cardano.Ledger.Conway.TxInfoSpec (spec) where import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo, toPlutusTxCert) import Cardano.Ledger.BaseTypes import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.TxCert import Cardano.Ledger.Credential (StakeCredential) import Cardano.Ledger.Plutus.Language (Language (..)) import Data.Proxy (Proxy (..)) import qualified PlutusLedgerApi.V2 as PV2 import qualified PlutusLedgerApi.V3 as PV3 import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Conway.Era (ConwayEraTest) import Test.Cardano.Ledger.Conway.Genesis () spec :: forall era. ( ConwayEraTest era , EraPlutusTxInfo PlutusV3 era , TxCert era ~ ConwayTxCert era ) => Spec spec :: forall era. (ConwayEraTest era, EraPlutusTxInfo 'PlutusV3 era, TxCert era ~ ConwayTxCert era) => Spec spec = do String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "TxInfo" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ do let trans :: ProtVer -> TxCert era -> TxCert trans ProtVer pv TxCert era cert = (ContextError era -> TxCert) -> (TxCert -> TxCert) -> Either (ContextError era) TxCert -> TxCert forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (String -> TxCert forall a. HasCallStack => String -> a error (String -> TxCert) -> (ContextError era -> String) -> ContextError era -> TxCert forall b c a. (b -> c) -> (a -> b) -> a -> c . ContextError era -> String forall a. Show a => a -> String show) TxCert -> TxCert forall a. a -> a id (forall (l :: Language) era (proxy :: Language -> *). EraPlutusTxInfo l era => proxy l -> ProtVer -> TxCert era -> Either (ContextError era) (PlutusTxCert l) toPlutusTxCert @'PlutusV3 @era Proxy 'PlutusV3 forall {k} (t :: k). Proxy t Proxy ProtVer pv TxCert era cert) transV9 :: TxCert era -> TxCert transV9 = ProtVer -> TxCert era -> TxCert trans (Version -> Nat -> ProtVer ProtVer (forall (v :: Nat). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @9) Nat 0) transV10 :: TxCert era -> TxCert transV10 = ProtVer -> TxCert era -> TxCert trans (Version -> Nat -> ProtVer ProtVer (forall (v :: Nat). (KnownNat v, MinVersion <= v, v <= MaxVersion) => Version natVersion @10) Nat 0) String -> (StakeCredential -> Coin -> IO ()) -> Spec forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Deposit in registration certs" ((StakeCredential -> Coin -> IO ()) -> Spec) -> (StakeCredential -> Coin -> IO ()) -> Spec forall a b. (a -> b) -> a -> b $ \(StakeCredential cred :: StakeCredential) (Coin coin :: Coin) -> do TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV9 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayRegCert StakeCredential cred (Coin -> StrictMaybe Coin forall a. a -> StrictMaybe a SJust Coin coin) TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV9 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ StakeCredential -> Coin -> TxCert era forall era. ConwayEraTxCert era => StakeCredential -> Coin -> TxCert era RegDepositTxCert StakeCredential cred Coin coin TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV9 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayRegCert StakeCredential cred StrictMaybe Coin forall a. StrictMaybe a SNothing Coin -> TxCert -> IO () expectDeposit Coin coin (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV10 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayRegCert StakeCredential cred (Coin -> StrictMaybe Coin forall a. a -> StrictMaybe a SJust Coin coin) Coin -> TxCert -> IO () expectDeposit Coin coin (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV10 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ StakeCredential -> Coin -> TxCert era forall era. ConwayEraTxCert era => StakeCredential -> Coin -> TxCert era RegDepositTxCert StakeCredential cred Coin coin TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV10 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayRegCert StakeCredential cred StrictMaybe Coin forall a. StrictMaybe a SNothing String -> (StakeCredential -> Coin -> IO ()) -> Spec forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "Deposit in unregistration certs" ((StakeCredential -> Coin -> IO ()) -> Spec) -> (StakeCredential -> Coin -> IO ()) -> Spec forall a b. (a -> b) -> a -> b $ \(StakeCredential cred :: StakeCredential) (Coin coin :: Coin) -> do TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV9 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayUnRegCert StakeCredential cred (Coin -> StrictMaybe Coin forall a. a -> StrictMaybe a SJust Coin coin) TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV9 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ StakeCredential -> Coin -> TxCert era forall era. ConwayEraTxCert era => StakeCredential -> Coin -> TxCert era UnRegDepositTxCert StakeCredential cred Coin coin TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV9 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayUnRegCert StakeCredential cred StrictMaybe Coin forall a. StrictMaybe a SNothing Coin -> TxCert -> IO () expectDeposit Coin coin (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV10 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayUnRegCert StakeCredential cred (Coin -> StrictMaybe Coin forall a. a -> StrictMaybe a SJust Coin coin) Coin -> TxCert -> IO () expectDeposit Coin coin (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV10 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ StakeCredential -> Coin -> TxCert era forall era. ConwayEraTxCert era => StakeCredential -> Coin -> TxCert era UnRegDepositTxCert StakeCredential cred Coin coin TxCert -> IO () expectNoDeposit (TxCert -> IO ()) -> TxCert -> IO () forall a b. (a -> b) -> a -> b $ TxCert era -> TxCert transV10 (TxCert era -> TxCert) -> TxCert era -> TxCert forall a b. (a -> b) -> a -> b $ ConwayDelegCert -> ConwayTxCert era forall era. ConwayDelegCert -> ConwayTxCert era ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert era) -> ConwayDelegCert -> ConwayTxCert era forall a b. (a -> b) -> a -> b $ StakeCredential -> StrictMaybe Coin -> ConwayDelegCert ConwayUnRegCert StakeCredential cred StrictMaybe Coin forall a. StrictMaybe a SNothing where expectDeposit :: Coin -> PV3.TxCert -> IO () expectDeposit :: Coin -> TxCert -> IO () expectDeposit (Coin Integer c) = \case PV3.TxCertRegStaking Credential _ (Just Lovelace d) -> Integer -> Lovelace PV2.Lovelace Integer c Lovelace -> Lovelace -> IO () forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` Lovelace d PV3.TxCertUnRegStaking Credential _ (Just Lovelace d) -> Integer -> Lovelace PV2.Lovelace Integer c Lovelace -> Lovelace -> IO () forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO () `shouldBe` Lovelace d TxCert txcert -> HasCallStack => String -> IO () String -> IO () expectationFailure (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "Deposit: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Coin -> String forall a. Show a => a -> String show (Integer -> Coin Coin Integer c) String -> String -> String forall a. Semigroup a => a -> a -> a <> String " expected in: " String -> String -> String forall a. Semigroup a => a -> a -> a <> TxCert -> String forall a. Show a => a -> String show TxCert txcert String -> String -> String forall a. Semigroup a => a -> a -> a <> String ", but not found" expectNoDeposit :: PV3.TxCert -> IO () expectNoDeposit :: TxCert -> IO () expectNoDeposit = \case PV3.TxCertRegStaking Credential _ Maybe Lovelace Nothing -> () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () PV3.TxCertUnRegStaking Credential _ Maybe Lovelace Nothing -> () -> IO () forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure () TxCert txcert -> HasCallStack => String -> IO () String -> IO () expectationFailure (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "Deposit not expected, but found in: " String -> String -> String forall a. Semigroup a => a -> a -> a <> TxCert -> String forall a. Show a => a -> String show TxCert txcert