{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Shelley.UnitTests (unitTests) where

import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.Address (Addr (..), raCredential, pattern RewardAccount)
import Cardano.Ledger.BaseTypes hiding ((==>))
import Cardano.Ledger.Coin
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.PoolParams (
  PoolMetadata (..),
  PoolParams (..),
  pmHash,
  pmUrl,
  ppCost,
  ppId,
  ppMargin,
  ppMetadata,
  ppOwners,
  ppPledge,
  ppRelays,
  ppRewardAccount,
  ppVrf,
 )
import Cardano.Ledger.Shelley.API (
  LedgerEnv (..),
  ShelleyLEDGER,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  LedgerState (..),
  UTxOState (..),
 )
import Cardano.Ledger.Shelley.Rules (
  ShelleyDelegsPredFailure (..),
  ShelleyDelplPredFailure (..),
  ShelleyLedgerPredFailure (..),
  ShelleyPoolPredFailure (..),
  ShelleyUtxoPredFailure (..),
  ShelleyUtxowPredFailure (..),
 )
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (TxBody (..))
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits, addrWits)
import Cardano.Ledger.TxIn (TxIn (..))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val ((<+>), (<->))
import Cardano.Protocol.Crypto (StandardCrypto, VRF, hashVerKeyVRF)
import Cardano.Protocol.TPraos.BHeader (checkLeaderValue)
import Control.DeepSeq (rnf)
import Control.State.Transition.Extended (PredicateFailure, TRC (..))
import qualified Data.ByteString.Char8 as BS (pack)
import Data.Default (def)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import Data.Proxy (Proxy (..))
import Data.Ratio ((%))
import Data.Sequence.Strict (StrictSeq (..))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Word (Word64)
import GHC.Stack
import Lens.Micro
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Core.KeyPair (
  KeyPair (..),
  mkVKeyRewardAccount,
  mkWitnessVKey,
  mkWitnessesVKey,
  vKey,
 )
import Test.Cardano.Ledger.Shelley.Arbitrary (
  ASC (ASC),
  StakeProportion (StakeProportion),
 )
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, MockCrypto)
import Test.Cardano.Ledger.Shelley.Fees (sizeTests)
import Test.Cardano.Ledger.Shelley.Generator.Core (VRFKeyPair (..), genesisCoins)
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Utils
import Test.Cardano.Protocol.TPraos.Arbitrary (VRFNatVal (VRFNatVal))
import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->>))
import qualified Test.QuickCheck.Gen as QC
import qualified Test.QuickCheck.Random as QC
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck

-- ========================================================================================

alicePay :: KeyPair 'Payment
alicePay :: KeyPair 'Payment
alicePay = RawSeed -> KeyPair 'Payment
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (RawSeed -> KeyPair 'Payment) -> RawSeed -> KeyPair 'Payment
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
1 Word64
1 Word64
1 Word64
1

aliceStake :: KeyPair 'Staking
aliceStake :: KeyPair 'Staking
aliceStake = RawSeed -> KeyPair 'Staking
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (RawSeed -> KeyPair 'Staking) -> RawSeed -> KeyPair 'Staking
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
2 Word64
2 Word64
2 Word64
2

aliceAddr :: Addr
aliceAddr :: Addr
aliceAddr =
  Network -> PaymentCredential -> StakeReference -> Addr
Addr
    Network
Testnet
    (KeyHash 'Payment -> PaymentCredential
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Payment -> PaymentCredential)
-> (VKey 'Payment -> KeyHash 'Payment)
-> VKey 'Payment
-> PaymentCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> PaymentCredential)
-> VKey 'Payment -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
alicePay)
    (StakeCredential -> StakeReference
StakeRefBase (StakeCredential -> StakeReference)
-> (VKey 'Staking -> StakeCredential)
-> VKey 'Staking
-> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Staking -> StakeCredential
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> StakeCredential)
-> (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> StakeReference)
-> VKey 'Staking -> StakeReference
forall a b. (a -> b) -> a -> b
$ KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
aliceStake)

bobPay :: KeyPair 'Payment
bobPay :: KeyPair 'Payment
bobPay = RawSeed -> KeyPair 'Payment
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (RawSeed -> KeyPair 'Payment) -> RawSeed -> KeyPair 'Payment
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
3 Word64
3 Word64
3 Word64
3 Word64
3

bobStake :: KeyPair 'Staking
bobStake :: KeyPair 'Staking
bobStake = RawSeed -> KeyPair 'Staking
forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' (RawSeed -> KeyPair 'Staking) -> RawSeed -> KeyPair 'Staking
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
4 Word64
4 Word64
4 Word64
4 Word64
4

bobAddr :: Addr
bobAddr :: Addr
bobAddr =
  Network -> PaymentCredential -> StakeReference -> Addr
Addr
    Network
Testnet
    (KeyHash 'Payment -> PaymentCredential
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Payment -> PaymentCredential)
-> (VKey 'Payment -> KeyHash 'Payment)
-> VKey 'Payment
-> PaymentCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> PaymentCredential)
-> VKey 'Payment -> PaymentCredential
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
bobPay)
    (StakeCredential -> StakeReference
StakeRefBase (StakeCredential -> StakeReference)
-> (VKey 'Staking -> StakeCredential)
-> VKey 'Staking
-> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Staking -> StakeCredential
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> StakeCredential)
-> (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> StakeReference)
-> VKey 'Staking -> StakeReference
forall a b. (a -> b) -> a -> b
$ KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
bobStake)

mkGenesisTxIn :: HasCallStack => Integer -> TxIn
mkGenesisTxIn :: HasCallStack => Integer -> TxIn
mkGenesisTxIn = TxId -> TxIx -> TxIn
TxIn TxId
genesisId (TxIx -> TxIn) -> (Integer -> TxIx) -> Integer -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial

pp :: forall era. (EraPParams era, ProtVerAtMost era 4) => PParams era
pp :: forall era. (EraPParams era, ProtVerAtMost era 4) => PParams era
pp =
  PParams era
forall era. EraPParams era => PParams era
emptyPParams
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeBL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
250
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
1024
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
10
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinUTxOValueL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinPoolCostL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
10

testVRFCheckWithActiveSlotCoeffOne :: Assertion
testVRFCheckWithActiveSlotCoeffOne :: Assertion
testVRFCheckWithActiveSlotCoeffOne =
  OutputVRF FakeVRF -> Rational -> ActiveSlotCoeff -> Bool
forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue
    (Natural -> OutputVRF FakeVRF
forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
0 :: VRF.OutputVRF (VRF MockCrypto))
    (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2)
    (PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> PositiveUnitInterval -> ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
1)
    Bool -> Bool -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Bool
