{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Shelley.RulesTests (
  chainExamples,
  multisigExamples,
  testTickF,
)
where

import Cardano.Ledger.BaseTypes (Network (..), StrictMaybe (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (hashScript)
import Cardano.Ledger.Credential (pattern ScriptHashObj)
import Cardano.Ledger.Keys (asWitness, hashKey)
import Cardano.Ledger.Shelley (Shelley)
import Cardano.Ledger.Shelley.API (ShelleyTICK, ShelleyTICKF)
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState (..),
  NewEpochState (..),
  UTxOState (..),
  totalObligation,
  utxosGovStateL,
 )
import Cardano.Ledger.Shelley.RewardUpdate (PulsingRewUpdate (..), RewardUpdate (..))
import Cardano.Ledger.Shelley.Rules (ShelleyUtxowPredFailure (..))
import Cardano.Ledger.Shelley.TxBody (RewardAccount (..), Withdrawals (..))
import Cardano.Ledger.Slot (EpochNo (..))
import Cardano.Protocol.TPraos.API (GetLedgerView (..))
import Control.State.Transition.Extended (TRC (..))
import Data.Either (isRight)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Lens.Micro ((^.))
import Test.Cardano.Ledger.Core.KeyPair (vKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, C_Crypto)
import Test.Cardano.Ledger.Shelley.Examples (testCHAINExample)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import Test.Cardano.Ledger.Shelley.Examples.EmptyBlock (exEmptyBlock)
import Test.Cardano.Ledger.Shelley.Examples.GenesisDelegation (genesisDelegExample)
import Test.Cardano.Ledger.Shelley.Examples.Mir (mirExample)
import Test.Cardano.Ledger.Shelley.Examples.MirTransfer (testMIRTransfer)
import Test.Cardano.Ledger.Shelley.Examples.NetworkID (testPoolNetworkId)
import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (poolLifetimeExample)
import Test.Cardano.Ledger.Shelley.Examples.PoolReReg (poolReRegExample)
import Test.Cardano.Ledger.Shelley.Examples.TwoPools (twoPoolsExample)
import Test.Cardano.Ledger.Shelley.Examples.Updates (updatesExample)
import Test.Cardano.Ledger.Shelley.MultiSigExamples (
  aliceAndBob,
  aliceAndBobOrCarl,
  aliceAndBobOrCarlAndDaria,
  aliceAndBobOrCarlOrDaria,
  aliceOnly,
  aliceOrBob,
  applyTxWithScript,
  bobOnly,
 )
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Cardano.Ledger.Shelley.Utils
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, testCase, (@?=))
import Test.Tasty.QuickCheck (Property, discard, testProperty, (===))

chainExamples :: TestTree
chainExamples :: TestTree
chainExamples =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"CHAIN examples"
    [ TestName -> Assertion -> TestTree
testCase TestName
"empty block" forall a b. (a -> b) -> a -> b
$ HasCallStack =>
CHAINExample (BHeader C_Crypto) (ShelleyEra C_Crypto) -> Assertion
testCHAINExample forall era.
(ExMock (EraCrypto era), EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6, Default (StashedAVVMAddresses era),
 EraGov era) =>
CHAINExample (BHeader (EraCrypto era)) era
exEmptyBlock
    , TestTree
poolLifetimeExample
    , TestTree
twoPoolsExample
    , TestTree
poolReRegExample
    , TestTree
updatesExample
    , TestTree
genesisDelegExample
    , TestTree
mirExample
    , TestTree
testMIRTransfer
    , TestTree
testPoolNetworkId
    ]

multisigExamples :: TestTree
multisigExamples :: TestTree
multisigExamples =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"MultiSig Examples"
    [ TestName -> Assertion -> TestTree
testCase TestName
"Alice uses SingleSig script" Assertion
testAliceSignsAlone
    , TestName -> Assertion -> TestTree
testCase TestName
"FAIL: Alice doesn't sign in multi-sig" Assertion
testAliceDoesntSign
    , TestName -> Assertion -> TestTree
testCase TestName
"Everybody signs in multi-sig" Assertion
testEverybodySigns
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice || Bob, Alice signs" Assertion
testAliceOrBob
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice || Bob, Bob signs" Assertion
testAliceOrBob'
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob, both sign" Assertion
testAliceAndBob
    , TestName -> Assertion -> TestTree
testCase TestName
"FAIL: Alice && Bob, Alice signs" Assertion
testAliceAndBob'
    , TestName -> Assertion -> TestTree
testCase TestName
"FAIL: Alice && Bob, Bob signs" Assertion
testAliceAndBob''
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl, Alice && Bob sign" Assertion
testAliceAndBobOrCarl
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl, Carl signs" Assertion
testAliceAndBobOrCarl'
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl && Daria, Alice && Bob sign" Assertion
testAliceAndBobOrCarlAndDaria
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl && Daria, Carl && Daria sign" Assertion
testAliceAndBobOrCarlAndDaria'
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl || Daria, Alice && Bob sign" Assertion
testAliceAndBobOrCarlOrDaria
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl || Daria, Carl signs" Assertion
testAliceAndBobOrCarlOrDaria'
    , TestName -> Assertion -> TestTree
testCase TestName
"Alice && Bob || Carl || Daria, Daria signs" Assertion
testAliceAndBobOrCarlOrDaria''
    , TestName -> Assertion -> TestTree
testCase TestName
"two scripts: Alice Or Bob / alice And Bob Or Carl" Assertion
testTwoScripts
    , TestName -> Assertion -> TestTree
testCase TestName
"FAIL: two scripts: Alice Or Bob / alice And Bob Or Carl" Assertion
testTwoScripts'
    , TestName -> Assertion -> TestTree
testCase TestName
"script and Key: Alice And Bob and alicePay" Assertion
testScriptAndSKey
    , TestName -> Assertion -> TestTree
testCase TestName
"FAIL: script and Key: Alice And Bob and alicePay" Assertion
testScriptAndSKey'
    , TestName -> Assertion -> TestTree
testCase TestName
"script and Key: Alice Or Bob and alicePay, only Alice" Assertion
testScriptAndSKey''
    , TestName -> Assertion -> TestTree
testCase
        TestName
"script and Key: Alice And Bob Or Carl and alicePay, Alice and Carl sign"
        Assertion
testScriptAndSKey'''
    , TestName -> Assertion -> TestTree
testCase TestName
"withdraw from script locked account, same script" Assertion
testRwdAliceSignsAlone
    , TestName -> Assertion -> TestTree
testCase TestName
"FAIL: withdraw from script locked account" Assertion
testRwdAliceSignsAlone'
    , TestName -> Assertion -> TestTree
testCase TestName
"withdraw from script locked account, different script" Assertion
testRwdAliceSignsAlone''
    , TestName -> Assertion -> TestTree
testCase
        TestName
"FAIL: withdraw from script locked account, signed, missing script"
        Assertion
testRwdAliceSignsAlone'''
    ]

testAliceSignsAlone :: Assertion
testAliceSignsAlone :: Assertion
testAliceSignsAlone =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceDoesntSign :: Assertion
testAliceDoesntSign :: Assertion
testAliceDoesntSign =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set (ScriptHash C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.dariaPay]
    wits :: Set (ScriptHash (EraCrypto (ShelleyEra C_Crypto)))
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
aliceOnly

testEverybodySigns :: Assertion
testEverybodySigns :: Assertion
testEverybodySigns =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [ forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay
        , forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay
        , forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay
        , forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.dariaPay
        ]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceOrBob :: Assertion
testAliceOrBob :: Assertion
testAliceOrBob =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceOrBob' :: Assertion
testAliceOrBob' :: Assertion
testAliceOrBob' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBob :: Assertion
testAliceAndBob :: Assertion
testAliceAndBob =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBob' :: Assertion
testAliceAndBob' :: Assertion
testAliceAndBob' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set (ScriptHash C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
    wits :: Set (ScriptHash (EraCrypto (ShelleyEra C_Crypto)))
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
aliceAndBob

testAliceAndBob'' :: Assertion
testAliceAndBob'' :: Assertion
testAliceAndBob'' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set (ScriptHash C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    wits :: Set (ScriptHash (EraCrypto (ShelleyEra C_Crypto)))
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
aliceAndBob

testAliceAndBobOrCarl :: Assertion
testAliceAndBobOrCarl :: Assertion
testAliceAndBobOrCarl =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBobOrCarl' :: Assertion
testAliceAndBobOrCarl' :: Assertion
testAliceAndBobOrCarl' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBobOrCarlAndDaria :: Assertion
testAliceAndBobOrCarlAndDaria :: Assertion
testAliceAndBobOrCarlAndDaria =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBobOrCarlAndDaria' :: Assertion
testAliceAndBobOrCarlAndDaria' :: Assertion
testAliceAndBobOrCarlAndDaria' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.dariaPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBobOrCarlOrDaria :: Assertion
testAliceAndBobOrCarlOrDaria :: Assertion
testAliceAndBobOrCarlOrDaria =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBobOrCarlOrDaria' :: Assertion
testAliceAndBobOrCarlOrDaria' :: Assertion
testAliceAndBobOrCarlOrDaria' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testAliceAndBobOrCarlOrDaria'' :: Assertion
testAliceAndBobOrCarlOrDaria'' :: Assertion
testAliceAndBobOrCarlOrDaria'' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.dariaPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

-- multiple script-locked outputs

testTwoScripts :: Assertion
testTwoScripts :: Assertion
testTwoScripts =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [ (forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
10000)
        , (forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
1000)
        ]
        [ forall era. ShelleyEraScript era => NativeScript era
aliceOrBob
        , forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl
        ]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testTwoScripts' :: Assertion
testTwoScripts' :: Assertion
testTwoScripts' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set (ScriptHash C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [ (forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
10000)
        , (forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
1000)
        ]
        [ forall era. ShelleyEraScript era => NativeScript era
aliceAndBob
        , forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl
        ]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay]
    wits :: Set (ScriptHash (EraCrypto (ShelleyEra C_Crypto)))
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
aliceAndBob

