{-# 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 (
  Credential (..),
  DelegEnv (..),
  Ptr (..),
  ShelleyDELEG,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure (..))
import Cardano.Ledger.Shelley.State
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 = (DState ShelleyEra -> InstantaneousRewards)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b.
(a -> b)
-> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) a
-> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DState ShelleyEra -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards

env :: ProtVer -> ChainAccountState -> DelegEnv ShelleyEra
env :: ProtVer -> ChainAccountState -> DelegEnv ShelleyEra
env ProtVer
pv ChainAccountState
chainAccountState =
  DelegEnv
    { slotNo :: SlotNo
slotNo = SlotNo
slot
    , deCurEpochNo :: EpochNo
deCurEpochNo = SlotNo -> EpochNo
epochFromSlotNo SlotNo
slot
    , ptr_ :: Ptr
ptr_ = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr SlotNo32
slot32 TxIx
forall a. Bounded a => a
minBound CertIx
forall a. Bounded a => a
minBound
    , deChainAccountState :: ChainAccountState
deChainAccountState = ChainAccountState
chainAccountState
    , ppDE :: PParams ShelleyEra
ppDE = PParams ShelleyEra
forall era. EraPParams era => PParams era
emptyPParams PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams ShelleyEra) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> ProtVer -> PParams ShelleyEra -> PParams ShelleyEra
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 ->
  ChainAccountState ->
  Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards ->
  Assertion