True

testsPParams :: TestTree
testsPParams :: TestTree
testsPParams =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Test the protocol parameters."
    [ TestName -> Assertion -> TestTree
testCase TestName
"VRF checks when the activeSlotCoeff is one" Assertion
testVRFCheckWithActiveSlotCoeffOne
    ]

-- | Test @checkLeaderVal@ in 'Cardano.Ledger.Shelley.BlockChain'
testCheckLeaderVal ::
  forall v.
  v ~ VRF StandardCrypto =>
  TestTree
testCheckLeaderVal :: forall v. (v ~ VRF StandardCrypto) => TestTree
testCheckLeaderVal =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Test checkLeaderVal calculation"
    [ TestName -> (VRFNatVal -> ASC -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"With a stake of 0, cannot lead" ((VRFNatVal -> ASC -> Bool) -> TestTree)
-> (VRFNatVal -> ASC -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \(VRFNatVal Natural
n) (ASC ActiveSlotCoeff
f) ->
          forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v (Natural -> OutputVRF v
forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
n) Rational
0 ActiveSlotCoeff
f Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
    , TestName -> (ASC -> StakeProportion -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"With a maximal VRF, cannot lead" ((ASC -> StakeProportion -> Bool) -> TestTree)
-> (ASC -> StakeProportion -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \(ASC ActiveSlotCoeff
f) (StakeProportion Rational
r) ->
          forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v
            (Natural -> OutputVRF v
forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
maxVRFVal)
            Rational
r
            ActiveSlotCoeff
f
            Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
    , TestName
-> (VRFNatVal -> ASC -> StakeProportion -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"checkLeaderVal succeeds iff l < 1 - (1-f)^r" ((VRFNatVal -> ASC -> StakeProportion -> Property) -> TestTree)
-> (VRFNatVal -> ASC -> StakeProportion -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \(VRFNatVal Natural
n) (ASC ActiveSlotCoeff
f) (StakeProportion Rational
r) ->
          Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
            let ascVal :: Double
                ascVal :: Double
ascVal = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double)
-> (PositiveUnitInterval -> Rational)
-> PositiveUnitInterval
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveUnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational (PositiveUnitInterval -> Double) -> PositiveUnitInterval -> Double
forall a b. (a -> b) -> a -> b
$ ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal ActiveSlotCoeff
f
             in forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v
                  (Natural -> OutputVRF v
forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
n)
                  Rational
r
                  ActiveSlotCoeff
f
                  Bool -> Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ( (Natural -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Natural
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Natural -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Natural
maxVRFVal Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1))
                          Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ascVal) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
                      )
    , -- Suppose that our VRF value V is drawn uniformly from [0, maxVRFVal).
      -- The leader check verifies that fromNat V < 1 - (1-f)^r, where fromNat
      -- is an appropriate mapping into the unit interval giving fromNat V ~
      -- U(0,1). Then the probability X of being selected leader, given that VRF
      -- value, is given by p = 1 - (1 - f)^r. So assuming n independent draws
      -- of V, the number of slots in which we lead is given by S ~ Bin(n, p)
      -- and has an expected value of np.
      --
      -- The probability that S sits outside a δ-window around the mean (i.e.
      -- that this test fails under the hypothesis that our leader check is
      -- correct) is given by P(np - δ <= S <= np + δ).
      --
      -- Previously, we chose δ such that this value is quite low (eg, <1/1000).
      -- However, this means the test *will* fail sometimes. If the probability
      -- is 0.0004 and we run the test 100 times for each run of the test
      -- suite, we would expect it to fail approximately once in every 25 test
      -- runs.
      --
      -- We therefore now use a fixed seed so that this is effectively a unit test
      -- and not a property test.
      --
      TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"We are elected as leader proportional to our stake" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
        -- 6297 is a seed value that fails
        -- --quickcheck-replay=618 fails when withSeed isn't used
        Gen Property -> Property
forall prop. Testable prop => prop -> Property
once (Gen Property -> Property)
-> (Gen Property -> Gen Property) -> Gen Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen Property -> Gen Property
forall {a}. Int -> Gen a -> Gen a
withSeed Int
12345 (Gen Property -> Property) -> Gen Property -> Property
forall a b. (a -> b) -> a -> b
$ do
          let numTrials :: Int
numTrials = Int
2000
          ASC ActiveSlotCoeff
f <- Gen ASC
forall a. Arbitrary a => Gen a
arbitrary
          StakeProportion Rational
r <- Gen StakeProportion
forall a. Arbitrary a => Gen a
arbitrary
          [Integer]
vrfVals <- Int -> Gen Integer -> Gen [Integer]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
numTrials ((Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
0, Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
maxVRFVal :: Integer))
          let ascVal :: Double
              ascVal :: Double
ascVal = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double)
-> (PositiveUnitInterval -> Rational)
-> PositiveUnitInterval
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveUnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational (PositiveUnitInterval -> Double) -> PositiveUnitInterval -> Double
forall a b. (a -> b) -> a -> b
$ ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal ActiveSlotCoeff
f
              -- 4 standard deviations
              δ :: Double
δ = Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt (Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
numTrials Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
p))
              p :: Double
p = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ascVal) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r
              mean :: Double
mean = Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
numTrials Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p
              lb :: Int
lb = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
mean Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
δ)
              ub :: Int
ub = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
mean Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
δ)
              check :: Integer -> Bool
check Integer
vrf = forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v (Natural -> OutputVRF v
forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF (Natural -> OutputVRF v) -> Natural -> OutputVRF v
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vrf) Rational
r ActiveSlotCoeff
f
              s :: Int
s = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> ([Bool] -> [Bool]) -> [Bool] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
forall a. a -> a
id ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Bool
check (Integer -> Bool) -> [Integer] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
vrfVals
          Property -> Gen Property
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> Gen Property) -> Property -> Gen Property
forall a b. (a -> b) -> a -> b
$
            Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
              TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
                (Int -> TestName
forall a. Show a => a -> TestName
show Int
lb TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
" /< " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Int -> TestName
forall a. Show a => a -> TestName
show Int
s TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
" /< " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Int -> TestName
forall a. Show a => a -> TestName
show Int
ub TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
" (p=" TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Double -> TestName
forall a. Show a => a -> TestName
show Double
p TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
")")
                (Int
lb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s Bool -> Bool -> Bool
&& Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ub)
    ]
  where
    maxVRFVal :: Natural
    maxVRFVal :: Natural
