{-# 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 (ShelleyEra)
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.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 ShelleyEra -> Assertion
testCHAINExample forall era.
(EraSegWits era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
CHAINExample 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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'

testAliceDoesntSign :: Assertion
testAliceDoesntSign :: Assertion
testAliceDoesntSign =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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 -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set ScriptHash
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.dariaPay]
    wits :: Set ScriptHash
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra 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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [ forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay
        , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay
        , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay
        , forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.dariaPay
        ]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'

testAliceAndBob' :: Assertion
testAliceAndBob' :: Assertion
testAliceAndBob' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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 -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set ScriptHash
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    wits :: Set ScriptHash
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra forall era. ShelleyEraScript era => NativeScript era
aliceAndBob

testAliceAndBob'' :: Assertion
testAliceAndBob'' :: Assertion
testAliceAndBob'' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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 -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set ScriptHash
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    wits :: Set ScriptHash
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra 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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.dariaPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.dariaPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [ (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
        ]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'

testTwoScripts' :: Assertion
testTwoScripts' :: Assertion
testTwoScripts' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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 -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set ScriptHash
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [ (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
        ]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay]
    wits :: Set ScriptHash
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra 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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'

testScriptAndSKey' :: Assertion
testScriptAndSKey' :: Assertion
testScriptAndSKey' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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) -> ShelleyUtxowPredFailure era
MissingVKeyWitnessesUTXOW) Set (KeyHash 'Witness)
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    wits :: Set (KeyHash 'Witness)
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ 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
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOrBob, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOrBob]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl, Integer -> Coin
Coin Integer
10000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl]
        (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
        (Integer -> Coin
Coin Integer
1000)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.carlPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        ( Map RewardAccount Coin -> Withdrawals
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              ( Network -> Credential 'Staking -> RewardAccount
RewardAccount
                  Network
Testnet
                  (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra forall era. ShelleyEraScript era => NativeScript era
aliceOnly)
              )
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'

testRwdAliceSignsAlone' :: Assertion
testRwdAliceSignsAlone' :: Assertion
testRwdAliceSignsAlone' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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 -> ShelleyUtxowPredFailure era
ScriptWitnessNotValidatingUTXOW) Set ScriptHash
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(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]
        ( Map RewardAccount Coin -> Withdrawals
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              ( Network -> Credential 'Staking -> RewardAccount
RewardAccount
                  Network
Testnet
                  ( forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$
                      forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra forall era. ShelleyEraScript era => NativeScript era
bobOnly
                  )
              )
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay]
    wits :: Set ScriptHash
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra 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))
  (UTxOState ShelleyEra)
