{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Valid (spec) where
import Cardano.Ledger.Allegra.Scripts (
pattern RequireTimeExpire,
)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Rules (
AlonzoUtxosPredFailure,
)
import Cardano.Ledger.Alonzo.Scripts (eraLanguages)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Plutus (
hashPlutusScript,
withSLanguage,
)
import Cardano.Ledger.Shelley.Scripts (
pattern RequireAllOf,
pattern RequireSignature,
)
import Control.Monad ((<=<))
import GHC.Exts (fromList)
import Lens.Micro ((&), (.~))
import Lens.Micro.Mtl (use)
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Alonzo.ImpTest
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus.Examples
spec ::
forall era.
( AlonzoEraImp era
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
) =>
SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(AlonzoEraImp era,
InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Valid transactions" forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall era. AlonzoEraScript era => [Language]
eraLanguages @era) forall a b. (a -> b) -> a -> b
$ \Language
lang ->
forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
lang forall a b. (a -> b) -> a -> b
$ \SLanguage l
slang ->
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall a. Show a => a -> String
show Language
lang) forall a b. (a -> b) -> a -> b
$ do
let
alwaysSucceedsWithDatumHash :: ScriptHash
alwaysSucceedsWithDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript forall a b. (a -> b) -> a -> b
$ forall (l :: Language). SLanguage l -> Plutus l
alwaysSucceedsWithDatum SLanguage l
slang :: ScriptHash
alwaysSucceedsNoDatumHash :: ScriptHash
alwaysSucceedsNoDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript forall a b. (a -> b) -> a -> b
$ forall (l :: Language). SLanguage l -> Plutus l
alwaysSucceedsNoDatum SLanguage l
slang :: ScriptHash
alwaysFailsWithDatumHash :: ScriptHash
alwaysFailsWithDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript forall a b. (a -> b) -> a -> b
$ forall (l :: Language). SLanguage l -> Plutus l
alwaysFailsWithDatum SLanguage l
slang :: ScriptHash
alwaysFailsNoDatumHash :: ScriptHash
alwaysFailsNoDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript forall a b. (a -> b) -> a -> b
$ forall (l :: Language). SLanguage l -> Plutus l
alwaysFailsNoDatum SLanguage l
slang :: ScriptHash
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Validating SPEND script" forall a b. (a -> b) -> a -> b
$ do
TxIn
txIn <- forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript ScriptHash
alwaysSucceedsWithDatumHash
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx forall a b. (a -> b) -> a -> b
$
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxIn
txIn]
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Not validating SPEND script" forall a b. (a -> b) -> a -> b
$ do
TxIn
txIn <- forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript ScriptHash
alwaysFailsWithDatumHash
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, AlonzoEraImp era,
InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) =>
Tx era -> ImpTestM era (Tx era)
submitPhase2Invalid forall a b. (a -> b) -> a -> b
$
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxIn
txIn]
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Validating CERT script" forall a b. (a -> b) -> a -> b
$ do
TxIn
txIn <- forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript ScriptHash
alwaysSucceedsWithDatumHash
let txCert :: TxCert era
txCert = forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
RegTxCert forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
alwaysSucceedsNoDatumHash
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx forall a b. (a -> b) -> a -> b
$
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
forall era. EraTxBody era => TxBody era
mkBasicTxBody
forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxIn
txIn]
forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era
txCert]
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Not validating CERT script" forall a b. (a -> b) -> a -> b
$ do
TxIn
txIn <- forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript ScriptHash
alwaysFailsWithDatumHash
let txCert :: TxCert era
txCert = forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
RegTxCert forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
alwaysSucceedsNoDatumHash
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, AlonzoEraImp era,
InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) =>
Tx era -> ImpTestM era (Tx era)
submitPhase2Invalid forall a b. (a -> b) -> a -> b
$
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
forall era. EraTxBody era => TxBody era
mkBasicTxBody
forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxIn
txIn]
forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era
txCert]
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Validating WITHDRAWAL script" forall a b. (a -> b) -> a -> b
$ do
RewardAccount
account <- forall era.
(HasCallStack, ShelleyEraImp era) =>
StakeCredential -> ImpTestM era RewardAccount
registerStakeCredential forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
alwaysSucceedsNoDatumHash
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx forall a b. (a -> b) -> a -> b
$
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals [(RewardAccount
account, forall a. Monoid a => a
mempty)]
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Not validating WITHDRAWAL script" forall a b. (a -> b) -> a -> b
$ do
RewardAccount
account <- forall era.
(HasCallStack, ShelleyEraImp era) =>
StakeCredential -> ImpTestM era RewardAccount
registerStakeCredential forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
alwaysFailsNoDatumHash
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, AlonzoEraImp era,
InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) =>
Tx era -> ImpTestM era (Tx era)
submitPhase2Invalid forall a b. (a -> b) -> a -> b
$
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals [(RewardAccount
account, forall a. Monoid a => a
mempty)]
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Validating MINT script" forall a b. (a -> b) -> a -> b
$ do
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era. MaryEraImp era => ScriptHash -> ImpTestM era (Tx era)
mkTokenMintingTx forall a b. (a -> b) -> a -> b
$ ScriptHash
alwaysSucceedsNoDatumHash
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Not validating MINT script" forall a b. (a -> b) -> a -> b
$ do
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, AlonzoEraImp era,
InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) =>
Tx era -> ImpTestM era (Tx era)
submitPhase2Invalid forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era. MaryEraImp era => ScriptHash -> ImpTestM era (Tx era)
mkTokenMintingTx forall a b. (a -> b) -> a -> b
$ ScriptHash
alwaysFailsNoDatumHash
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Validating scripts everywhere" forall a b. (a -> b) -> a -> b
$ do
SlotNo
slotNo <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall era. SimpleGetter (ImpTestState era) SlotNo
impLastTickG
let
timelockScriptHash :: SlotNo -> ImpM (LedgerSpec era) ScriptHash
timelockScriptHash SlotNo
i = do
KeyHash 'Witness
addr <- forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript forall a b. (a -> b) -> a -> b
$
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf [forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
addr, forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (SlotNo
slotNo forall a. Num a => a -> a -> a
+ SlotNo
100 forall a. Num a => a -> a -> a
+ SlotNo
i)]
scriptAsset :: ScriptHash -> m (PolicyID, b)
scriptAsset ScriptHash
scriptHash = do
Positive b
amount <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptHash -> PolicyID
PolicyID ScriptHash
scriptHash, forall l. IsList l => [Item l] -> l
fromList [(ShortByteString -> AssetName
AssetName ShortByteString
"Test Asset", b
amount)])
ScriptHash
timelockScriptHash0 <- SlotNo -> ImpM (LedgerSpec era) ScriptHash
timelockScriptHash SlotNo
0
ScriptHash
timelockScriptHash1 <- SlotNo -> ImpM (LedgerSpec era) ScriptHash
timelockScriptHash SlotNo
1
ScriptHash
timelockScriptHash2 <- SlotNo -> ImpM (LedgerSpec era) ScriptHash
timelockScriptHash SlotNo
2
let
inputScriptHashes :: [ScriptHash]
inputScriptHashes = [ScriptHash
alwaysSucceedsWithDatumHash, ScriptHash
timelockScriptHash0]
assetScriptHashes :: [ScriptHash]
assetScriptHashes = [ScriptHash
alwaysSucceedsNoDatumHash, ScriptHash
timelockScriptHash1]
rewardScriptHashes :: [ScriptHash]
rewardScriptHashes = [ScriptHash
alwaysSucceedsNoDatumHash, ScriptHash
timelockScriptHash2]
[TxIn]
txIns <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript [ScriptHash]
inputScriptHashes
MultiAsset
multiAsset <- Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {b} {b} {m :: * -> *}.
(Item b ~ (AssetName, b), Num b, Ord b, Arbitrary b, MonadGen m,
IsList b) =>
ScriptHash -> m (PolicyID, b)
scriptAsset [ScriptHash]
assetScriptHashes
[RewardAccount]
rewardAccounts <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall era.
(HasCallStack, ShelleyEraImp era) =>
StakeCredential -> ImpTestM era RewardAccount
registerStakeCredential forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj) [ScriptHash]
rewardScriptHashes
KeyHash 'Payment
outputAddr <- forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash @'Payment
let
txOut :: TxOut era
txOut =
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
(forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyHash 'Payment
outputAddr StakeReference
StakeRefNull)
(Coin -> MultiAsset -> MaryValue
MaryValue forall a. Monoid a => a
mempty MultiAsset
multiAsset)
txBody :: TxBody era
txBody =
forall era. EraTxBody era => TxBody era
mkBasicTxBody
forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall l. IsList l => [Item l] -> l
fromList [TxIn]
txIns
forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ SlotNo
slotNo forall a. Num a => a -> a -> a
+ SlotNo
1)
forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
multiAsset
forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals (forall l. IsList l => [Item l] -> l
fromList [(RewardAccount
acct, forall a. Monoid a => a
mempty) | RewardAccount
acct <- [RewardAccount]
rewardAccounts])
forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall l. IsList l => [Item l] -> l
fromList (forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era
UnRegTxCert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptHash]
rewardScriptHashes)
forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxOut era
txOut]
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era ()
expectTxSuccess forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx forall a b. (a -> b) -> a -> b
$ forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
txBody
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Acceptable supplimentary datum" forall a b. (a -> b) -> a -> b
$ do
forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Expectation
pendingWith String
"not implemented yet"
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Multiple identical certificates" forall a b. (a -> b) -> a -> b
$ do
forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Expectation
pendingWith String
"not implemented yet"
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Non-script output with datum" forall a b. (a -> b) -> a -> b
$ do
forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Expectation
pendingWith String
"not implemented yet"