maxVRFVal = (Natural
2 Natural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
8 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Proxy v -> Word
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
forall (proxy :: * -> *). proxy v -> Word
VRF.sizeOutputVRF (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
    withSeed :: Int -> Gen a -> Gen a
withSeed Int
i (QC.MkGen QCGen -> Int -> a
f) = (QCGen -> Int -> a) -> Gen a
forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen ((QCGen -> Int -> a) -> Gen a) -> (QCGen -> Int -> a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \QCGen
_r Int
n -> QCGen -> Int -> a
f (Int -> QCGen
QC.mkQCGen Int
i) Int
n

testLEDGER ::
  HasCallStack =>
  LedgerState C ->
  ShelleyTx C ->
  LedgerEnv C ->
  Either (NonEmpty (PredicateFailure (ShelleyLEDGER C))) (LedgerState C) ->
  Assertion
testLEDGER :: HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
initSt ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
env (Right LedgerState ShelleyEra
expectedSt) = do
  forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @(ShelleyLEDGER C) ShelleyBase a -> a
forall a. ShelleyBase a -> a
runShelleyBase LedgerEnv ShelleyEra
Environment (ShelleyLEDGER ShelleyEra)
env (ReaderT
   (State (ShelleyLEDGER ShelleyEra)
    -> Signal (ShelleyLEDGER ShelleyEra)
    -> Either
         (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
         (State (ShelleyLEDGER ShelleyEra)))
   IO
   (State (ShelleyLEDGER ShelleyEra))
 -> Assertion)
-> ReaderT
     (State (ShelleyLEDGER ShelleyEra)
      -> Signal (ShelleyLEDGER ShelleyEra)
      -> Either
           (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
           (State (ShelleyLEDGER ShelleyEra)))
     IO
     (State (ShelleyLEDGER ShelleyEra))
-> Assertion
forall a b. (a -> b) -> a -> b
$ LedgerState ShelleyEra
-> ReaderT
     (LedgerState ShelleyEra
      -> ShelleyTx ShelleyEra
      -> Either
           (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
           (LedgerState ShelleyEra))
     IO
     (LedgerState ShelleyEra)
forall a.
a
-> ReaderT
     (LedgerState ShelleyEra
      -> ShelleyTx ShelleyEra
      -> Either
           (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
           (LedgerState ShelleyEra))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerState ShelleyEra
initSt ReaderT
  (LedgerState ShelleyEra
   -> ShelleyTx ShelleyEra
   -> Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
  IO
  (LedgerState ShelleyEra)
-> ShelleyTx ShelleyEra
-> ReaderT
     (LedgerState ShelleyEra
      -> ShelleyTx ShelleyEra
      -> Either
           (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
           (LedgerState ShelleyEra))
     IO
     (LedgerState ShelleyEra)
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- ShelleyTx ShelleyEra
tx ReaderT
  (LedgerState ShelleyEra
   -> ShelleyTx ShelleyEra
   -> Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
  IO
  (LedgerState ShelleyEra)
-> LedgerState ShelleyEra
-> ReaderT
     (LedgerState ShelleyEra
      -> ShelleyTx ShelleyEra
      -> Either
           (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
           (LedgerState ShelleyEra))
     IO
     (LedgerState ShelleyEra)
forall (m :: * -> *) st.
(MonadIO m, Eq st, ToExpr st, HasCallStack) =>
m st -> st -> m st
.->> LedgerState ShelleyEra
expectedSt
testLEDGER LedgerState ShelleyEra
initSt ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
env predicateFailure :: Either
  (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
  (LedgerState ShelleyEra)
predicateFailure@(Left NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
_) = do
  let st :: Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st = ShelleyBase
  (Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (Either
      (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
      (LedgerState ShelleyEra))
 -> Either
      (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
      (LedgerState ShelleyEra))
-> ShelleyBase
     (Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState 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 @(ShelleyLEDGER C) ((Environment (ShelleyLEDGER ShelleyEra),
 State (ShelleyLEDGER ShelleyEra),
 Signal (ShelleyLEDGER ShelleyEra))
-> TRC (ShelleyLEDGER ShelleyEra)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv ShelleyEra
Environment (ShelleyLEDGER ShelleyEra)
env, State (ShelleyLEDGER ShelleyEra)
LedgerState ShelleyEra
initSt, ShelleyTx ShelleyEra
Signal (ShelleyLEDGER ShelleyEra)
tx))
  Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either
  (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
  (LedgerState ShelleyEra)
Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
predicateFailure

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin Integer
10000

data AliceToBob = AliceToBob
  { AliceToBob -> TxIn
input :: TxIn
  , AliceToBob -> Coin
toBob :: Coin
  , AliceToBob -> Coin
fee :: Coin
  , AliceToBob -> Coin
deposits :: Coin
  , AliceToBob -> Coin
refunds :: Coin
  , AliceToBob -> [TxCert ShelleyEra]
certs :: [TxCert C]
  , AliceToBob -> SlotNo
ttl :: SlotNo
  , AliceToBob -> [KeyPair 'Witness]
signers :: [KeyPair 'Witness]
  }

aliceGivesBobLovelace :: AliceToBob -> ShelleyTx C
aliceGivesBobLovelace :: AliceToBob -> ShelleyTx ShelleyEra
aliceGivesBobLovelace
  AliceToBob
    { TxIn
$sel:input:AliceToBob :: AliceToBob -> TxIn
input :: TxIn
input
    , Coin
$sel:toBob:AliceToBob :: AliceToBob -> Coin
toBob :: Coin
toBob
    , Coin
$sel:fee:AliceToBob :: AliceToBob -> Coin
fee :: Coin
fee
    , Coin
$sel:deposits:AliceToBob :: AliceToBob -> Coin
deposits :: Coin
deposits
    , Coin
$sel:refunds:AliceToBob :: AliceToBob -> Coin
refunds :: Coin
refunds
    , [TxCert ShelleyEra]
$sel:certs:AliceToBob :: AliceToBob -> [TxCert ShelleyEra]
certs :: [TxCert ShelleyEra]
certs
    , SlotNo
$sel:ttl:AliceToBob :: AliceToBob -> SlotNo
ttl :: SlotNo
ttl
    , [KeyPair 'Witness]
$sel:signers:AliceToBob :: AliceToBob -> [KeyPair 'Witness]
signers :: [KeyPair 'Witness]
signers
    } = TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody ShelleyEra
txbody ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = awits} StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
    where
      aliceCoin :: Coin
aliceCoin = Coin
aliceInitCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
refunds Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> (Coin
toBob Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
fee Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
deposits)
      txbody :: TxBody ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          (TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
input)
          ( [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
              [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr Value ShelleyEra
Coin
aliceCoin
              , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr Value ShelleyEra
Coin
toBob
              ]
          )
          ([ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [TxCert ShelleyEra]
[ShelleyTxCert ShelleyEra]
certs)
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          Coin
fee
          SlotNo
ttl
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      awits :: Set (WitVKey 'Witness)
awits = SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody ShelleyEra
txbody) [KeyPair 'Witness]
signers

utxoState :: UTxOState C
utxoState :: UTxOState ShelleyEra
utxoState =
  UTxO ShelleyEra
-> Coin
-> Coin
-> GovState ShelleyEra
-> InstantStake ShelleyEra
-> Coin
-> UTxOState ShelleyEra
forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
UTxOState
    ( TxId -> [TxOut ShelleyEra] -> UTxO ShelleyEra
forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins
        TxId
genesisId
        [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr Value ShelleyEra
Coin
aliceInitCoin
        , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
1000)
        ]
    )
    (Integer -> Coin
Coin Integer
0)
    (Integer -> Coin
Coin Integer
0)
    GovState ShelleyEra
ShelleyGovState ShelleyEra
forall a. Default a => a
def
    InstantStake ShelleyEra
ShelleyInstantStake ShelleyEra
forall a. Monoid a => a
mempty
    Coin
forall a. Monoid a => a
mempty

dpState :: CertState C
dpState :: CertState ShelleyEra
dpState = CertState ShelleyEra
ShelleyCertState ShelleyEra
forall a. Default a => a
def

ledgerState :: LedgerState C
ledgerState :: LedgerState ShelleyEra
ledgerState = UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState ShelleyEra
utxoState CertState ShelleyEra
dpState

addReward :: CertState C -> Credential 'Staking -> Coin -> CertState C
addReward :: CertState ShelleyEra
-> StakeCredential -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dp StakeCredential
ra Coin
c = CertState ShelleyEra
ShelleyCertState ShelleyEra
dp ShelleyCertState ShelleyEra
-> (ShelleyCertState 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))
-> ShelleyCertState ShelleyEra
-> Identity (ShelleyCertState ShelleyEra)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState ShelleyEra) (DState ShelleyEra)
certDStateL ((DState ShelleyEra -> Identity (DState ShelleyEra))
 -> ShelleyCertState ShelleyEra
 -> Identity (ShelleyCertState ShelleyEra))
-> ((UMap -> Identity UMap)
    -> DState ShelleyEra -> Identity (DState ShelleyEra))
-> (UMap -> Identity UMap)
-> ShelleyCertState ShelleyEra
-> Identity (ShelleyCertState ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Identity UMap)
-> DState ShelleyEra -> Identity (DState ShelleyEra)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL ((UMap -> Identity UMap)
 -> ShelleyCertState ShelleyEra
 -> Identity (ShelleyCertState ShelleyEra))
-> UMap
-> ShelleyCertState ShelleyEra
-> ShelleyCertState ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UMap
rewards'
  where
    ds :: DState ShelleyEra
ds = CertState ShelleyEra
ShelleyCertState ShelleyEra
dp ShelleyCertState ShelleyEra
-> Getting
     (DState ShelleyEra)
     (ShelleyCertState ShelleyEra)
     (DState ShelleyEra)
-> DState ShelleyEra
forall s a. s -> Getting a s a -> a
^. (DState ShelleyEra
 -> Const (DState ShelleyEra) (DState ShelleyEra))
-> CertState ShelleyEra
-> Const (DState ShelleyEra) (CertState ShelleyEra)
Getting
  (DState ShelleyEra)
  (ShelleyCertState ShelleyEra)
  (DState ShelleyEra)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState ShelleyEra) (DState ShelleyEra)
certDStateL
    rewards' :: UMap
rewards' = StakeCredential -> RDPair -> UView StakeCredential RDPair -> UMap
forall k v. k -> v -> UView k v -> UMap
UM.insert StakeCredential
ra (CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
UM.compactCoinOrError Coin
c) (Word64 -> CompactForm Coin
UM.CompactCoin Word64
2)) (DState ShelleyEra -> UView StakeCredential RDPair
forall era. DState era -> UView StakeCredential RDPair
rewards DState ShelleyEra
ds)

-- Any key deposit works in this test ^
ledgerEnv :: LedgerEnv C
ledgerEnv :: LedgerEnv ShelleyEra
ledgerEnv = SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams ShelleyEra
-> ChainAccountState
-> LedgerEnv ShelleyEra
forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
LedgerEnv (Word64 -> SlotNo
SlotNo Word64
0) Maybe EpochNo
forall a. Maybe a
Nothing TxIx
forall a. Bounded a => a
minBound PParams ShelleyEra
forall era. (EraPParams era, ProtVerAtMost era 4) => PParams era
pp (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))

testInvalidTx ::
  NonEmpty (PredicateFailure (ShelleyLEDGER C)) ->
  ShelleyTx C ->
  Assertion
testInvalidTx :: NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
errs ShelleyTx ShelleyEra
tx =
  HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
ledgerState ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
ledgerEnv (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. a -> Either a b
Left NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs)

testSpendNonexistentInput :: Assertion
testSpendNonexistentInput :: Assertion
testSpendNonexistentInput =
  NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
    [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure (Mismatch 'RelEQ (Value ShelleyEra)
-> ShelleyUtxoPredFailure ShelleyEra
forall era.
Mismatch 'RelEQ (Value era) -> ShelleyUtxoPredFailure era
ValueNotConservedUTxO (Mismatch 'RelEQ (Value ShelleyEra)
 -> ShelleyUtxoPredFailure ShelleyEra)
-> Mismatch 'RelEQ (Value ShelleyEra)
-> ShelleyUtxoPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
10000)))
    , PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
 -> ShelleyUtxowPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Set TxIn -> ShelleyUtxoPredFailure ShelleyEra
forall era. Set TxIn -> ShelleyUtxoPredFailure era
BadInputsUTxO (TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton (TxIn -> Set TxIn) -> TxIn -> Set TxIn
forall a b. (a -> b) -> a -> b
$ HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
42))
    ]
    (ShelleyTx ShelleyEra -> Assertion)
-> ShelleyTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> ShelleyTx ShelleyEra
aliceGivesBobLovelace
    (AliceToBob -> ShelleyTx ShelleyEra)
-> AliceToBob -> ShelleyTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ AliceToBob
      { $sel:input:AliceToBob :: TxIn
input = HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
42 -- Non Existent
      , $sel:toBob:AliceToBob :: Coin
toBob = Integer -> Coin
Coin Integer
3000
      , $sel:fee:AliceToBob :: Coin
fee = Integer -> Coin
Coin Integer
1500
      , $sel:deposits:AliceToBob :: Coin
deposits = Integer -> Coin
Coin Integer
0
      , $sel:refunds:AliceToBob :: Coin
refunds = Integer -> Coin
Coin Integer
0
      , $sel:certs:AliceToBob :: [TxCert ShelleyEra]
certs = []
      , $sel:ttl:AliceToBob :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
100
      , $sel:signers:AliceToBob :: [KeyPair 'Witness]
signers = [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
alicePay]
      }

testWitnessNotIncluded :: Assertion
testWitnessNotIncluded :: Assertion
testWitnessNotIncluded =
  let txbody :: TxBody ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
          ( [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
              [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
6404)
              , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
3000)
              ]
          )
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          (Integer -> Coin
Coin Integer
596)
          (Word64 -> SlotNo
SlotNo Word64
100)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txbody TxWits ShelleyEra
ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      txwits :: Set (KeyHash 'Witness)
txwits = KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton (KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> KeyHash 'Payment -> KeyHash 'Witness
forall a b. (a -> b) -> a -> b
$ VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> VKey 'Payment -> KeyHash 'Payment
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
alicePay)
   in NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
        [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure ShelleyEra
forall era. Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure era
MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
txwits
        ]
        ShelleyTx ShelleyEra
tx

testSpendNotOwnedUTxO :: Assertion
testSpendNotOwnedUTxO :: Assertion
testSpendNotOwnedUTxO =
  let txbody :: TxBody ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1])
          (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
232))
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          (Integer -> Coin
Coin Integer
768)
          (Word64 -> SlotNo
SlotNo Word64
100)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      aliceWit :: WitVKey 'Witness
aliceWit = SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody ShelleyEra
txbody) KeyPair 'Payment
alicePay
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txbody ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = Set.fromList [aliceWit]} StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      txwits :: Set (KeyHash 'Witness)
txwits = KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton (KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> KeyHash 'Payment -> KeyHash 'Witness
forall a b. (a -> b) -> a -> b
$ VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> VKey 'Payment -> KeyHash 'Payment
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
bobPay)
   in NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
        [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure ShelleyEra
forall era. Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure era
MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
txwits
        ]
        ShelleyTx ShelleyEra
tx

testWitnessWrongUTxO :: Assertion
testWitnessWrongUTxO :: Assertion
testWitnessWrongUTxO =
  let txbody :: TxBody ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1])
          (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
230))
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          (Integer -> Coin
Coin Integer
770)
          (Word64 -> SlotNo
SlotNo Word64
100)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      tx2body :: TxBody ShelleyEra
tx2body =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
1])
          (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
230))
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          (Integer -> Coin
Coin Integer
770)
          (Word64 -> SlotNo
SlotNo Word64
101)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      aliceWit :: WitVKey 'Witness
aliceWit = SafeHash EraIndependentTxBody
-> KeyPair 'Payment -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey (TxBody ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody ShelleyEra
tx2body) KeyPair 'Payment
alicePay
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txbody ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = Set.fromList [aliceWit]} StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      txwits :: Set (KeyHash 'Witness)
txwits = KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton (KeyHash 'Payment -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Payment -> KeyHash 'Witness)
-> KeyHash 'Payment -> KeyHash 'Witness
forall a b. (a -> b) -> a -> b
$ VKey 'Payment -> KeyHash 'Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Payment -> KeyHash 'Payment)
-> VKey 'Payment -> KeyHash 'Payment
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
bobPay)
   in NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
        [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            [VKey 'Witness] -> ShelleyUtxowPredFailure ShelleyEra
forall era. [VKey 'Witness] -> ShelleyUtxowPredFailure era
InvalidWitnessesUTXOW
              [VKey 'Payment -> VKey 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (VKey 'Payment -> VKey 'Witness) -> VKey 'Payment -> VKey 'Witness
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
alicePay]
        , PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure ShelleyEra
forall era. Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure era
MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
txwits
        ]
        ShelleyTx ShelleyEra
tx

testEmptyInputSet :: Assertion
testEmptyInputSet :: Assertion
testEmptyInputSet =
  let aliceWithdrawal :: Map RewardAccount Coin
aliceWithdrawal = RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton (Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
Testnet KeyPair 'Staking
aliceStake) (Integer -> Coin
Coin Integer
2000)
      txb :: TxBody ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          Set TxIn
forall a. Set a
Set.empty
          (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra))
-> TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
1000))
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
aliceWithdrawal)
          (Integer -> Coin
Coin Integer
1000)
          (Word64 -> SlotNo
SlotNo Word64
0)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      txwits :: ShelleyTxWits ShelleyEra
txwits = ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = mkWitnessesVKey (hashAnnotated txb) [aliceStake]}
      tx :: ShelleyTx ShelleyEra
