{-# 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 (..), Ptr (..), SlotNo32 (..), StakeReference (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley (ShelleyEra)
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 (..), Tx (..))
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 Cardano.Ledger.Val (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 (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 Test.QuickCheck ((===), (==>))
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 hiding (Witness)

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

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 -> Credential Payment -> StakeReference -> Addr
Addr
    Network
Testnet
    (KeyHash Payment -> Credential Payment
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Payment -> Credential Payment)
-> (VKey Payment -> KeyHash Payment)
-> VKey Payment
-> Credential Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Payment -> KeyHash Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Payment -> Credential Payment)
-> VKey Payment -> Credential Payment
forall a b. (a -> b) -> a -> b
$ KeyPair Payment -> VKey Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair Payment
alicePay)
    (Credential Staking -> StakeReference
StakeRefBase (Credential Staking -> StakeReference)
-> (VKey Staking -> Credential Staking)
-> VKey Staking
-> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> (VKey Staking -> KeyHash Staking)
-> VKey Staking
-> Credential Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Staking -> 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 -> Credential Payment -> StakeReference -> Addr
Addr
    Network
Testnet
    (KeyHash Payment -> Credential Payment
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Payment -> Credential Payment)
-> (VKey Payment -> KeyHash Payment)
-> VKey Payment
-> Credential Payment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Payment -> KeyHash Payment
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Payment -> Credential Payment)
-> VKey Payment -> Credential Payment
forall a b. (a -> b) -> a -> b
$ KeyPair Payment -> VKey Payment
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair Payment
bobPay)
    (Credential Staking -> StakeReference
StakeRefBase (Credential Staking -> StakeReference)
-> (VKey Staking -> Credential Staking)
-> VKey Staking
-> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> (VKey Staking -> KeyHash Staking)
-> VKey Staking
-> Credential Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Staking -> 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, AtMostEra "Mary" era) => PParams era
pp :: forall era. (EraPParams era, AtMostEra "Mary" era) => 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, HasCallStack) =>
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, AtMostEra "Mary" era) =>
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. (HasCallStack, Show a, Eq a) => a -> a -> Assertion
@?= Bool
True

