{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Shelley.Examples.Chain (
  CHAINExample (..),
  testCHAINExample,
) where

import Cardano.Ledger.Block (Block)
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses, nesPdL)
import Cardano.Ledger.State
import Cardano.Protocol.TPraos.BlockHeader (BHeader)
import Control.State.Transition.Extended hiding (Assertion)
import Data.Default (def)
import Data.List.NonEmpty (NonEmpty)
import GHC.Stack
import Lens.Micro
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Rules.Chain (CHAIN, ChainState, chainStateNesL, totalAda)
import Test.Cardano.Ledger.Shelley.TreeDiff (expectExprEqual)
import Test.Cardano.Ledger.Shelley.Utils (applySTSTest, maxLLSupply, runShelleyBase)
import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->>))
import Test.Tasty.HUnit (Assertion, (@?=))

data CHAINExample era = CHAINExample
  { forall era. CHAINExample era -> ChainState era
startState :: ChainState era
  -- ^ State to start testing with
  , forall era. CHAINExample era -> Block (BHeader MockCrypto) era
newBlock :: Block (BHeader MockCrypto) era
  -- ^ Block to run chain state transition system on
  , forall era.
CHAINExample era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
intendedResult :: Either (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
  -- ^ type of fatal error, if failure expected and final chain state if success expected
  }

deriving instance
  ( EraGov era
  , EraTxOut era
  , Show (BlockBody era)
  , Show (CertState era)
  , Show (InstantStake era)
  , Show (StashedAVVMAddresses era)
  , Show (PredicateFailure (EraRule "BBODY" era))
  , Show (PredicateFailure (EraRule "TICK" era))
  , Show (PredicateFailure (EraRule "TICKN" era))
  ) =>
  Show (CHAINExample era)

-- | Runs example, applies chain state transition system rule (STS),
--   and checks that trace ends with expected state or expected error.
testCHAINExample :: HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample :: HasCallStack => CHAINExample ShelleyEra -> Assertion
testCHAINExample (CHAINExample ChainState ShelleyEra
initSt Block (BHeader MockCrypto) ShelleyEra
block (Right ChainState ShelleyEra
expectedSt)) = do
  forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @(CHAIN ShelleyEra)
    ShelleyBase a -> a
forall a. ShelleyBase a -> a
runShelleyBase
    ()
    ( (ChainState ShelleyEra
-> ReaderT
     (ChainState ShelleyEra
      -> Block (BHeader MockCrypto) ShelleyEra
      -> Either
           (NonEmpty (TestChainPredicateFailure ShelleyEra))
           (ChainState ShelleyEra))
     IO
     (ChainState ShelleyEra)
forall a.
a
-> ReaderT
     (ChainState ShelleyEra
      -> Block (BHeader MockCrypto) ShelleyEra
      -> Either
           (NonEmpty (TestChainPredicateFailure ShelleyEra))
           (ChainState ShelleyEra))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainState ShelleyEra
initSt ReaderT
  (ChainState ShelleyEra
   -> Block (BHeader MockCrypto) ShelleyEra
   -> Either
        (NonEmpty (TestChainPredicateFailure ShelleyEra))
        (ChainState ShelleyEra))
  IO
  (ChainState ShelleyEra)
-> Block (BHeader MockCrypto) ShelleyEra
-> ReaderT
     (ChainState ShelleyEra
      -> Block (BHeader MockCrypto) ShelleyEra
      -> Either
           (NonEmpty (TestChainPredicateFailure ShelleyEra))
           (ChainState ShelleyEra))
     IO
     (ChainState ShelleyEra)
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- Block (BHeader MockCrypto) ShelleyEra
block ReaderT
  (ChainState ShelleyEra
   -> Block (BHeader MockCrypto) ShelleyEra
   -> Either
        (NonEmpty (TestChainPredicateFailure ShelleyEra))
        (ChainState ShelleyEra))
  IO
  (ChainState ShelleyEra)
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ReaderT
     (ChainState ShelleyEra
      -> Block (BHeader MockCrypto) ShelleyEra
      -> Either
           (NonEmpty (TestChainPredicateFailure ShelleyEra))
           (ChainState ShelleyEra))
     IO
     (ChainState ShelleyEra)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra))
-> ChainState ShelleyEra -> Identity (ChainState ShelleyEra)
forall era (f :: * -> *).
Functor f =>
(NewEpochState era -> f (NewEpochState era))
-> ChainState era -> f (ChainState era)
chainStateNesL ((NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra))
 -> ChainState ShelleyEra -> Identity (ChainState ShelleyEra))
-> ((PoolDistr -> Identity PoolDistr)
    -> NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra))