tx = TxBody ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody ShelleyEra
txb TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      dpState' :: CertState ShelleyEra
dpState' = CertState ShelleyEra
-> StakeCredential -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dpState (RewardAccount -> StakeCredential
raCredential (RewardAccount -> StakeCredential)
-> RewardAccount -> StakeCredential
forall a b. (a -> b) -> a -> b
$ Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
Testnet KeyPair 'Staking
aliceStake) (Integer -> Coin
Coin Integer
2000)
   in HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER
        (UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState ShelleyEra
utxoState CertState ShelleyEra
ShelleyCertState ShelleyEra
dpState')
        ShelleyTx ShelleyEra
tx
        LedgerEnv ShelleyEra
ledgerEnv
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. a -> Either a b
Left [PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure PredicateFailure (EraRule "UTXO" ShelleyEra)
ShelleyUtxoPredFailure ShelleyEra
forall era. ShelleyUtxoPredFailure era
InputSetEmptyUTxO)])

testFeeTooSmall :: Assertion
testFeeTooSmall :: Assertion
testFeeTooSmall =
  NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
    [PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure (Mismatch 'RelGTEQ Coin -> ShelleyUtxoPredFailure ShelleyEra
forall era. Mismatch 'RelGTEQ Coin -> ShelleyUtxoPredFailure era
FeeTooSmallUTxO (Mismatch 'RelGTEQ Coin -> ShelleyUtxoPredFailure ShelleyEra)
-> Mismatch 'RelGTEQ Coin -> ShelleyUtxoPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Mismatch 'RelGTEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
1) (Integer -> Coin
Coin Integer
279)))]
    (ShelleyTx ShelleyEra -> Assertion)
-> ShelleyTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> ShelleyTx ShelleyEra
aliceGivesBobLovelace
      AliceToBob
        { $sel:input:AliceToBob :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
        , $sel:toBob:AliceToBob :: Coin
toBob = Integer -> Coin
Coin Integer
3000
        , $sel:fee:AliceToBob :: Coin
fee = Integer -> Coin
Coin Integer
1
        , $sel:deposits:AliceToBob :: Coin
deposits = Integer -> Coin
Coin Integer
0
        , $sel:refunds:AliceToBob :: Coin
refunds = Integer -> Coin
Coin Integer
0
        , $sel:certs:AliceToBob :: [TxCert ShelleyEra]
certs = []
        , $sel:ttl:AliceToBob :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
100
        , $sel:signers:AliceToBob :: [KeyPair 'Witness]
signers = [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
alicePay]
        }

testExpiredTx :: Assertion
testExpiredTx :: Assertion
testExpiredTx =
  let errs :: NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs =
        [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure (Mismatch 'RelLTEQ SlotNo -> ShelleyUtxoPredFailure ShelleyEra
forall era. Mismatch 'RelLTEQ SlotNo -> ShelleyUtxoPredFailure era
ExpiredUTxO (Mismatch 'RelLTEQ SlotNo -> ShelleyUtxoPredFailure ShelleyEra)
-> Mismatch 'RelLTEQ SlotNo -> ShelleyUtxoPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ SlotNo -> SlotNo -> Mismatch 'RelLTEQ SlotNo
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}) (SlotNo {unSlotNo :: Word64
unSlotNo = Word64
1})))
        ]
      tx :: ShelleyTx ShelleyEra