-- script and skey locked

testScriptAndSKey :: Assertion
testScriptAndSKey :: Assertion
testScriptAndSKey =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testScriptAndSKey' :: Assertion
testScriptAndSKey' :: Assertion
testScriptAndSKey' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (KeyHash 'Witness (EraCrypto era))
-> ShelleyUtxowPredFailure era
MissingVKeyWitnessesUTXOW) Set (KeyHash 'Witness C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    wits :: Set (KeyHash 'Witness C_Crypto)
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay

testScriptAndSKey'' :: Assertion
testScriptAndSKey'' :: Assertion
testScriptAndSKey'' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testScriptAndSKey''' :: Assertion
testScriptAndSKey''' :: Assertion
testScriptAndSKey''' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl]
        (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

-- Withdrawals

testRwdAliceSignsAlone :: Assertion
testRwdAliceSignsAlone :: Assertion
testRwdAliceSignsAlone =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              ( forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount
                  Network
Testnet
                  (forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
aliceOnly)
              )
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testRwdAliceSignsAlone' :: Assertion
testRwdAliceSignsAlone' :: Assertion
testRwdAliceSignsAlone' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set (ScriptHash C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly, forall era. ShelleyEraScript era => NativeScript era
bobOnly]
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              ( forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount
                  Network
Testnet
                  ( forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall a b. (a -> b) -> a -> b
$
                      forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
bobOnly
                  )
              )
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay]
    wits :: Set (ScriptHash (EraCrypto (ShelleyEra C_Crypto)))
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
bobOnly

testRwdAliceSignsAlone'' :: Assertion
testRwdAliceSignsAlone'' :: Assertion
testRwdAliceSignsAlone'' =
  HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
s (forall a b. Either a b -> Bool
isRight Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly, forall era. ShelleyEraScript era => NativeScript era
bobOnly]
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              ( forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount
                  Network
Testnet
                  ( forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall a b. (a -> b) -> a -> b
$
                      forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
bobOnly
                  )
              )
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt'

testRwdAliceSignsAlone''' :: Assertion
testRwdAliceSignsAlone''' :: Assertion
testRwdAliceSignsAlone''' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra C_Crypto)))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyUtxowPredFailure era
MissingScriptWitnessesUTXOW) Set (ScriptHash C_Crypto)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra C_Crypto))))
  (UTxOState (ShelleyEra C_Crypto))
