{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Shelley.Imp.LedgerSpec (
  spec,
) where

import Cardano.Ledger.BaseTypes (inject)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.UTxO (UTxO (..))
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Lens.Micro ((&), (.~), (^.))
import Test.Cardano.Ledger.Core.Utils (txInAt)
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Shelley.ImpTest

spec ::
  forall era.
  ShelleyEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
ShelleyEraImp era =>
SpecWith (ImpInit (LedgerSpec era))
spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"LEDGER" forall a b. (a -> b) -> a -> b
$ do
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Transactions update UTxO" forall a b. (a -> b) -> a -> b
$ do
    Addr
addr1 <- forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m Addr
freshKeyAddr_
    let coin1 :: Coin
coin1 = Integer -> Coin
Coin Integer
2000000
    Tx era
tx1 <-
      forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era (Tx era)
submitTxAnn String
"First transaction" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
        forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL @era
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton
              (forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr1 forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject Coin
coin1)
    UTxO Map TxIn (TxOut era)
utxo1 <- forall era. ImpTestM era (UTxO era)
getUTxO
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall i era.
(HasCallStack, Integral i, EraTx era) =>
i -> Tx era -> TxIn
txInAt (Int
0 :: Int) Tx era
tx1) Map TxIn (TxOut era)
utxo1 of
      Just TxOut era
out1 -> TxOut era
out1 forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
coin1
      Maybe (TxOut era)
Nothing -> forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
expectationFailure String
"Could not find the TxOut of the first transaction"
    Addr
addr2 <- forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m Addr
freshKeyAddr_
    let coin2 :: Coin
coin2 = Integer -> Coin
Coin Integer
3000000
    Tx era
tx2 <-
      forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era (Tx era)
submitTxAnn String
"Second transaction" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
        forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Set a
Set.singleton
              (forall i era.
(HasCallStack, Integral i, EraTx era) =>
i -> Tx era -> TxIn
txInAt (Int
0 :: Int) Tx era
tx1)
          forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL @era
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr2 forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject Coin
coin2)
    UTxO Map TxIn (TxOut era)
utxo2 <- forall era. ImpTestM era (UTxO era)
getUTxO
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall i era.
(HasCallStack, Integral i, EraTx era) =>
i -> Tx era -> TxIn
txInAt (Int
0 :: Int) Tx era
tx2) Map TxIn (TxOut era)
utxo2 of
      Just TxOut era
out1 -> do
        TxOut era
out1 forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
coin2
      Maybe (TxOut era)
Nothing -> forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
expectationFailure String
"Could not find the TxOut of the second transaction"