{-# 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.Alonzo.Plutus.Context (toPlutusTxCert)
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.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.Genesis ()

spec :: Spec
spec :: Spec
spec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxInfo" forall a b. (a -> b) -> a -> b
$ do
    let trans :: ProtVer -> ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
trans ProtVer
pv ConwayTxCert (ConwayEra StandardCrypto)
cert = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) 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 @Conway forall {k} (t :: k). Proxy t
Proxy ProtVer
pv ConwayTxCert (ConwayEra StandardCrypto)
cert)
        transV9 :: ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 = ProtVer -> ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
trans (Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) Natural
0)
        transV10 :: ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 = ProtVer -> ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
trans (Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @10) Natural
0)

    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Deposit in registration certs" forall a b. (a -> b) -> a -> b
$
      \(StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred :: StakeCredential (EraCrypto Conway))
       (Coin
coin :: Coin) -> do
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred (forall a. a -> StrictMaybe a
SJust Coin
coin)
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era) -> Coin -> TxCert era
RegDepositTxCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred Coin
coin
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred forall a. StrictMaybe a
SNothing

          Coin -> TxCert -> IO ()
expectDeposit Coin
coin forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred (forall a. a -> StrictMaybe a
SJust Coin
coin)
          Coin -> TxCert -> IO ()
expectDeposit Coin
coin forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era) -> Coin -> TxCert era
RegDepositTxCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred Coin
coin
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred forall a. StrictMaybe a
SNothing

    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Deposit in unregistration certs" forall a b. (a -> b) -> a -> b
$
      \(StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred :: StakeCredential (EraCrypto Conway))
       (Coin
coin :: Coin) -> do
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayUnRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred (forall a. a -> StrictMaybe a
SJust Coin
coin)
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era) -> Coin -> TxCert era
UnRegDepositTxCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred Coin
coin
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV9 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayUnRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred forall a. StrictMaybe a
SNothing

          Coin -> TxCert -> IO ()
expectDeposit Coin
coin forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayUnRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred (forall a. a -> StrictMaybe a
SJust Coin
coin)
          Coin -> TxCert -> IO ()
expectDeposit Coin
coin forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era) -> Coin -> TxCert era
UnRegDepositTxCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred Coin
coin
          TxCert -> IO ()
expectNoDeposit forall a b. (a -> b) -> a -> b
$ ConwayTxCert (ConwayEra StandardCrypto) -> TxCert
transV10 forall a b. (a -> b) -> a -> b
$ forall era. ConwayDelegCert (EraCrypto era) -> ConwayTxCert era
ConwayTxCertDeleg forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> StrictMaybe Coin -> ConwayDelegCert c
ConwayUnRegCert StakeCredential (EraCrypto (ConwayEra StandardCrypto))
cred 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 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 forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Lovelace
d
        TxCert
txcert ->
          HasCallStack => String -> IO ()
expectationFailure forall a b. (a -> b) -> a -> b
$
            String
"Deposit: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Integer -> Coin
Coin Integer
c) forall a. Semigroup a => a -> a -> a
<> String
" expected in: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TxCert
txcert 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        PV3.TxCertUnRegStaking Credential
_ Maybe Lovelace
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        TxCert
txcert ->
          HasCallStack => String -> IO ()
expectationFailure forall a b. (a -> b) -> a -> b
$
            String
"Deposit not expected, but found in: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TxCert
txcert