utxoSt' =
      forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript
        @C_Crypto
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        ( forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
bobOnly))
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay]
    wits :: Set (ScriptHash (EraCrypto (ShelleyEra C_Crypto)))
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @C forall era. ShelleyEraScript era => NativeScript era
bobOnly

-- | The reward aggregation bug described in the Shelley ledger spec in
-- section 17.4 (in the Errata) resulted in needing to use 'aggregatedRewards' to change
-- the behavior of how rewards are collected starting at protocol version 3.
-- Instead of collecting a `Coin` for each stake credential, we collect 'Set Reward'.
-- In major protocol version 2, it is impossible for this set to be empty, but sadly this
-- property is not enforced in the types. For this reason, the property test
-- 'propTickfPerservesLedgerView' removes these empty sets from an otherwise arbitrary
-- 'NewEpochState'.
filterEmptyRewards :: NewEpochState Shelley -> NewEpochState Shelley
filterEmptyRewards :: NewEpochState Shelley -> NewEpochState Shelley
filterEmptyRewards (NewEpochState EpochNo
el BlocksMade (EraCrypto Shelley)
bprev BlocksMade (EraCrypto Shelley)
bcur EpochState Shelley
es StrictMaybe (PulsingRewUpdate (EraCrypto Shelley))
ru PoolDistr (EraCrypto Shelley)
pd StashedAVVMAddresses Shelley
stash) =
  forall era.