utxoSt')
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(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]
        ( Map RewardAccount Coin -> Withdrawals
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              ( Network -> Credential 'Staking -> RewardAccount
RewardAccount
                  Network
Testnet
                  ( forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$
                      forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra forall era. ShelleyEraScript era => NativeScript era
bobOnly
                  )
              )
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    s :: TestName
s = TestName
"problem: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'

testRwdAliceSignsAlone''' :: Assertion
testRwdAliceSignsAlone''' :: Assertion
testRwdAliceSignsAlone''' =
  Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
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 -> ShelleyUtxowPredFailure era
MissingScriptWitnessesUTXOW) Set ScriptHash
wits
  where
    utxoSt' :: Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
utxoSt' =
      [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript
        [(forall era. ShelleyEraScript era => NativeScript era
aliceOnly, Integer -> Coin
Coin Integer
11000)]
        [forall era. ShelleyEraScript era => NativeScript era
aliceOnly]
        ( Map RewardAccount Coin -> Withdrawals
Withdrawals forall a b. (a -> b) -> a -> b
$
            forall k a. k -> a -> Map k a
Map.singleton
              (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra forall era. ShelleyEraScript era => NativeScript era
bobOnly))
              (Integer -> Coin
Coin Integer
1000)
        )
        (Integer -> Coin
Coin Integer
0)
        [forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.alicePay, forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
Cast.bobPay]
    wits :: Set ScriptHash
wits = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra 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 ShelleyEra -> NewEpochState ShelleyEra
filterEmptyRewards :: NewEpochState ShelleyEra -> NewEpochState ShelleyEra
filterEmptyRewards (NewEpochState EpochNo
el BlocksMade
bprev BlocksMade
bcur EpochState ShelleyEra
es StrictMaybe PulsingRewUpdate
ru PoolDistr
pd StashedAVVMAddresses ShelleyEra
stash) =
  forall era.
EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState EpochNo
el BlocksMade
bprev BlocksMade
bcur EpochState ShelleyEra
es StrictMaybe PulsingRewUpdate
ru' PoolDistr
pd StashedAVVMAddresses ShelleyEra
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
ru' = case StrictMaybe PulsingRewUpdate
ru of
      StrictMaybe PulsingRewUpdate
SNothing -> forall a. StrictMaybe a
SNothing
      SJust (Pulsing RewardSnapShot
_ Pulser
_) -> forall a. StrictMaybe a
SNothing
      SJust (Complete RewardUpdate
rewardUpdate) ->
        forall a. a -> StrictMaybe a
SJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardUpdate -> PulsingRewUpdate
Complete forall a b. (a -> b) -> a -> b
$ RewardUpdate
rewardUpdate {rs :: Map (Credential 'Staking) (Set Reward)
rs = forall {k} {a}. Map k (Set a) -> Map k (Set a)
removeEmptyRewards (RewardUpdate -> Map (Credential 'Staking) (Set Reward)
rs RewardUpdate
rewardUpdate)}

setDepositsToObligation :: NewEpochState ShelleyEra -> NewEpochState ShelleyEra
setDepositsToObligation :: NewEpochState ShelleyEra -> NewEpochState ShelleyEra
setDepositsToObligation NewEpochState ShelleyEra
nes = NewEpochState ShelleyEra
nes {nesEs :: EpochState ShelleyEra
nesEs = EpochState ShelleyEra
es {esLState :: LedgerState ShelleyEra
esLState = LedgerState ShelleyEra
ls {lsUTxOState :: UTxOState ShelleyEra
lsUTxOState = UTxOState ShelleyEra
utxoState}}}
  where
    es :: EpochState ShelleyEra
es = forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ShelleyEra
nes
    ls :: LedgerState ShelleyEra
ls = forall era. EpochState era -> LedgerState era
esLState EpochState ShelleyEra
es
    utxoState :: UTxOState ShelleyEra
utxoState =
      (forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState ShelleyEra
ls)
        { utxosDeposited :: Coin
utxosDeposited =
            forall era. EraGov era => CertState era -> GovState era -> Coin
totalObligation
              (forall era. LedgerState era -> CertState era
lsCertState LedgerState ShelleyEra
ls)
              (UTxOState ShelleyEra
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 ShelleyEra -> Property
propTickfPerservesLedgerView :: NewEpochState ShelleyEra -> Property
propTickfPerservesLedgerView NewEpochState ShelleyEra
nes =
  let (EpochNo Word64
e) = forall era. NewEpochState era -> EpochNo
nesEL NewEpochState ShelleyEra
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 ShelleyEra
nes' = NewEpochState ShelleyEra -> NewEpochState ShelleyEra
setDepositsToObligation (NewEpochState ShelleyEra -> NewEpochState ShelleyEra
filterEmptyRewards NewEpochState ShelleyEra
nes)
      tickNes :: Either
  (NonEmpty (ShelleyTickPredFailure ShelleyEra))
  (NewEpochState ShelleyEra)
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 ShelleyEra) (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), NewEpochState ShelleyEra
nes', SlotNo
slot))
      tickFNes :: Either
  (NonEmpty (ShelleyTickfPredFailure ShelleyEra))
  (NewEpochState ShelleyEra)
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 ShelleyEra) (forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), NewEpochState ShelleyEra
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 ShelleyEra
tickNes' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Either
  (NonEmpty (ShelleyTickPredFailure ShelleyEra))
  (NewEpochState ShelleyEra)
tickNes
        Right NewEpochState ShelleyEra
tickFNes' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Either
  (NonEmpty (ShelleyTickfPredFailure ShelleyEra))
  (NewEpochState ShelleyEra)
tickFNes
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. GetLedgerView era => NewEpochState era -> LedgerView
currentLedgerView NewEpochState ShelleyEra
tickNes' forall a. (Eq a, Show a) => a -> a -> Property
=== forall era. GetLedgerView era => NewEpochState era -> LedgerView
currentLedgerView NewEpochState ShelleyEra
tickFNes'

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