testsPParams :: TestTree
testsPParams :: SpecWith ()
testsPParams =
  String -> [SpecWith ()] -> SpecWith ()
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Test the protocol parameters."
    [ HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"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) => SpecWith ()
testCheckLeaderVal =
  String -> [SpecWith ()] -> SpecWith ()
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Test checkLeaderVal calculation"
    [ String -> (VRFNatVal -> ASC -> Bool) -> SpecWith ()
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> SpecWith ()
testProperty String
"With a stake of 0, cannot lead" ((VRFNatVal -> ASC -> Bool) -> SpecWith ())
-> (VRFNatVal -> ASC -> Bool) -> SpecWith ()
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
    , String -> (ASC -> StakeProportion -> Bool) -> SpecWith ()
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> SpecWith ()
testProperty String
"With a maximal VRF, cannot lead" ((ASC -> StakeProportion -> Bool) -> SpecWith ())
-> (ASC -> StakeProportion -> Bool) -> SpecWith ()
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
    , String
-> (VRFNatVal -> ASC -> StakeProportion -> Property) -> SpecWith ()
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> SpecWith ()
testProperty String
"checkLeaderVal succeeds iff l < 1 - (1-f)^r" ((VRFNatVal -> ASC -> StakeProportion -> Property) -> SpecWith ())
-> (VRFNatVal -> ASC -> StakeProportion -> Property) -> SpecWith ()
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.
      --
      String -> Property -> SpecWith ()
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> SpecWith ()
testProperty String
"We are elected as leader proportional to our stake" (Property -> SpecWith ()) -> Property -> SpecWith ()
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 f <- Gen ASC
forall a. Arbitrary a => Gen a
arbitrary
          StakeProportion r <- arbitrary
          vrfVals <- QC.vectorOf numTrials (QC.choose (0, fromIntegral maxVRFVal :: Integer))
          let 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
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
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 = 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 = 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 = 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
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 = [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
          pure $
            r > 0 ==>
              counterexample
                (show lb <> " /< " <> show s <> " /< " <> show ub <> " (p=" <> show p <> ")")
                (lb < s && s < 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 ShelleyEra ->
  Tx TopTx ShelleyEra ->
  LedgerEnv ShelleyEra ->
  Either (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))) (LedgerState ShelleyEra) ->
  Assertion
testLEDGER :: HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
initSt Tx TopTx 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 ShelleyEra) 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
      -> Tx TopTx ShelleyEra
      -> Either
           (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
           (LedgerState ShelleyEra))
     IO
     (LedgerState ShelleyEra)
forall a.
a
-> ReaderT
     (LedgerState ShelleyEra
      -> Tx TopTx ShelleyEra
      -> Either
           (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
           (LedgerState ShelleyEra))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerState ShelleyEra
initSt ReaderT
  (LedgerState ShelleyEra
   -> Tx TopTx ShelleyEra
   -> Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
  IO
  (LedgerState ShelleyEra)
-> Tx TopTx ShelleyEra
-> ReaderT
     (LedgerState ShelleyEra
      -> Tx TopTx 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
.- Tx TopTx ShelleyEra
tx ReaderT
  (LedgerState ShelleyEra
   -> Tx TopTx ShelleyEra
   -> Either
        (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
        (LedgerState ShelleyEra))
  IO
  (LedgerState ShelleyEra)
-> LedgerState ShelleyEra
-> ReaderT
     (LedgerState ShelleyEra
      -> Tx TopTx 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 Tx TopTx 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 ShelleyEra) ((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, Tx TopTx 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. (HasCallStack, Show a, Eq a) => 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 ShelleyEra]
  , AliceToBob -> SlotNo
ttl :: SlotNo
  , AliceToBob -> [KeyPair Witness]
signers :: [KeyPair Witness]
  }

aliceGivesBobLovelace :: AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace :: AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace
  AliceToBob
    { TxIn
input :: AliceToBob -> TxIn
input :: TxIn
input
    , Coin
toBob :: AliceToBob -> Coin
toBob :: Coin
toBob
    , Coin
fee :: AliceToBob -> Coin
fee :: Coin
fee
    , Coin
deposits :: AliceToBob -> Coin
deposits :: Coin
deposits
    , Coin
refunds :: AliceToBob -> Coin
refunds :: Coin
refunds
    , [TxCert ShelleyEra]
certs :: AliceToBob -> [TxCert ShelleyEra]
certs :: [TxCert ShelleyEra]
certs
    , SlotNo
ttl :: AliceToBob -> SlotNo
ttl :: SlotNo
ttl
    , [KeyPair Witness]
signers :: AliceToBob -> [KeyPair Witness]
signers :: [KeyPair Witness]
signers
    } = ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx (ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ TxBody TopTx ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx TopTx ShelleyEra
forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx TxBody TopTx 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 TopTx ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody TopTx ShelleyEra
txbody) [KeyPair Witness]
signers

utxoState :: UTxOState ShelleyEra
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 ShelleyEra
dpState :: CertState ShelleyEra
dpState = CertState ShelleyEra
ShelleyCertState ShelleyEra
forall a. Default a => a
def

ledgerState :: LedgerState ShelleyEra
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 ShelleyEra -> Credential Staking -> Coin -> CertState ShelleyEra
addReward :: CertState ShelleyEra
-> Credential Staking -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dp Credential Staking
cred 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))
-> ((ShelleyAccounts ShelleyEra
     -> Identity (ShelleyAccounts ShelleyEra))
    -> DState ShelleyEra -> Identity (DState ShelleyEra))
-> (ShelleyAccounts ShelleyEra
    -> Identity (ShelleyAccounts ShelleyEra))
-> ShelleyCertState ShelleyEra
-> Identity (ShelleyCertState ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts ShelleyEra -> Identity (Accounts ShelleyEra))
-> DState ShelleyEra -> Identity (DState ShelleyEra)
(ShelleyAccounts ShelleyEra
 -> Identity (ShelleyAccounts ShelleyEra))
-> DState ShelleyEra -> Identity (DState ShelleyEra)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
      ((ShelleyAccounts ShelleyEra
  -> Identity (ShelleyAccounts ShelleyEra))
 -> ShelleyCertState ShelleyEra
 -> Identity (ShelleyCertState ShelleyEra))
-> (ShelleyAccounts ShelleyEra -> ShelleyAccounts ShelleyEra)
-> ShelleyCertState ShelleyEra
-> ShelleyCertState ShelleyEra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (Credential Staking) (CompactForm Coin)
-> Accounts ShelleyEra -> Accounts ShelleyEra
forall era.
EraAccounts era =>
Map (Credential Staking) (CompactForm Coin)
-> Accounts era -> Accounts era
addToBalanceAccounts (Credential Staking
-> CompactForm Coin -> Map (Credential Staking) (CompactForm Coin)
forall k a. k -> a -> Map k a
Map.singleton Credential Staking
cred (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
c))
        (Accounts ShelleyEra -> ShelleyAccounts ShelleyEra)
-> (ShelleyAccounts ShelleyEra -> Accounts ShelleyEra)
-> ShelleyAccounts ShelleyEra
-> ShelleyAccounts ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Accounts ShelleyEra
-> Accounts ShelleyEra
forall era.
ShelleyEraAccounts era =>
Credential Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Accounts era
-> Accounts era
registerShelleyAccount Credential Staking
cred Ptr
ptr (Word64 -> CompactForm Coin
CompactCoin Word64
2) Maybe (KeyHash StakePool)
forall a. Maybe a
Nothing
  where
    ptr :: Ptr
ptr = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
45) (HasCallStack => Integer -> TxIx
Integer -> TxIx
mkTxIxPartial Integer
1234) (HasCallStack => Integer -> CertIx
Integer -> CertIx
mkCertIxPartial Integer
12)

-- Any key deposit works in this test ^
ledgerEnv :: LedgerEnv ShelleyEra
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, AtMostEra "Mary" era) => PParams era
pp (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))