EpochNo
-> BlocksMade (EraCrypto era)
-> BlocksMade (EraCrypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (EraCrypto era))
-> PoolDistr (EraCrypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState EpochNo
el BlocksMade (EraCrypto Shelley)
bprev BlocksMade (EraCrypto Shelley)
bcur EpochState Shelley
es StrictMaybe (PulsingRewUpdate StandardCrypto)
ru' PoolDistr (EraCrypto Shelley)
pd StashedAVVMAddresses Shelley
stash
  where
    removeEmptyRewards :: Map k (Set a) -> Map k (Set a)
removeEmptyRewards = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Bool
Set.null
    ru' :: StrictMaybe (PulsingRewUpdate StandardCrypto)
ru' = case StrictMaybe (PulsingRewUpdate (EraCrypto Shelley))
ru of
      StrictMaybe (PulsingRewUpdate (EraCrypto Shelley))
SNothing -> forall a. StrictMaybe a
SNothing
      SJust (Pulsing RewardSnapShot (EraCrypto Shelley)
_ Pulser (EraCrypto Shelley)
_) -> forall a. StrictMaybe a
SNothing
      SJust (Complete RewardUpdate (EraCrypto Shelley)
rewardUpdate) ->
        forall a. a -> StrictMaybe a
SJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. RewardUpdate c -> PulsingRewUpdate c
Complete forall a b. (a -> b) -> a -> b
$ RewardUpdate (EraCrypto Shelley)
rewardUpdate {rs :: Map
  (Credential 'Staking StandardCrypto) (Set (Reward StandardCrypto))
rs = forall {k} {a}. Map k (Set a) -> Map k (Set a)
removeEmptyRewards (forall c.
RewardUpdate c -> Map (Credential 'Staking c) (Set (Reward c))
rs RewardUpdate (EraCrypto Shelley)
rewardUpdate)}

setDepositsToObligation :: NewEpochState Shelley -> NewEpochState Shelley
setDepositsToObligation :: NewEpochState Shelley -> NewEpochState Shelley
setDepositsToObligation NewEpochState Shelley
nes = NewEpochState Shelley
nes {nesEs :: EpochState Shelley
nesEs = EpochState Shelley
es {esLState :: LedgerState Shelley
esLState = LedgerState Shelley
ls {lsUTxOState :: UTxOState Shelley
lsUTxOState = UTxOState Shelley
utxoState}}}
  where
    es :: EpochState Shelley
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState Shelley
nes
    ls :: LedgerState Shelley
ls = forall era. EpochState era -> LedgerState era
esLState EpochState Shelley
es
    utxoState :: UTxOState Shelley
utxoState =
      (forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState Shelley
ls)
        { utxosDeposited :: Coin
utxosDeposited =
            forall era. EraGov era => CertState era -> GovState era -> Coin
totalObligation
              (forall era. LedgerState era -> CertState era
lsCertState LedgerState Shelley
ls)
              (UTxOState Shelley
utxoState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL)
        }

-- | This property test checks the correctness of the TICKF transation.
-- TICKF is used by the consensus layer to get a ledger view in a computationally
-- cheaper way than using the TICK rule.
-- Therefore TICKF and TICK need to compute the same ledger view.
propTickfPerservesLedgerView :: NewEpochState Shelley -> Property
propTickfPerservesLedgerView :: NewEpochState Shelley -> Property
propTickfPerservesLedgerView NewEpochState Shelley
nes =
  let (EpochNo Word64
e) = forall era. NewEpochState era -> EpochNo
nesEL NewEpochState Shelley
nes
      slot :: SlotNo
slot = EpochNo -> SlotNo
slotFromEpoch (Word64 -> EpochNo
EpochNo forall a b. (a -> b) -> a -> b
$ Word64
e forall a. Num a => a -> a -> a
+ Word64
1)
      nes' :: NewEpochState Shelley
nes' = NewEpochState Shelley -> NewEpochState Shelley
setDepositsToObligation (NewEpochState Shelley -> NewEpochState Shelley
filterEmptyRewards NewEpochState Shelley
nes)
      tickNes :: Either
  (NonEmpty (ShelleyTickPredFailure Shelley)) (NewEpochState Shelley)
tickNes = 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 @(ShelleyTICK Shelley) (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), NewEpochState Shelley
nes', SlotNo
slot))
      tickFNes :: Either
  (NonEmpty (ShelleyTickfPredFailure Shelley))
  (NewEpochState Shelley)
tickFNes = 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 @(ShelleyTICKF Shelley) (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), NewEpochState Shelley
nes', SlotNo
slot))
   in forall a. a -> Maybe a -> a
fromMaybe forall a. a
discard forall a b. (a -> b) -> a -> b
$ do
        Right NewEpochState Shelley
tickNes' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Either
  (NonEmpty (ShelleyTickPredFailure Shelley)) (NewEpochState Shelley)
tickNes
        Right NewEpochState Shelley
tickFNes' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Either
  (NonEmpty (ShelleyTickfPredFailure Shelley))
  (NewEpochState Shelley)
tickFNes
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
GetLedgerView era =>
NewEpochState era -> LedgerView (EraCrypto era)
currentLedgerView NewEpochState Shelley
tickNes' forall a. (Eq a, Show a) => a -> a -> Property
=== forall era.
GetLedgerView era =>
NewEpochState era -> LedgerView (EraCrypto era)
currentLedgerView NewEpochState Shelley
tickFNes'

testTickF :: TestTree
testTickF :: TestTree
testTickF = forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"TICKF properties" NewEpochState Shelley -> Property
propTickfPerservesLedgerView