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

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

alicePay :: KeyPair 'Payment
alicePay :: KeyPair 'Payment
alicePay = forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' 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 = forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
2 Word64
2 Word64
2 Word64
2

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

bobPay :: KeyPair 'Payment
bobPay :: KeyPair 'Payment
bobPay = forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' 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 = forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
4 Word64
4 Word64
4 Word64
4 Word64
4

bobAddr :: Addr
bobAddr :: Addr
bobAddr =
  Network -> PaymentCredential -> StakeReference -> Addr
Addr
    Network
Testnet
    (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Payment
bobPay)
    (StakeCredential -> StakeReference
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Integer -> TxIx
mkTxIxPartial

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

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

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

-- | Test @checkLeaderVal@ in 'Cardano.Ledger.Shelley.BlockChain'
testCheckLeaderVal ::
  forall v.
  v ~ VRF StandardCrypto =>
  TestTree
testCheckLeaderVal :: forall v. (v ~ VRF StandardCrypto) => TestTree
testCheckLeaderVal =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Test checkLeaderVal calculation"
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"With a stake of 0, cannot lead" forall a b. (a -> b) -> a -> b
$
        \(VRFNatVal Natural
n) (ASC ActiveSlotCoeff
f) ->
          forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v (forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
n) Rational
0 ActiveSlotCoeff
f forall a. Eq a => a -> a -> Bool
== Bool
False
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"With a maximal VRF, cannot lead" forall a b. (a -> b) -> a -> b
$
        \(ASC ActiveSlotCoeff
f) (StakeProportion Rational
r) ->
          forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v
            (forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
maxVRFVal)
            Rational
r
            ActiveSlotCoeff
f
            forall a. Eq a => a -> a -> Bool
== Bool
False
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"checkLeaderVal succeeds iff l < 1 - (1-f)^r" forall a b. (a -> b) -> a -> b
$
        \(VRFNatVal Natural
n) (ASC ActiveSlotCoeff
f) (StakeProportion Rational
r) ->
          Rational
r forall a. Ord a => a -> a -> Bool
> Rational
0 forall prop. Testable prop => Bool -> prop -> Property
==>
            let ascVal :: Double
                ascVal :: Double
ascVal = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => r -> Rational
unboundRational forall a b. (a -> b) -> a -> b
$ ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal ActiveSlotCoeff
f
             in forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v
                  (forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF Natural
n)
                  Rational
r
                  ActiveSlotCoeff
f
                  forall a. (Eq a, Show a) => a -> a -> Property
=== ( (forall a b. (Real a, Fractional b) => a -> b
realToFrac Natural
n forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac (Natural
maxVRFVal forall a. Num a => a -> a -> a
+ Natural
1))
                          forall a. Ord a => a -> a -> Bool
< (Double
1 forall a. Num a => a -> a -> a
- (Double
1 forall a. Num a => a -> a -> a
- Double
ascVal) forall a. Floating a => a -> a -> a
** 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.
      --
      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"We are elected as leader proportional to our stake" forall a b. (a -> b) -> a -> b
$
        -- 6297 is a seed value that fails
        -- --quickcheck-replay=618 fails when withSeed isn't used
        forall prop. Testable prop => prop -> Property
once forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Int -> Gen a -> Gen a
withSeed Int
12345 forall a b. (a -> b) -> a -> b
$ do
          let numTrials :: Int
numTrials = Int
2000
          ASC ActiveSlotCoeff
f <- forall a. Arbitrary a => Gen a
arbitrary
          StakeProportion Rational
r <- forall a. Arbitrary a => Gen a
arbitrary
          [Integer]
vrfVals <- forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
numTrials (forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
maxVRFVal :: Integer))
          let ascVal :: Double
              ascVal :: Double
ascVal = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => r -> Rational
unboundRational forall a b. (a -> b) -> a -> b
$ ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal ActiveSlotCoeff
f
              -- 4 standard deviations
              δ :: Double
δ = Double
4 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt (forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
numTrials forall a. Num a => a -> a -> a
* Double
p forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
p))
              p :: Double
p = Double
1 forall a. Num a => a -> a -> a
- (Double
1 forall a. Num a => a -> a -> a
- Double
ascVal) forall a. Floating a => a -> a -> a
** forall a. Fractional a => Rational -> a
fromRational Rational
r
              mean :: Double
mean = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
numTrials forall a. Num a => a -> a -> a
* Double
p
              lb :: Int
lb = forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
mean forall a. Num a => a -> a -> a
- Double
δ)
              ub :: Int
ub = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
mean forall a. Num a => a -> a -> a
+ Double
δ)
              check :: Integer -> Bool
check Integer
vrf = forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue @v (forall v. VRFAlgorithm v => Natural -> OutputVRF v
VRF.mkTestOutputVRF forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
vrf) Rational
r ActiveSlotCoeff
f
              s :: Int
s = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Integer -> Bool
check forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
vrfVals
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Rational
r forall a. Ord a => a -> a -> Bool
> Rational
0 forall prop. Testable prop => Bool -> prop -> Property
==>
              forall prop. Testable prop => TestName -> prop -> Property
counterexample
                (forall a. Show a => a -> TestName
show Int
lb forall a. Semigroup a => a -> a -> a
<> TestName
" /< " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> TestName
show Int
s forall a. Semigroup a => a -> a -> a
<> TestName
" /< " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> TestName
show Int
ub forall a. Semigroup a => a -> a -> a
<> TestName
" (p=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> TestName
show Double
p forall a. Semigroup a => a -> a -> a
<> TestName
")")
                (Int
lb forall a. Ord a => a -> a -> Bool
< Int
s Bool -> Bool -> Bool
&& Int
s forall a. Ord a => a -> a -> Bool
< Int
ub)
    ]
  where
    maxVRFVal :: Natural
    maxVRFVal :: Natural
maxVRFVal = (Natural
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
8 forall a. Num a => a -> a -> a
* forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
VRF.sizeOutputVRF (forall {k} (t :: k). Proxy t
Proxy @v))) forall a. Num a => a -> a -> a
- Natural
1
    withSeed :: Int -> Gen a -> Gen a
withSeed Int
i (QC.MkGen QCGen -> Int -> a
f) = forall a. (QCGen -> Int -> a) -> Gen a
QC.MkGen forall a b. (a -> b) -> a -> b
$ \QCGen
_r Int
n -> QCGen -> Int -> a
f (Int -> QCGen
QC.mkQCGen Int
i) Int
n

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

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

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

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

utxoState :: UTxOState C
utxoState :: UTxOState ShelleyEra
utxoState =
  forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
UTxOState
    ( forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins
        TxId
genesisId
        [ forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
aliceAddr Coin
aliceInitCoin
        , 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)
    forall a. Default a => a
def
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty

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

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

addReward :: CertState C -> Credential 'Staking -> Coin -> CertState C
addReward :: CertState ShelleyEra
-> StakeCredential -> Coin -> CertState ShelleyEra
addReward CertState ShelleyEra
dp StakeCredential
ra Coin
c = CertState ShelleyEra
dp forall a b. a -> (a -> b) -> b
& forall era. EraCertState era => Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UMap
rewards'
  where
    ds :: DState ShelleyEra
ds = CertState ShelleyEra
dp forall s a. s -> Getting a s a -> a
^. forall era. EraCertState era => Lens' (CertState era) (DState era)
certDStateL
    rewards' :: UMap
rewards' = forall k v. k -> v -> UView k v -> UMap
UM.insert StakeCredential
ra (CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (HasCallStack => Coin -> CompactForm Coin
UM.compactCoinOrError Coin
c) (Word64 -> CompactForm Coin
UM.CompactCoin Word64
2)) (forall era. DState era -> UView StakeCredential RDPair
rewards DState ShelleyEra
ds)

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

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

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

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

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

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

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

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

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

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

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

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

alicePoolColdKeys :: KeyPair 'StakePool
alicePoolColdKeys :: KeyPair 'StakePool
alicePoolColdKeys = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
1)

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

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

testProducedOverMaxWord64 :: Assertion
testProducedOverMaxWord64 :: Assertion
testProducedOverMaxWord64 =
  let biggestCoin :: Integer
biggestCoin = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64)
      txbody :: ShelleyTxBody ShelleyEra
txbody =
        forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody @C
          (forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId forall a. Bounded a => a
minBound])
          (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
bobAddr (Integer -> Coin
Coin Integer
biggestCoin)])
          forall a. StrictSeq a
Empty
          (Map RewardAccount Coin -> Withdrawals
Withdrawals 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)
          forall a. StrictMaybe a
SNothing
          forall a. StrictMaybe a
SNothing
      txwits :: ShelleyTxWits ShelleyEra
txwits = forall a. Monoid a => a
mempty {addrWits :: Set (WitVKey 'Witness)
addrWits = forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated ShelleyTxBody ShelleyEra
txbody) [KeyPair 'Payment
alicePay]}
      tx :: ShelleyTx ShelleyEra
tx = forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx @C ShelleyTxBody ShelleyEra
txbody ShelleyTxWits ShelleyEra
txwits forall a. StrictMaybe a
SNothing
      st :: Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st =
        forall a. ShelleyBase a -> a
runShelleyBase forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTSTest @(ShelleyLEDGER C) (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv ShelleyEra
ledgerEnv, LedgerState ShelleyEra
ledgerState, ShelleyTx ShelleyEra
tx))
   in -- We test that the predicate failure does not return bottom
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. NFData a => a -> ()
rnf Either
  (NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
  (LedgerState ShelleyEra)
st

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

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