testInvalidTx ::
  NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)) ->
  Tx TopTx ShelleyEra ->
  Assertion
testInvalidTx :: NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
-> Tx TopTx ShelleyEra -> Assertion
testInvalidTx NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))
errs Tx TopTx ShelleyEra
tx =
  HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
ledgerState Tx TopTx 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))
-> Tx TopTx 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))
    ]
    (Tx TopTx ShelleyEra -> Assertion)
-> Tx TopTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace
    (AliceToBob -> Tx TopTx ShelleyEra)
-> AliceToBob -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ AliceToBob
      { input :: TxIn
input = HasCallStack => Integer -> TxIn
Integer -> TxIn
mkGenesisTxIn Integer
42 -- Non Existent
      , toBob :: Coin
toBob = Integer -> Coin
Coin Integer
3000
      , fee :: Coin
fee = Integer -> Coin
Coin Integer
1500
      , deposits :: Coin
deposits = Integer -> Coin
Coin Integer
0
      , refunds :: Coin
refunds = Integer -> Coin
Coin Integer
0
      , certs :: [TxCert ShelleyEra]
certs = []
      , ttl :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
100
      , signers :: [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 TopTx ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra
tx = forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx 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))
-> Tx TopTx 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 TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx ShelleyTx TopTx ShelleyEra
tx)

testSpendNotOwnedUTxO :: Assertion
testSpendNotOwnedUTxO :: Assertion
testSpendNotOwnedUTxO =
  let txbody :: TxBody TopTx ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody TopTx ShelleyEra
txbody) KeyPair Payment
alicePay
      tx :: Tx TopTx ShelleyEra
tx = ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx (ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx 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))
-> Tx TopTx 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
        ]
        Tx TopTx ShelleyEra
tx

testWitnessWrongUTxO :: Assertion
testWitnessWrongUTxO :: Assertion
testWitnessWrongUTxO =
  let txbody :: TxBody TopTx ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra
tx2body =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody TopTx ShelleyEra
tx2body) KeyPair Payment
alicePay
      tx :: ShelleyTx TopTx ShelleyEra
tx = forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx 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))
-> Tx TopTx 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 TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx ShelleyTx TopTx 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 TopTx ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra
tx = TxBody TopTx ShelleyEra
-> TxWits ShelleyEra
-> StrictMaybe (TxAuxData ShelleyEra)
-> ShelleyTx TopTx ShelleyEra
forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx TxBody TopTx ShelleyEra
txb TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      dpState' :: CertState ShelleyEra
dpState' = CertState ShelleyEra
-> Credential Staking -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dpState (RewardAccount -> Credential Staking
raCredential (RewardAccount -> Credential Staking)
-> RewardAccount -> Credential Staking
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
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> Tx TopTx 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 TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx ShelleyTx TopTx 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))
-> Tx TopTx 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)))]
    (Tx TopTx ShelleyEra -> Assertion)
