{-# 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.Credential (SlotNo32 (..))
import Cardano.Ledger.Hashes (GenDelegs (..))
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.Utils (
  RawSeed (..),
  applySTSTest,
  epochFromSlotNo,
  mkKeyPair,
  runShelleyBase,
 )
import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->>))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

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

env :: ProtVer -> AccountState -> DelegEnv ShelleyEra
env :: ProtVer -> AccountState -> DelegEnv ShelleyEra
env ProtVer
pv AccountState
acnt =
  DelegEnv
    { slotNo :: SlotNo
slotNo = SlotNo
slot
    , deCurEpochNo :: EpochNo
deCurEpochNo = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
    , ptr_ :: Ptr
ptr_ = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr SlotNo32
slot32 forall a. Bounded a => a
minBound forall a. Bounded a => a
minBound
    , acnt_ :: AccountState
acnt_ = AccountState
acnt
    , ppDE :: PParams ShelleyEra
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
    slot32 :: SlotNo32
slot32 = Word32 -> SlotNo32
SlotNo32 Word32
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 ->
  InstantaneousRewards ->
  AccountState ->
  Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards ->
  Assertion
testMirTransfer :: ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer ProtVer
pv MIRPot
pot MIRTarget
target InstantaneousRewards
ir AccountState
acnt (Right InstantaneousRewards
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 ShelleyEra) forall a. ShelleyBase a -> a
runShelleyBase (ProtVer -> AccountState -> DelegEnv ShelleyEra
env ProtVer
pv AccountState
acnt) forall a b. (a -> b) -> a -> b
$
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstantaneousRewards -> DState ShelleyEra
dStateWithRewards InstantaneousRewards
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 -> TxCert era
MirTxCert (MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
pot MIRTarget
target)) forall (m :: * -> *) st.
(MonadIO m, Eq st, ToExpr st, HasCallStack) =>
m st -> st -> m st
.->> (InstantaneousRewards -> DState ShelleyEra
dStateWithRewards InstantaneousRewards
expected)
testMirTransfer ProtVer
pv MIRPot
pot MIRTarget
target InstantaneousRewards
ir AccountState
acnt predicateFailure :: Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
  InstantaneousRewards
predicateFailure@(Left NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))
_) = do
  let st :: Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState ShelleyEra)
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 ShelleyEra)
            (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (ProtVer -> AccountState -> DelegEnv ShelleyEra
env ProtVer
pv AccountState
acnt, InstantaneousRewards -> DState ShelleyEra
dStateWithRewards InstantaneousRewards
ir, forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert -> TxCert era
MirTxCert (MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
pot MIRTarget
target)))
  (Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
  (DState ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
ignoreAllButIRWD Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState ShelleyEra)
st) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
  InstantaneousRewards
predicateFailure

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

alice :: Credential 'Staking
alice :: Credential 'Staking
alice = (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
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 (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
1)

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

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

bob :: Credential 'Staking
bob :: Credential 'Staking
bob = (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
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 (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)

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

bobOnlyDelta :: Integer -> Map (Credential 'Staking) DeltaCoin
bobOnlyDelta :: Integer -> Map (Credential 'Staking) DeltaCoin
bobOnlyDelta Integer
c = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
ReservesMIR
              (Coin -> MIRTarget
SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
TreasuryMIR
              (Coin -> MIRTarget
SendToOppositePotMIR forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta (-Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Coin -> MIRTarget
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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 (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Coin -> MIRTarget
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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 (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Coin -> MIRTarget
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Coin -> MIRTarget
SendToOppositePotMIR (Integer -> Coin
Coin Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ (Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking) DeltaCoin
bobOnlyDelta Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards (Integer -> Map (Credential 'Staking) 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
                  ( Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards
                      (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
2 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking) 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
-> InstantaneousRewards
-> AccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$ (Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking) DeltaCoin
bobOnlyDelta Integer
1))
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) 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
                  ( Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards
                      forall a. Monoid a => a
mempty
                      (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
2 forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking) Coin
bobOnlyReward Integer
1)
                      forall a. Monoid a => a
mempty
                      forall a. Monoid a => a
mempty
                  )
              )
        ]
    ]