{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Shelley.Examples.MirTransfer (
  testMIRTransfer,
)
where

import Cardano.Ledger.BaseTypes (Mismatch (..), ProtVer (..), natVersion)
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
import Cardano.Ledger.Keys (
  GenDelegs (..),
  KeyRole (..),
  hashKey,
 )
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API (
  AccountState (..),
  Credential (..),
  DState (..),
  DelegEnv (..),
  InstantaneousRewards (..),
  Ptr (..),
  ShelleyDELEG,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure (..))
import Cardano.Ledger.Slot (SlotNo (..))
import qualified Cardano.Ledger.UMap as UM
import Control.State.Transition.Extended hiding (Assertion)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Lens.Micro
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C_Crypto)
import Test.Cardano.Ledger.Shelley.Utils (
  RawSeed (..),
  applySTSTest,
  epochFromSlotNo,
  mkKeyPair,
  runShelleyBase,
 )
import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->>))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

type ShelleyTest = ShelleyEra C_Crypto

ignoreAllButIRWD ::
  Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest))) (DState ShelleyTest) ->
  Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest))) (InstantaneousRewards C_Crypto)
ignoreAllButIRWD :: Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
  (DState ShelleyTest)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
ignoreAllButIRWD = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall era. DState era -> InstantaneousRewards (EraCrypto era)
dsIRewards

env :: ProtVer -> AccountState -> DelegEnv ShelleyTest
env :: ProtVer -> AccountState -> DelegEnv ShelleyTest
env ProtVer
pv AccountState
acnt =
  DelegEnv
    { slotNo :: SlotNo
slotNo = SlotNo
slot
    , curEpochNo :: EpochNo
curEpochNo = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
    , ptr_ :: Ptr
ptr_ = SlotNo -> TxIx -> CertIx -> Ptr
Ptr SlotNo
slot forall a. Bounded a => a
minBound forall a. Bounded a => a
minBound
    , acnt_ :: AccountState
acnt_ = AccountState
acnt
    , ppDE :: PParams ShelleyTest
ppDE = forall era. EraPParams era => PParams era
emptyPParams forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
pv
    }
  where
    slot :: SlotNo
slot = Word64 -> SlotNo
SlotNo Word64
50

shelleyPV :: ProtVer
shelleyPV :: ProtVer
shelleyPV = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2) Natural
0

alonzoPV :: ProtVer
alonzoPV :: ProtVer
alonzoPV = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @5) Natural
0

testMirTransfer ::
  ProtVer ->
  MIRPot ->
  MIRTarget C_Crypto ->
  InstantaneousRewards C_Crypto ->
  AccountState ->
  Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest))) (InstantaneousRewards C_Crypto) ->
  Assertion
testMirTransfer :: ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer ProtVer
pv MIRPot
pot MIRTarget C_Crypto
target InstantaneousRewards C_Crypto
ir AccountState
acnt (Right InstantaneousRewards C_Crypto
expected) = 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 @(ShelleyDELEG ShelleyTest) forall a. ShelleyBase a -> a
runShelleyBase (ProtVer -> AccountState -> DelegEnv ShelleyTest
env ProtVer
pv AccountState
acnt) forall a b. (a -> b) -> a -> b
$
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall c. InstantaneousRewards c -> DState (ShelleyEra c)
dStateWithRewards InstantaneousRewards C_Crypto
ir)) forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert (EraCrypto era) -> TxCert era
MirTxCert (forall c. MIRPot -> MIRTarget c -> MIRCert c
MIRCert MIRPot
pot MIRTarget C_Crypto
target)) forall (m :: * -> *) st.
(MonadIO m, Eq st, ToExpr st, HasCallStack) =>
m st -> st -> m st
.->> (forall c. InstantaneousRewards c -> DState (ShelleyEra c)
dStateWithRewards InstantaneousRewards C_Crypto
expected)
testMirTransfer ProtVer
pv MIRPot
pot MIRTarget C_Crypto
target InstantaneousRewards C_Crypto
ir AccountState
acnt predicateFailure :: Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
  (InstantaneousRewards C_Crypto)
predicateFailure@(Left NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest))
_) = do
  let st :: Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyTest))
  (DState ShelleyTest)