-> Tx TopTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace
      AliceToBob
        { input :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
        , toBob :: Coin
toBob = Integer -> Coin
Coin Integer
3000
        , fee :: Coin
fee = Integer -> Coin
Coin Integer
1
        , deposits :: Coin
deposits = Integer -> Coin
Coin Integer
0
        , refunds :: Coin
refunds = Integer -> Coin
Coin Integer
0
        , certs :: [TxCert ShelleyEra]
certs = []
        , ttl :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
100
        , signers :: [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 :: Tx TopTx ShelleyEra
tx =
        AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace (AliceToBob -> Tx TopTx ShelleyEra)
-> AliceToBob -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$
          AliceToBob
            { input :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
            , toBob :: Coin
toBob = Integer -> Coin
Coin Integer
3000
            , fee :: Coin
fee = Integer -> Coin
Coin Integer
600
            , deposits :: Coin
deposits = Integer -> Coin
Coin Integer
0
            , refunds :: Coin
refunds = Integer -> Coin
Coin Integer
0
            , certs :: [TxCert ShelleyEra]
certs = []
            , ttl :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
0
            , signers :: [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, AtMostEra "Mary" era) => PParams era
pp (Coin -> Coin -> ChainAccountState
ChainAccountState (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0))
   in HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
ledgerState Tx TopTx 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 TopTx ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra
txb' = TxBody TopTx ShelleyEra
txb {stbTTL = SlotNo 2}
      txwits :: Cardano.Ledger.Shelley.TxWits.ShelleyTxWits ShelleyEra
      txwits :: ShelleyTxWits ShelleyEra
txwits = ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = mkWitnessesVKey (hashAnnotated txb') [alicePay]}
      tx :: ShelleyTx TopTx ShelleyEra
tx = forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx 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
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
testLEDGER LedgerState ShelleyEra
ledgerState (ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx ShelleyTx TopTx 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 TopTx ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 ShelleyEra
      txwits :: ShelleyTxWits ShelleyEra
txwits = ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty {addrWits = Set.singleton $ mkWitnessVKey (hashAnnotated txb) alicePay}
      tx :: ShelleyTx TopTx ShelleyEra
tx = forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx 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
-> Credential Staking -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dpState (RewardAccount -> Credential Staking
raCredential (RewardAccount -> Credential Staking)
-> RewardAccount -> Credential Staking
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
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> Tx TopTx 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 TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx ShelleyTx TopTx 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 TopTx ShelleyEra
txb =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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
-> Credential Staking -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dpState (RewardAccount -> Credential Staking
raCredential RewardAccount
rAccount) (Integer -> Coin
Coin Integer
10)
      tx :: Tx TopTx ShelleyEra
tx = ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx (ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> ShelleyTx TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx ShelleyEra
txb TxWits ShelleyEra
ShelleyTxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
StrictMaybe (ShelleyTxAuxData ShelleyEra)
forall a. StrictMaybe a
SNothing
      errs :: NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
errs =
        [ Map RewardAccount (Mismatch RelEQ Coin)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
Map RewardAccount (Mismatch RelEQ Coin)
-> ShelleyLedgerPredFailure era
ShelleyIncompleteWithdrawals
            [(RewardAccount
rAccount, Coin -> Coin -> Mismatch RelEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (Integer -> Coin
Coin Integer
11) (Integer -> Coin
Coin Integer
10))]
        ]
   in HasCallStack =>
LedgerState ShelleyEra
-> Tx TopTx ShelleyEra
-> LedgerEnv ShelleyEra
-> Either
     (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)))
     (LedgerState ShelleyEra)
-> Assertion
LedgerState ShelleyEra
-> Tx TopTx 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') Tx TopTx 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))
-> Tx TopTx 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)])]
    (Tx TopTx ShelleyEra -> Assertion)
-> Tx TopTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace
    (AliceToBob -> Tx TopTx ShelleyEra)
-> AliceToBob -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ AliceToBob
      { input :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
      , toBob :: Coin
toBob = Integer -> Coin
Coin Integer
1 -- Too Small
      , fee :: Coin
fee = Integer -> Coin
Coin Integer
997
      , deposits :: Coin
deposits = Integer -> Coin
Coin Integer
0
      , refunds :: Coin
refunds = Integer -> Coin
Coin Integer
0
      , certs :: [TxCert ShelleyEra]
certs = []
      , ttl :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
0
      , signers :: [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)

aliceStakePoolParamsSmallCost :: StakePoolParams
aliceStakePoolParamsSmallCost :: StakePoolParams
aliceStakePoolParamsSmallCost =
  StakePoolParams
    { sppId :: KeyHash StakePool
sppId = 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
    , sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto VerKeyVRF (VRF MockCrypto)
VerKeyVRF FakeVRF
vkVrf
    , sppPledge :: Coin
sppPledge = Integer -> Coin
Coin Integer
1
    , sppCost :: Coin
sppCost = Integer -> Coin
Coin Integer
5 -- Too Small!
    , sppMargin :: UnitInterval
sppMargin = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , sppRewardAccount :: RewardAccount
sppRewardAccount = Network -> Credential Staking -> RewardAccount
RewardAccount Network
Testnet (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> (KeyPair Staking -> KeyHash Staking)
-> KeyPair Staking
-> Credential Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey Staking -> KeyHash Staking)
-> (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 -> Credential Staking)
-> KeyPair Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ KeyPair Staking
aliceStake)
    , sppOwners :: Set (KeyHash Staking)
sppOwners = 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
    , sppRelays :: StrictSeq StakePoolRelay
sppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
    , sppMetadata :: StrictMaybe PoolMetadata
sppMetadata =
        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 = String -> ByteString
BS.pack String
"{}"
            }
    }
  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))