-> (PoolDistr -> Identity PoolDistr)
-> ChainState ShelleyEra
-> Identity (ChainState ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolDistr -> Identity PoolDistr)
-> NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra)
forall era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> NewEpochState era -> f (NewEpochState era)
nesPdL ((PoolDistr -> Identity PoolDistr)
 -> ChainState ShelleyEra -> Identity (ChainState ShelleyEra))
-> PoolDistr -> ChainState ShelleyEra -> ChainState ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolDistr
forall a. Default a => a
def)
        ReaderT
  (ChainState ShelleyEra
   -> Block (BHeader MockCrypto) ShelleyEra
   -> Either
        (NonEmpty (TestChainPredicateFailure ShelleyEra))
        (ChainState ShelleyEra))
  IO
  (ChainState ShelleyEra)
-> ChainState ShelleyEra
-> ReaderT
     (ChainState ShelleyEra
      -> Block (BHeader MockCrypto) ShelleyEra
      -> Either
           (NonEmpty (TestChainPredicateFailure ShelleyEra))
           (ChainState ShelleyEra))
     IO
     (ChainState ShelleyEra)
forall (m :: * -> *) st.
(MonadIO m, Eq st, ToExpr st, HasCallStack) =>
m st -> st -> m st
.->> (ChainState ShelleyEra
expectedSt ChainState ShelleyEra
-> (ChainState ShelleyEra -> ChainState ShelleyEra)
-> ChainState ShelleyEra
forall a b. a -> (a -> b) -> b
& (NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra))
-> ChainState ShelleyEra -> Identity (ChainState ShelleyEra)
forall era (f :: * -> *).
Functor f =>
(NewEpochState era -> f (NewEpochState era))
-> ChainState era -> f (ChainState era)
chainStateNesL ((NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra))
 -> ChainState ShelleyEra -> Identity (ChainState ShelleyEra))
-> ((PoolDistr -> Identity PoolDistr)
    -> NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra))
-> (PoolDistr -> Identity PoolDistr)
-> ChainState ShelleyEra
-> Identity (ChainState ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolDistr -> Identity PoolDistr)
-> NewEpochState ShelleyEra -> Identity (NewEpochState ShelleyEra)
forall era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> NewEpochState era -> f (NewEpochState era)
nesPdL ((PoolDistr -> Identity PoolDistr)
 -> ChainState ShelleyEra -> Identity (ChainState ShelleyEra))
-> PoolDistr -> ChainState ShelleyEra -> ChainState ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolDistr
forall a. Default a => a
def)
    )
    Assertion -> Assertion -> Assertion
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coin -> Coin -> Assertion
forall a. (Eq a, ToExpr a) => a -> a -> Assertion
expectExprEqual (ChainState ShelleyEra -> Coin
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
ChainState era -> Coin
totalAda ChainState ShelleyEra
expectedSt) Coin
maxLLSupply
testCHAINExample (CHAINExample ChainState ShelleyEra
initSt Block (BHeader MockCrypto) ShelleyEra
block predicateFailure :: Either
  (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
  (ChainState ShelleyEra)
predicateFailure@(Left NonEmpty (PredicateFailure (CHAIN ShelleyEra))
_)) = do
  let st :: Either
  (NonEmpty (TestChainPredicateFailure ShelleyEra))
  (ChainState ShelleyEra)
st = ShelleyBase
  (Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra))
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (Either
      (NonEmpty (TestChainPredicateFailure ShelleyEra))
      (ChainState ShelleyEra))
 -> Either
      (NonEmpty (TestChainPredicateFailure ShelleyEra))
      (ChainState ShelleyEra))
-> ShelleyBase
     (Either
        (NonEmpty (TestChainPredicateFailure ShelleyEra))
        (ChainState ShelleyEra))
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTSTest @(CHAIN ShelleyEra) ((Environment (CHAIN ShelleyEra), State (CHAIN ShelleyEra),
 Signal (CHAIN ShelleyEra))
-> TRC (CHAIN ShelleyEra)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), State (CHAIN ShelleyEra)
ChainState ShelleyEra
initSt, Block (BHeader MockCrypto) ShelleyEra
Signal (CHAIN ShelleyEra)
block))
  Either
  (NonEmpty (TestChainPredicateFailure ShelleyEra))
  (ChainState ShelleyEra)
st Either
  (NonEmpty (TestChainPredicateFailure ShelleyEra))
  (ChainState ShelleyEra)
-> Either
     (NonEmpty (TestChainPredicateFailure ShelleyEra))
     (ChainState ShelleyEra)
-> Assertion
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Assertion
@?= Either
  (NonEmpty (PredicateFailure (CHAIN ShelleyEra)))
  (ChainState ShelleyEra)
Either
  (NonEmpty (TestChainPredicateFailure ShelleyEra))
  (ChainState ShelleyEra)
predicateFailure