st =
        forall a. ShelleyBase a -> a
runShelleyBase 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 @(ShelleyDELEG ShelleyTest)
            (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (ProtVer -> AccountState -> DelegEnv ShelleyTest
env ProtVer
pv AccountState
acnt, forall c. InstantaneousRewards c -> DState (ShelleyEra c)
dStateWithRewards InstantaneousRewards C_Crypto
ir, forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert (EraCrypto era) -> TxCert era
MirTxCert (forall c. MIRPot -> MIRTarget c -> MIRCert c
MIRCert MIRPot
pot MIRTarget C_Crypto
target)))
  (Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
  (DState ShelleyTest)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
ignoreAllButIRWD Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyTest))
  (DState ShelleyTest)
st) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
  (InstantaneousRewards C_Crypto)
predicateFailure

dStateWithRewards :: InstantaneousRewards c -> DState (ShelleyEra c)
dStateWithRewards :: forall c. InstantaneousRewards c -> DState (ShelleyEra c)
dStateWithRewards InstantaneousRewards c
ir =
  DState
    { dsUnified :: UMap (EraCrypto (ShelleyEra c))
dsUnified = forall c. UMap c
UM.empty
    , dsFutureGenDelegs :: Map
  (FutureGenDeleg (EraCrypto (ShelleyEra c)))
  (GenDelegPair (EraCrypto (ShelleyEra c)))
dsFutureGenDelegs = forall k a. Map k a
Map.empty
    , dsGenDelegs :: GenDelegs (EraCrypto (ShelleyEra c))
dsGenDelegs = forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs forall k a. Map k a
Map.empty
    , dsIRewards :: InstantaneousRewards (EraCrypto (ShelleyEra c))
dsIRewards = InstantaneousRewards c
ir
    }

alice :: Credential 'Staking C_Crypto
alice :: Credential 'Staking C_Crypto
alice = (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
1)

aliceOnlyReward :: Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward :: Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
c = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking C_Crypto
alice, Integer -> Coin
Coin Integer
c)]

aliceOnlyDelta :: Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta :: Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
c = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking C_Crypto
alice, Integer -> DeltaCoin
DeltaCoin Integer
c)]

bob :: Credential 'Staking C_Crypto
bob :: Credential 'Staking C_Crypto
bob = (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)

bobOnlyReward :: Integer -> Map (Credential 'Staking C_Crypto) Coin
bobOnlyReward :: Integer -> Map (Credential 'Staking C_Crypto) Coin
bobOnlyReward Integer
c = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking C_Crypto
bob, Integer -> Coin
Coin Integer
c)]

bobOnlyDelta :: Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
bobOnlyDelta :: Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
bobOnlyDelta Integer
c = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking C_Crypto
bob, Integer -> DeltaCoin
DeltaCoin Integer
c)]

testMIRTransfer :: TestTree
testMIRTransfer :: TestTree
testMIRTransfer =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"MIR cert transfers"
    [ TestName -> [TestTree] -> TestTree
testGroup
        TestName
"MIR cert embargos"
        [ TestName -> Assertion -> TestTree
testCase TestName
"embargo reserves to treasury transfer" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
ReservesMIR
              (forall c. Coin -> MIRTarget c
SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed)
        , TestName -> Assertion -> TestTree
testCase TestName
"embargo treasury to reserves transfer" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
TreasuryMIR
              (forall c. Coin -> MIRTarget c
SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
1})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed)
        , TestName -> Assertion -> TestTree
testCase TestName
"embargo decrements from reserves" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
ReservesMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed)
        , TestName -> Assertion -> TestTree
testCase TestName
"embargo decrements from treasury" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
TreasuryMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
1})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed)
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"MIR cert alonzo"
        [ TestName -> Assertion -> TestTree
testCase TestName
"increment reserves too much" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
1)
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
ReservesMIR forall a b. (a -> b) -> a -> b
$ forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
2) (Integer -> Coin
Coin Integer
1))
        , TestName -> Assertion -> TestTree
testCase TestName
"increment treasury too much" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
1)
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
1})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
TreasuryMIR forall a b. (a -> b) -> a -> b
$ forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
2) (Integer -> Coin
Coin Integer
1))
        , TestName -> Assertion -> TestTree