tx =
        AliceToBob -> ShelleyTx ShelleyEra
aliceGivesBobLovelace (AliceToBob -> ShelleyTx ShelleyEra)
-> AliceToBob -> ShelleyTx ShelleyEra
forall a b. (a -> b) -> a -> b
$
          AliceToBob
            { $sel:input:AliceToBob :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
            , $sel:toBob:AliceToBob :: Coin
toBob = Integer -> Coin
Coin Integer
3000
            , $sel:fee:AliceToBob :: Coin
fee = Integer -> Coin
Coin Integer
600
            , $sel:deposits:AliceToBob :: Coin
deposits = Integer -> Coin
Coin Integer
0
            , $sel:refunds:AliceToBob :: Coin
refunds = Integer -> Coin
Coin Integer
0
            , $sel:certs:AliceToBob :: [TxCert ShelleyEra]
certs = []
            , $sel:ttl:AliceToBob :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
0
            , $sel:signers:AliceToBob :: [KeyPair 'Witness]
signers = [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
alicePay]
            }
      ledgerEnv' :: LedgerEnv ShelleyEra
ledgerEnv' = SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams ShelleyEra
-> ChainAccountState
-> LedgerEnv ShelleyEra
forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
LedgerEnv (Word64 -> SlotNo
SlotNo Word64
1) Maybe EpochNo
forall a. Maybe a
Nothing TxIx
forall a. Bounded a => a
minBound PParams ShelleyEra
forall era. (EraPParams era, ProtVerAtMost era 4) => PParams era
pp (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))
   in HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
ledgerState ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
ledgerEnv' (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. a -> Either a b
Left NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs)

testInvalidWintess :: Assertion
testInvalidWintess :: Assertion
testInvalidWintess =
  let txb :: TxBody ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
          ( [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
              [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
6000)
              , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
3000)
              ]
          )
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          (Integer -> Coin
Coin Integer
1000)
          (Word64 -> SlotNo
SlotNo Word64
1)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      txb' :: TxBody ShelleyEra
txb' = TxBody ShelleyEra
txb {stbTTL = SlotNo 2}
      txwits :: Cardano.Ledger.Shelley.TxWits.ShelleyTxWits C
      txwits :: ShelleyTxWits ShelleyEra
