{-# 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 Control.State.Transition.Extended hiding (Assertion) import Data.Default (def) 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.TreeDiff () 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))) (CertState ShelleyEra) -> Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards ignoreAllButIRWD :: Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) (CertState ShelleyEra) -> Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards ignoreAllButIRWD = (ShelleyCertState ShelleyEra -> InstantaneousRewards) -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState 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 (DState ShelleyEra -> InstantaneousRewards) -> (ShelleyCertState ShelleyEra -> DState ShelleyEra) -> ShelleyCertState ShelleyEra -> InstantaneousRewards forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyCertState ShelleyEra -> DState ShelleyEra forall era. ShelleyCertState era -> DState era shelleyCertDState) 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 $ ShelleyCertState ShelleyEra -> ReaderT (ShelleyCertState ShelleyEra -> ShelleyTxCert ShelleyEra -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) IO (ShelleyCertState ShelleyEra) forall a. a -> ReaderT (ShelleyCertState ShelleyEra -> ShelleyTxCert ShelleyEra -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (InstantaneousRewards -> CertState ShelleyEra certStateWithRewards InstantaneousRewards ir) ReaderT (ShelleyCertState ShelleyEra -> ShelleyTxCert ShelleyEra -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) IO (ShelleyCertState ShelleyEra) -> TxCert ShelleyEra -> ReaderT (ShelleyCertState ShelleyEra -> ShelleyTxCert ShelleyEra -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) IO (ShelleyCertState 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, AtMostEra "Babbage" era) => MIRCert -> TxCert era MirTxCert (MIRPot -> MIRTarget -> MIRCert MIRCert MIRPot pot MIRTarget target) ReaderT (ShelleyCertState ShelleyEra -> ShelleyTxCert ShelleyEra -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) IO (ShelleyCertState ShelleyEra) -> ShelleyCertState ShelleyEra -> ReaderT (ShelleyCertState ShelleyEra -> ShelleyTxCert ShelleyEra -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) IO (ShelleyCertState ShelleyEra) forall (m :: * -> *) st. (MonadIO m, Eq st, ToExpr st, HasCallStack) => m st -> st -> m st .->> InstantaneousRewards -> CertState ShelleyEra certStateWithRewards 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)) (ShelleyCertState ShelleyEra) st = ShelleyBase (Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra) forall a. ShelleyBase a -> a runShelleyBase (ShelleyBase (Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) -> ShelleyBase (Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra)) -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState 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 -> CertState ShelleyEra certStateWithRewards InstantaneousRewards ir, MIRCert -> TxCert ShelleyEra forall era. (ShelleyEraTxCert era, AtMostEra "Babbage" era) => MIRCert -> TxCert era MirTxCert (MIRPot -> MIRTarget -> MIRCert MIRCert MIRPot pot MIRTarget target))) Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) (CertState ShelleyEra) -> Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards ignoreAllButIRWD Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) (CertState ShelleyEra) Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) (ShelleyCertState ShelleyEra) st Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) InstantaneousRewards -> Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) InstantaneousRewards -> Assertion forall a. (HasCallStack, Show a, Eq a) => a -> a -> Assertion @?= Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards Either (NonEmpty (ShelleyDelegPredFailure ShelleyEra)) InstantaneousRewards predicateFailure certStateWithRewards :: InstantaneousRewards -> CertState ShelleyEra certStateWithRewards :: InstantaneousRewards -> CertState ShelleyEra certStateWithRewards InstantaneousRewards ir = CertState ShelleyEra forall a. Default a => a def CertState ShelleyEra -> (CertState ShelleyEra -> ShelleyCertState ShelleyEra) -> ShelleyCertState ShelleyEra forall a b. a -> (a -> b) -> b & (DState ShelleyEra -> Identity (DState ShelleyEra)) -> CertState ShelleyEra -> Identity (CertState ShelleyEra) (DState ShelleyEra -> Identity (DState ShelleyEra)) -> CertState ShelleyEra -> Identity (ShelleyCertState ShelleyEra) forall era. EraCertState era => Lens' (CertState era) (DState era) Lens' (CertState ShelleyEra) (DState ShelleyEra) certDStateL ((DState ShelleyEra -> Identity (DState ShelleyEra)) -> CertState ShelleyEra -> Identity (ShelleyCertState ShelleyEra)) -> DState ShelleyEra -> CertState ShelleyEra -> ShelleyCertState ShelleyEra forall s t a b. ASetter s t a b -> b -> s -> t .~ DState { dsAccounts :: Accounts ShelleyEra dsAccounts = Accounts ShelleyEra ShelleyAccounts ShelleyEra forall a. Default a => a def , dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair dsFutureGenDelegs = Map FutureGenDeleg GenDelegPair forall k a. Map k a Map.empty , dsGenDelegs :: GenDelegs dsGenDelegs = Map (KeyHash GenesisRole) GenDelegPair -> GenDelegs GenDelegs Map (KeyHash GenesisRole) 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 = String -> [TestTree] -> TestTree forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a testGroup String "MIR cert transfers" [ String -> [TestTree] -> TestTree forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a testGroup String "MIR cert embargos" [ HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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) ] , String -> [TestTree] -> TestTree forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a testGroup String "MIR cert alonzo" [ HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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))) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)))) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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)) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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 ) ) , HasCallStack => String -> Assertion -> TestTree String -> Assertion -> TestTree testCase String "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 ) ) ] ]