-> Tx TopTx 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 (StakePoolParams -> Coin
sppCost StakePoolParams
aliceStakePoolParamsSmallCost) (forall era. (EraPParams era, AtMostEra "Mary" era) => PParams era
pp @ShelleyEra 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)
    ]
    (Tx TopTx ShelleyEra -> Assertion)
-> Tx TopTx ShelleyEra -> Assertion
forall a b. (a -> b) -> a -> b
$ AliceToBob -> Tx TopTx ShelleyEra
aliceGivesBobLovelace
    (AliceToBob -> Tx TopTx ShelleyEra)
-> AliceToBob -> Tx TopTx ShelleyEra
forall a b. (a -> b) -> a -> b
$ AliceToBob
      { input :: TxIn
input = TxId -> TxIx -> TxIn
TxIn TxId
genesisId TxIx
forall a. Bounded a => a
minBound
      , toBob :: Coin
toBob = Integer -> Coin
Coin Integer
100
      , fee :: Coin
fee = Integer -> Coin
Coin Integer
997
      , deposits :: Coin
deposits = Integer -> Coin
Coin Integer
250
      , refunds :: Coin
refunds = Integer -> Coin
Coin Integer
0
      , certs :: [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
$ StakePoolParams -> PoolCert
RegPool StakePoolParams
aliceStakePoolParamsSmallCost]
      , ttl :: SlotNo
ttl = Word64 -> SlotNo
SlotNo Word64
0
      , signers :: [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 TopTx ShelleyEra
txbody =
        Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody TopTx 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 TopTx ShelleyEra
tx = forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx @ShelleyEra TxBody TopTx 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 ShelleyEra) ((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 TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall (l :: TxLevel). ShelleyTx l ShelleyEra -> Tx l ShelleyEra
MkShelleyTx ShelleyTx TopTx 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 :: SpecWith ()
testsInvalidLedger =
  String -> [SpecWith ()] -> SpecWith ()
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Tests with invalid transactions in ledger"
    [ HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice tries to spend a nonexistent input" Assertion
testSpendNonexistentInput
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice does not include a witness" Assertion
testWitnessNotIncluded
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice tries to spend Bob's UTxO" Assertion
testSpendNotOwnedUTxO
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice provides witness of wrong UTxO" Assertion
testWitnessWrongUTxO
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice's transaction does not consume input" Assertion
testEmptyInputSet
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice's fee is too small" Assertion
testFeeTooSmall
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Alice's transaction has expired" Assertion
testExpiredTx
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Invalid witnesses" Assertion
testInvalidWintess
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - No withdrawal witness" Assertion
testWithdrawalNoWit
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - Incorrect withdrawal amount" Assertion
testWithdrawalWrongAmt
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - OutputTooSmall" Assertion
testOutputTooSmall
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - PoolCostTooSmall" Assertion
testPoolCostTooSmall
    , HasCallStack => String -> Assertion -> SpecWith ()
String -> Assertion -> SpecWith ()
testCase String
"Invalid Ledger - ProducedOverMaxWord64" Assertion
testProducedOverMaxWord64
    ]

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