txwits = ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = mkWitnessesVKey (hashAnnotated txb') [alicePay]}
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txb TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      errs :: NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs =
        [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            [VKey 'Witness] -> ShelleyUtxowPredFailure ShelleyEra
forall era. [VKey 'Witness] -> ShelleyUtxowPredFailure era
InvalidWitnessesUTXOW
              [VKey 'Payment -> VKey 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (VKey 'Payment -> VKey 'Witness) -> VKey 'Payment -> VKey 'Witness
forall a b. (a -> b) -> a -> b
$ KeyPair 'Payment -> VKey 'Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
alicePay]
        ]
   in HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
ledgerState ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
ledgerEnv (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. a -> Either a b
Left NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs)

testWithdrawalNoWit :: Assertion
testWithdrawalNoWit :: Assertion
testWithdrawalNoWit =
  let txb :: TxBody ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
          ( [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
              [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
6000)
              , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
3010)
              ]
          )
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$ RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton (Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
Testnet KeyPair 'Staking
bobStake) (Integer -> Coin
Coin Integer
10))
          (Integer -> Coin
Coin Integer
1000)
          (Word64 -> SlotNo
SlotNo Word64
0)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      txwits :: ShelleyTxWits C
      txwits :: ShelleyTxWits ShelleyEra
txwits = ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = Set.singleton $ mkWitnessVKey (hashAnnotated txb) alicePay}
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txb TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      missing :: Set (KeyHash 'Witness)
missing = KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton (KeyHash 'Staking -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash 'Staking -> KeyHash 'Witness)
-> KeyHash 'Staking -> KeyHash 'Witness
forall a b. (a -> b) -> a -> b
$ VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking -> KeyHash 'Staking
forall a b. (a -> b) -> a -> b
$ KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
bobStake)
      errs :: NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs =
        [ PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure ShelleyEra
forall era. Set (KeyHash 'Witness) -> ShelleyUtxowPredFailure era
MissingVKeyWitnessesUTXOW Set (KeyHash 'Witness)
missing
        ]
      dpState' :: CertState ShelleyEra
dpState' = CertState ShelleyEra
-> StakeCredential -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dpState (RewardAccount -> StakeCredential
raCredential (RewardAccount -> StakeCredential)
-> RewardAccount -> StakeCredential
forall a b. (a -> b) -> a -> b
$ Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
Testnet KeyPair 'Staking
bobStake) (Integer -> Coin
Coin Integer
10)
   in HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER (UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState ShelleyEra
utxoState CertState ShelleyEra
ShelleyCertState ShelleyEra
dpState') ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
ledgerEnv (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. a -> Either a b
Left NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs)

testWithdrawalWrongAmt :: Assertion
testWithdrawalWrongAmt :: Assertion
testWithdrawalWrongAmt =
  let txb :: TxBody ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
          ( [ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
              [ Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr (Integer -> Coin
Coin Integer
6000)
              , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
3011)
              ]
          )
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$ RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton (Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
Testnet KeyPair 'Staking
bobStake) (Integer -> Coin
Coin Integer
11))
          (Integer -> Coin
Coin Integer
1000)
          (Word64 -> SlotNo
SlotNo Word64
0)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      txwits :: ShelleyTxWits ShelleyEra
txwits =
        ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty
          { addrWits =
              mkWitnessesVKey
                (hashAnnotated txb)
                [asWitness alicePay, asWitness bobStake]
          }
      rAccount :: RewardAccount
rAccount = Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
Testnet KeyPair 'Staking
bobStake
      dpState' :: CertState ShelleyEra
dpState' = CertState ShelleyEra
-> StakeCredential -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dpState (RewardAccount -> StakeCredential
raCredential RewardAccount
rAccount) (Integer -> Coin
Coin Integer
10)
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txb TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      errs :: NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs = [PredicateFailure (EraRule "DELEGS" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (Map RewardAccount Coin -> ShelleyDelegsPredFailure ShelleyEra
forall era. Map RewardAccount Coin -> ShelleyDelegsPredFailure era
WithdrawalsNotInRewardsDELEGS (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rAccount (Integer -> Coin
Coin Integer
11)))]
   in HasCallStack =>
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> ShelleyTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER (UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState UTxOState ShelleyEra
utxoState CertState ShelleyEra
ShelleyCertState ShelleyEra
dpState') ShelleyTx ShelleyEra
tx LedgerEnv ShelleyEra
ledgerEnv (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a b. a -> Either a b
Left NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs)

testOutputTooSmall :: Assertion
testOutputTooSmall :: Assertion
testOutputTooSmall =
  NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
    [PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
UtxowFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
UtxoFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
 -> ShelleyUtxowPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$ [TxOut ShelleyEra] -> ShelleyUtxoPredFailure ShelleyEra
forall era. [TxOut era] -> ShelleyUtxoPredFailure era
OutputTooSmallUTxO [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
1)])]
    (ShelleyTx ShelleyEra -> Assertion)
-> ShelleyTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> ShelleyTx ShelleyEra
aliceGivesBobLovelace
    (AliceToBob -> ShelleyTx ShelleyEra)
-> AliceToBob -> ShelleyTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ AliceToBob
      { $sel:input:AliceToBob :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
      , $sel:toBob:AliceToBob :: Coin
toBob = Integer -> Coin
Coin Integer
1 -- Too Small
      , $sel:fee:AliceToBob :: Coin
fee = Integer -> Coin
Coin Integer
997
      , $sel:deposits:AliceToBob :: Coin
deposits = Integer -> Coin
Coin Integer
0
      , $sel:refunds:AliceToBob :: Coin
refunds = Integer -> Coin
Coin Integer
0
      , $sel:certs:AliceToBob :: [TxCert ShelleyEra]
certs = []
      , $sel:ttl:AliceToBob :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
0
      , $sel:signers:AliceToBob :: [KeyPair 'Witness]
signers = [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
alicePay]
      }

alicePoolColdKeys :: KeyPair 'StakePool
alicePoolColdKeys :: KeyPair 'StakePool
alicePoolColdKeys = VKey 'StakePool -> SignKeyDSIGN DSIGN -> KeyPair 'StakePool
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey 'StakePool
forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
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)

alicePoolParamsSmallCost :: PoolParams
alicePoolParamsSmallCost :: PoolParams
alicePoolParamsSmallCost =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = VKey 'StakePool -> KeyHash 'StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'StakePool -> KeyHash 'StakePool)
-> VKey 'StakePool -> KeyHash 'StakePool
forall a b. (a -> b) -> a -> b
$ KeyPair 'StakePool -> VKey 'StakePool
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'StakePool
alicePoolColdKeys
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto VerKeyVRF (VRF MockCrypto)
VerKeyVRF FakeVRF
vkVrf
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
1
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
5 -- Too Small!
    , ppMargin :: UnitInterval
ppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet (KeyHash 'Staking -> StakeCredential
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> StakeCredential)
-> (KeyPair 'Staking -> KeyHash 'Staking)
-> KeyPair 'Staking
-> StakeCredential
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)
-> (KeyPair 'Staking -> VKey 'Staking)
-> KeyPair 'Staking
-> KeyHash 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair 'Staking -> StakeCredential)
-> KeyPair 'Staking -> StakeCredential
forall a b. (a -> b) -> a -> b
$ KeyPair 'Staking
aliceStake)
    , ppOwners :: Set (KeyHash 'Staking)
ppOwners = KeyHash 'Staking -> Set (KeyHash 'Staking)
forall a. a -> Set a
Set.singleton (KeyHash 'Staking -> Set (KeyHash 'Staking))
-> KeyHash 'Staking -> Set (KeyHash 'Staking)
forall a b. (a -> b) -> a -> b
$ (VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> (KeyPair 'Staking -> VKey 'Staking)
-> KeyPair 'Staking
-> KeyHash 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey) KeyPair 'Staking
aliceStake
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata =
        PoolMetadata -> StrictMaybe PoolMetadata
forall a. a -> StrictMaybe a
SJust (PoolMetadata -> StrictMaybe PoolMetadata)
-> PoolMetadata -> StrictMaybe PoolMetadata
forall a b. (a -> b) -> a -> b
$
          PoolMetadata
            { pmUrl :: Url
pmUrl = Maybe Url -> Url
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"alice.pool"
            , pmHash :: ByteString
pmHash = TestName -> ByteString
BS.pack TestName
"{}"
            }
    }
  where
    vkVrf :: VerKeyVRF (VRF MockCrypto)
vkVrf = VRFKeyPair MockCrypto -> VerKeyVRF (VRF MockCrypto)
forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey (VRFKeyPair MockCrypto -> VerKeyVRF (VRF MockCrypto))
-> VRFKeyPair MockCrypto -> VerKeyVRF (VRF MockCrypto)
forall a b. (a -> b) -> a -> b
$ forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair @MockCrypto (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
2)

testPoolCostTooSmall :: Assertion
testPoolCostTooSmall :: Assertion
testPoolCostTooSmall =
  NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> ShelleyTx ShelleyEra -> Assertion