testCase TestName
"increment reserves too much with delta" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
1)
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty (Integer -> DeltaCoin
DeltaCoin (-Integer
1)) (Integer -> DeltaCoin
DeltaCoin Integer
1))
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
2, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
ReservesMIR forall a b. (a -> b) -> a -> b
$ forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
2) (Integer -> Coin
Coin Integer
1))
        , TestName -> Assertion -> TestTree
testCase TestName
"increment treasury too much with delta" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
1)
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) (Integer -> DeltaCoin
DeltaCoin Integer
1) (Integer -> DeltaCoin
DeltaCoin (-Integer
1)))
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
2})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
TreasuryMIR forall a b. (a -> b) -> a -> b
$ forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
2) (Integer -> Coin
Coin Integer
1))
        , TestName -> Assertion -> TestTree
testCase TestName
"negative balance in reserves mapping" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ShelleyDelegPredFailure era
MIRProducesNegativeUpdate)
        , TestName -> Assertion -> TestTree
testCase TestName
"negative balance in treasury mapping" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
1})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. ShelleyDelegPredFailure era
MIRProducesNegativeUpdate)
        , TestName -> Assertion -> TestTree
testCase TestName
"transfer reserves to treasury" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (forall c. Coin -> MIRTarget c
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. b -> Either a b
Right (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (Integer -> DeltaCoin
DeltaCoin (-Integer
1)) (Integer -> DeltaCoin
DeltaCoin Integer
1)))
        , TestName -> Assertion -> TestTree
testCase TestName
"transfer treasury to reserves" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (forall c. Coin -> MIRTarget c
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
1})
              (forall a b. b -> Either a b
Right (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (Integer -> DeltaCoin
DeltaCoin Integer
1) (Integer -> DeltaCoin
DeltaCoin (-Integer
1))))
        , TestName -> Assertion -> TestTree
testCase TestName
"insufficient transfer reserves to treasury" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (forall c. Coin -> MIRTarget c
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty (Integer -> DeltaCoin
DeltaCoin (-Integer
1)) (Integer -> DeltaCoin
DeltaCoin Integer
1))
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
2, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForTransferDELEG MIRPot
ReservesMIR forall a b. (a -> b) -> a -> b
$ forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
1) (Integer -> Coin
Coin Integer
0))
        , TestName -> Assertion -> TestTree
testCase TestName
"insufficient transfer treasury to reserves" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (forall c. Coin -> MIRTarget c
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) (Integer -> DeltaCoin
DeltaCoin Integer
1) (Integer -> DeltaCoin
DeltaCoin (-Integer
1)))
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
2})
              (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForTransferDELEG MIRPot
TreasuryMIR forall a b. (a -> b) -> a -> b
$ forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
1) (Integer -> Coin
Coin Integer
0))
        , TestName -> Assertion -> TestTree
testCase TestName
"increment reserves mapping" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ (Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
1 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
bobOnlyDelta Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
3, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
0})
              ( forall a b. b -> Either a b
Right
                  ( forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards
                      (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
2 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking C_Crypto) Coin
bobOnlyReward Integer
1)
                      forall a. Monoid a => a
mempty
                      forall a. Monoid a => a
mempty
                      forall a. Monoid a => a
mempty
                  )
              )
        , TestName -> Assertion -> TestTree
testCase TestName
"increment treasury mapping" forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget C_Crypto
-> InstantaneousRewards C_Crypto
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyTest)))
     (InstantaneousRewards C_Crypto)
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ (Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
aliceOnlyDelta Integer
1 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking C_Crypto) DeltaCoin
bobOnlyDelta Integer
1))
              (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
1) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
              (AccountState {asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
0, asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
3})
              ( forall a b. b -> Either a b
Right
                  ( forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards
                      forall a. Monoid a => a
mempty
                      (Integer -> Map (Credential 'Staking C_Crypto) Coin
aliceOnlyReward Integer
2 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking C_Crypto) Coin
bobOnlyReward Integer
1)
                      forall a. Monoid a => a
mempty
                      forall a. Monoid a => a
mempty
                  )
              )
        ]
    ]