testMirTransfer :: ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer ProtVer
pv MIRPot
pot MIRTarget
target InstantaneousRewards
ir ChainAccountState
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) ShelleyBase a -> a
forall a. ShelleyBase a -> a
runShelleyBase (ProtVer -> ChainAccountState -> DelegEnv ShelleyEra
env ProtVer
pv ChainAccountState
acnt) (ReaderT
   (State (ShelleyDELEG ShelleyEra)
    -> Signal (ShelleyDELEG ShelleyEra)
    -> Either
         (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
         (State (ShelleyDELEG ShelleyEra)))
   IO
   (State (ShelleyDELEG ShelleyEra))
 -> Assertion)
-> ReaderT
     (State (ShelleyDELEG ShelleyEra)
      -> Signal (ShelleyDELEG ShelleyEra)
      -> Either
           (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
           (State (ShelleyDELEG ShelleyEra)))
     IO
     (State (ShelleyDELEG ShelleyEra))
-> Assertion
forall a b. (a -> b) -> a -> b
$
    DState ShelleyEra
-> ReaderT
     (DState ShelleyEra
      -> ShelleyTxCert ShelleyEra
      -> Either
           (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
           (DState ShelleyEra))
     IO
     (DState ShelleyEra)
forall a.
a
-> ReaderT
     (DState ShelleyEra
      -> ShelleyTxCert ShelleyEra
      -> Either
           (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
           (DState ShelleyEra))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstantaneousRewards -> DState ShelleyEra
dStateWithRewards InstantaneousRewards
ir) ReaderT
  (DState ShelleyEra
   -> ShelleyTxCert ShelleyEra
   -> Either
        (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
        (DState ShelleyEra))
  IO
  (DState ShelleyEra)
-> TxCert ShelleyEra
-> ReaderT
     (DState ShelleyEra
      -> ShelleyTxCert ShelleyEra
      -> Either
           (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
           (DState ShelleyEra))
     IO
     (DState ShelleyEra)
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- MIRCert -> TxCert ShelleyEra
forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert -> TxCert era
MirTxCert (MIRPot -> MIRTarget -> MIRCert
MIRCert MIRPot
pot MIRTarget
target) ReaderT
  (DState ShelleyEra
   -> ShelleyTxCert ShelleyEra
   -> Either
        (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
        (DState ShelleyEra))
  IO
  (DState ShelleyEra)
-> DState ShelleyEra
-> ReaderT
     (DState ShelleyEra
      -> ShelleyTxCert ShelleyEra
      -> Either
           (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
           (DState ShelleyEra))
     IO
     (DState ShelleyEra)
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 ChainAccountState
acnt predicateFailure :: Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
  InstantaneousRewards
predicateFailure@(Left NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))
_) = do
  let st :: Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState ShelleyEra)
st =
        ShelleyBase
  (Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     (DState ShelleyEra))
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState ShelleyEra)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (Either
      (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
      (DState ShelleyEra))
 -> Either
      (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
      (DState ShelleyEra))
-> ShelleyBase
     (Either
        (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
        (DState ShelleyEra))
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState 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 @(ShelleyDELEG ShelleyEra)
            ((Environment (ShelleyDELEG ShelleyEra),
 State (ShelleyDELEG ShelleyEra), Signal (ShelleyDELEG ShelleyEra))
-> TRC (ShelleyDELEG ShelleyEra)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (ProtVer -> ChainAccountState -> DelegEnv ShelleyEra
env ProtVer
pv ChainAccountState
acnt, InstantaneousRewards -> DState ShelleyEra
dStateWithRewards InstantaneousRewards
ir, MIRCert -> TxCert ShelleyEra
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 (PredicateFailure (ShelleyDELEG ShelleyEra)))
  (DState ShelleyEra)
Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (DState ShelleyEra)
st Either
  (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
  InstantaneousRewards
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
  InstantaneousRewards
Either
  (NonEmpty (ShelleyDelegPredFailure 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 = Map FutureGenDeleg GenDelegPair
forall k a. Map k a
Map.empty
    , dsGenDelegs :: GenDelegs
dsGenDelegs = Map (KeyHash 'Genesis) GenDelegPair -> GenDelegs
GenDelegs Map (KeyHash 'Genesis) GenDelegPair
forall k a. Map k a
Map.empty
    , dsIRewards :: InstantaneousRewards
dsIRewards = InstantaneousRewards
ir
    }

alice :: Credential 'Staking
alice :: Credential 'Staking
alice = (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ((SignKeyDSIGN DSIGN, VKey 'Staking) -> KeyHash 'Staking)
-> (SignKeyDSIGN DSIGN, VKey 'Staking)
-> Credential 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> ((SignKeyDSIGN DSIGN, VKey 'Staking) -> VKey 'Staking)
-> (SignKeyDSIGN DSIGN, VKey 'Staking)
-> KeyHash 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignKeyDSIGN DSIGN, VKey 'Staking) -> VKey 'Staking
forall a b. (a, b) -> b
snd) ((SignKeyDSIGN DSIGN, VKey 'Staking) -> Credential 'Staking)
-> (SignKeyDSIGN DSIGN, VKey 'Staking) -> Credential 'Staking
forall a b. (a -> b) -> a -> b
$ RawSeed -> (SignKeyDSIGN DSIGN, VKey 'Staking)
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 = [(Credential 'Staking, Coin)] -> Map (Credential 'Staking) Coin
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 = [(Credential 'Staking, DeltaCoin)]
-> Map (Credential 'Staking) DeltaCoin
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 = (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ((SignKeyDSIGN DSIGN, VKey 'Staking) -> KeyHash 'Staking)
-> (SignKeyDSIGN DSIGN, VKey 'Staking)
-> Credential 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> ((SignKeyDSIGN DSIGN, VKey 'Staking) -> VKey 'Staking)
-> (SignKeyDSIGN DSIGN, VKey 'Staking)
-> KeyHash 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignKeyDSIGN DSIGN, VKey 'Staking) -> VKey 'Staking
forall a b. (a, b) -> b
snd) ((SignKeyDSIGN DSIGN, VKey 'Staking) -> Credential 'Staking)
-> (SignKeyDSIGN DSIGN, VKey 'Staking) -> Credential 'Staking
forall a b. (a -> b) -> a -> b
$ RawSeed -> (SignKeyDSIGN DSIGN, VKey 'Staking)
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 = [(Credential 'Staking, Coin)] -> Map (Credential 'Staking) Coin
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 = [(Credential 'Staking, DeltaCoin)]
-> Map (Credential 'Staking) DeltaCoin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
ReservesMIR
              (Coin -> MIRTarget
SendToOppositePotMIR (Coin -> MIRTarget) -> Coin -> MIRTarget
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
1, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ ShelleyDelegPredFailure ShelleyEra
forall era. ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed)
        , TestName -> Assertion -> TestTree
testCase TestName
"embargo treasury to reserves transfer" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
TreasuryMIR
              (Coin -> MIRTarget
SendToOppositePotMIR (Coin -> MIRTarget) -> Coin -> MIRTarget
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)
              (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
1})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ ShelleyDelegPredFailure ShelleyEra
forall era. ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed)
        , TestName -> Assertion -> TestTree
testCase TestName
"embargo decrements from reserves" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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) Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
1, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ ShelleyDelegPredFailure ShelleyEra
forall era. ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed)
        , TestName -> Assertion -> TestTree
testCase TestName
"embargo decrements from treasury" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
shelleyPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
1) DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
1})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ ShelleyDelegPredFailure ShelleyEra
forall era. ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed)
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"MIR cert alonzo"
        [ TestName -> Assertion -> TestTree
testCase TestName
"increment reserves too much" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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) Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
1, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
ReservesMIR (Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelLTEQ Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
1) DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
1})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
TreasuryMIR (Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelLTEQ Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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) Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> DeltaCoin
DeltaCoin (-Integer
1)) (Integer -> DeltaCoin
DeltaCoin Integer
1))
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
2, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
ReservesMIR (Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelLTEQ Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
1) (Integer -> DeltaCoin
DeltaCoin Integer
1) (Integer -> DeltaCoin
DeltaCoin (-Integer
1)))
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
2})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG MIRPot
TreasuryMIR (Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelLTEQ Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
1, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ ShelleyDelegPredFailure ShelleyEra
forall era. ShelleyDelegPredFailure era
MIRProducesNegativeUpdate)
        , TestName -> Assertion -> TestTree
testCase TestName
"negative balance in treasury mapping" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
1})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ ShelleyDelegPredFailure ShelleyEra
forall era. ShelleyDelegPredFailure era
MIRProducesNegativeUpdate)
        , TestName -> Assertion -> TestTree
testCase TestName
"transfer reserves to treasury" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> 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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
1, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (InstantaneousRewards
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. b -> Either a b
Right (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> 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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
1})
              (InstantaneousRewards
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. b -> Either a b
Right (Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty Map (Credential 'Staking) Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> 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) Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> DeltaCoin
DeltaCoin (-Integer
1)) (Integer -> DeltaCoin
DeltaCoin Integer
1))
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
2, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForTransferDELEG MIRPot
ReservesMIR (Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelLTEQ Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> 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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
1) (Integer -> DeltaCoin
DeltaCoin Integer
1) (Integer -> DeltaCoin
DeltaCoin (-Integer
1)))
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
2})
              (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
NonEmpty (ShelleyDelegPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. a -> Either a b
Left (NonEmpty (ShelleyDelegPredFailure ShelleyEra)
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> (ShelleyDelegPredFailure ShelleyEra
    -> NonEmpty (ShelleyDelegPredFailure ShelleyEra))
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ShelleyEra
-> NonEmpty (ShelleyDelegPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyDelegPredFailure ShelleyEra
 -> Either
      (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
      InstantaneousRewards)
-> ShelleyDelegPredFailure ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
forall a b. (a -> b) -> a -> b
$ MIRPot
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall era.
MIRPot -> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForTransferDELEG MIRPot
TreasuryMIR (Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ Coin -> ShelleyDelegPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelLTEQ Coin
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
ReservesMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$ (Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1 Map (Credential 'Staking) DeltaCoin
-> Map (Credential 'Staking) DeltaCoin
-> Map (Credential 'Staking) DeltaCoin
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) Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
3, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
0})
              ( InstantaneousRewards
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
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 Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin -> Map (Credential 'Staking) Coin
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking) Coin
bobOnlyReward Integer
1)
                      Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty
                      DeltaCoin
forall a. Monoid a => a
mempty
                      DeltaCoin
forall a. Monoid a => a
mempty
                  )
              )
        , TestName -> Assertion -> TestTree
testCase TestName
"increment treasury mapping" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            ProtVer
-> MIRPot
-> MIRTarget
-> InstantaneousRewards
-> ChainAccountState
-> Either
     (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra)))
     InstantaneousRewards
-> Assertion
testMirTransfer
              ProtVer
alonzoPV
              MIRPot
TreasuryMIR
              (Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$ (Integer -> Map (Credential 'Staking) DeltaCoin
aliceOnlyDelta Integer
1 Map (Credential 'Staking) DeltaCoin
-> Map (Credential 'Staking) DeltaCoin
-> Map (Credential 'Staking) DeltaCoin
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 Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
1) DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty)
              (ChainAccountState {casReserves :: Coin
casReserves = Integer -> Coin
Coin Integer
0, casTreasury :: Coin
casTreasury = Integer -> Coin
Coin Integer
3})
              ( InstantaneousRewards
-> Either
     (NonEmpty (ShelleyDelegPredFailure ShelleyEra))
     InstantaneousRewards
forall a b. b -> Either a b
Right
                  ( Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards
                      Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty
                      (Integer -> Map (Credential 'Staking) Coin
aliceOnlyReward Integer
2 Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin -> Map (Credential 'Staking) Coin
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Integer -> Map (Credential 'Staking) Coin
bobOnlyReward Integer
1)
                      DeltaCoin
forall a. Monoid a => a
mempty
                      DeltaCoin
forall a. Monoid a => a
mempty
                  )
              )
        ]
    ]