testInvalidTx
    [ PredicateFailure (EraRule "DELEGS" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (PredicateFailure (EraRule "DELEGS" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "DELEGS" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "DELPL" ShelleyEra)
-> ShelleyDelegsPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure (PredicateFailure (EraRule "DELPL" ShelleyEra)
 -> ShelleyDelegsPredFailure ShelleyEra)
-> PredicateFailure (EraRule "DELPL" ShelleyEra)
-> ShelleyDelegsPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "POOL" ShelleyEra)
-> ShelleyDelplPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "POOL" era)
-> ShelleyDelplPredFailure era
PoolFailure (PredicateFailure (EraRule "POOL" ShelleyEra)
 -> ShelleyDelplPredFailure ShelleyEra)
-> PredicateFailure (EraRule "POOL" ShelleyEra)
-> ShelleyDelplPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure ShelleyEra
forall era. Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure era
StakePoolCostTooLowPOOL (Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure ShelleyEra)
-> Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
              Coin -> Coin -> Mismatch 'RelGTEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (PoolParams -> Coin
ppCost PoolParams
alicePoolParamsSmallCost) (forall era. (EraPParams era, ProtVerAtMost era 4) => PParams era
pp @C PParams ShelleyEra
-> Getting Coin (PParams ShelleyEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ShelleyEra) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppMinPoolCostL)
    ]
    (ShelleyTx ShelleyEra -> Assertion)
-> ShelleyTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> ShelleyTx ShelleyEra
aliceGivesBobLovelace
    (AliceToBob -> ShelleyTx ShelleyEra)
-> AliceToBob -> ShelleyTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ AliceToBob
      { $sel:input:AliceToBob :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
      , $sel:toBob:AliceToBob :: Coin
toBob = Integer -> Coin
Coin Integer
100
      , $sel:fee:AliceToBob :: Coin
fee = Integer -> Coin
Coin Integer
997
      , $sel:deposits:AliceToBob :: Coin
deposits = Integer -> Coin
Coin Integer
250
      , $sel:refunds:AliceToBob :: Coin
refunds = Integer -> Coin
Coin Integer
0
      , $sel:certs:AliceToBob :: [TxCert ShelleyEra]
certs = [PoolCert -> ShelleyTxCert ShelleyEra
forall era. PoolCert -> ShelleyTxCert era
ShelleyTxCertPool (PoolCert -> ShelleyTxCert ShelleyEra)
-> PoolCert -> ShelleyTxCert ShelleyEra
forall a b. (a -> b) -> a -> b
$ PoolParams -> PoolCert
RegPool PoolParams
alicePoolParamsSmallCost]
      , $sel:ttl:AliceToBob :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
0
      , $sel:signers:AliceToBob :: [KeyPair 'Witness]
signers =
          ( [ KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
alicePay
            , KeyPair 'Staking -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Staking
aliceStake
            , KeyPair 'StakePool -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'StakePool
alicePoolColdKeys
            ]
          )
      }

testProducedOverMaxWord64 :: Assertion
testProducedOverMaxWord64 :: Assertion
testProducedOverMaxWord64 =
  let biggestCoin :: Integer
biggestCoin = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)
      txbody :: TxBody ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
          ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound])
          ([ShelleyTxOut ShelleyEra] -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
biggestCoin)])
          StrictSeq (TxCert ShelleyEra)
StrictSeq (ShelleyTxCert ShelleyEra)
forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall k a. Map k a
Map.empty)
          (Integer -> Coin
Coin Integer
1) -- @produced@ will return biggestCoin + 1, which is > 2^64.
          (Word64 -> SlotNo
SlotNo Word64
100)
          StrictMaybe (Update ShelleyEra)
forall a. StrictMaybe a
SNothing
          StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
      txwits :: ShelleyTxWits ShelleyEra
txwits = ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = mkWitnessesVKey (hashAnnotated txbody) [alicePay]}
      tx :: ShelleyTx ShelleyEra
tx = forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C TxBody ShelleyEra
txbody TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      st :: Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st =
        ShelleyBase
  (Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState ShelleyEra)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase
   (Either
      (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
      (LedgerState ShelleyEra))
 -> Either
      (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
      (LedgerState ShelleyEra))
-> ShelleyBase
     (Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
-> Either
     (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
     (LedgerState 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 @(ShelleyLEDGER C) ((Environment (ShelleyLEDGER ShelleyEra),
 State (ShelleyLEDGER ShelleyEra),
 Signal (ShelleyLEDGER ShelleyEra))
-> TRC (ShelleyLEDGER ShelleyEra)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv ShelleyEra
Environment (ShelleyLEDGER ShelleyEra)
ledgerEnv, State (ShelleyLEDGER ShelleyEra)
LedgerState ShelleyEra
ledgerState, ShelleyTx ShelleyEra
Signal (ShelleyLEDGER ShelleyEra)
tx))
   in -- We test that the predicate failure does not return bottom
      () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Assertion) -> () -> Assertion
forall a b. (a -> b) -> a -> b
$! Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
-> ()
forall a. NFData a => a -> ()
rnf Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st

testsInvalidLedger :: TestTree
testsInvalidLedger :: TestTree
testsInvalidLedger =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Tests with invalid transactions in ledger"
    [ TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice tries to spend a nonexistent input" Assertion
testSpendNonexistentInput
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice does not include a witness" Assertion
testWitnessNotIncluded
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice tries to spend Bob's UTxO" Assertion
testSpendNotOwnedUTxO
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice provides witness of wrong UTxO" Assertion
testWitnessWrongUTxO
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice's transaction does not consume input" Assertion
testEmptyInputSet
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice's fee is too small" Assertion
testFeeTooSmall
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Alice's transaction has expired" Assertion
testExpiredTx
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Invalid witnesses" Assertion
testInvalidWintess
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - No withdrawal witness" Assertion
testWithdrawalNoWit
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - Incorrect withdrawal amount" Assertion
testWithdrawalWrongAmt
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - OutputTooSmall" Assertion
testOutputTooSmall
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - PoolCostTooSmall" Assertion
testPoolCostTooSmall
    , TestName -> Assertion -> TestTree
testCase TestName
"Invalid Ledger - ProducedOverMaxWord64" Assertion
testProducedOverMaxWord64
    ]

unitTests :: TestTree
unitTests :: TestTree
unitTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Unit Tests"
    [ Item [TestTree]
TestTree
testsInvalidLedger
    , Item [TestTree]
TestTree
testsPParams
    , Item [TestTree]
TestTree
sizeTests
    , Item [TestTree]
TestTree
forall v. (v ~ VRF StandardCrypto) => TestTree
testCheckLeaderVal
    ]