diff --git a/src/Cooked/Validators.hs b/src/Cooked/Validators.hs index ab4a5ef8e..c7e12eed0 100644 --- a/src/Cooked/Validators.hs +++ b/src/Cooked/Validators.hs @@ -1,7 +1,5 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -- | This module introduces standard dummy validators to be used in @@ -23,17 +21,17 @@ import qualified PlutusTx as Pl -- a sufficient target for the datum hijacking attack since we only -- want to show feasibility of the attack. alwaysTrueValidator :: Pl.TypedValidator a -alwaysTrueValidator = unsafeTypedValidatorFromUPLC (Pl.getPlc $$(Pl.compile [||tgt||])) +alwaysTrueValidator = unsafeTypedValidatorFromUPLC $ Pl.getPlc $$(Pl.compile [||tgt||]) where - tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> () - tgt _ _ _ = () + tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> Bool + tgt _ _ _ = True -- | The trivial validator that always fails alwaysFalseValidator :: Pl.TypedValidator a -alwaysFalseValidator = unsafeTypedValidatorFromUPLC (Pl.getPlc $$(Pl.compile [||tgt||])) +alwaysFalseValidator = unsafeTypedValidatorFromUPLC $ Pl.getPlc $$(Pl.compile [||tgt||]) where - tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> () - tgt _ _ _ = error "This validator always fails." + tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> Bool + tgt _ _ _ = False -- | A Mock contract type to instantiate validators with data MockContract diff --git a/tests/Cooked/InitialDistributionSpec.hs b/tests/Cooked/InitialDistributionSpec.hs index 3e7eb1710..c72e799e7 100644 --- a/tests/Cooked/InitialDistributionSpec.hs +++ b/tests/Cooked/InitialDistributionSpec.hs @@ -61,7 +61,7 @@ spendReferenceAlwaysTrueValidator = do tests :: TestTree tests = testGroup - "initial distributions" + "Initial distributions" [ testCase "Reading datums placed in the initial distribution, inlined, hashed or vanilla" $ testSucceedsFrom' def (\results _ -> testBool $ results == [10, 10, 10]) initialDistributionWithDatum getValueFromInitialDatum, testCase "Spending a script placed as a reference script in the initial distribution" $ diff --git a/tests/Cooked/MinAdaSpec.hs b/tests/Cooked/MinAdaSpec.hs index 9dc715eeb..37583d74f 100644 --- a/tests/Cooked/MinAdaSpec.hs +++ b/tests/Cooked/MinAdaSpec.hs @@ -50,7 +50,7 @@ paymentWithoutMinAda paidLovelaces = do tests :: TestTree tests = testGroup - "automatic minAda adjustment of transaction outputs" + "MinAda auto adjustment of transaction outputs" [ testCase "adjusted transaction passes" $ testSucceeds def paymentWithMinAda, testCase "adjusted transaction contains minimal amount" $ testFails diff --git a/tests/Cooked/ReferenceScriptsSpec.hs b/tests/Cooked/ReferenceScriptsSpec.hs index 1787ba4f4..5f31bc31d 100644 --- a/tests/Cooked/ReferenceScriptsSpec.hs +++ b/tests/Cooked/ReferenceScriptsSpec.hs @@ -28,30 +28,6 @@ import qualified Prettyprinter as PP import Test.Tasty import Test.Tasty.HUnit --- | The validator that always agrees to the transaction -yesValidator :: Pl.TypedValidator MockContract -yesValidator = - Pl.mkTypedValidator @MockContract - $$(Pl.compile [||val||]) - $$(Pl.compile [||wrap||]) - where - val :: () -> () -> Pl.ScriptContext -> Bool - val _ _ _ = True - - wrap = Pl.mkUntypedValidator - --- | The validator that never agrees to the transaction -noValidator :: Pl.TypedValidator MockContract -noValidator = - Pl.mkTypedValidator @MockContract - $$(Pl.compile [||val||]) - $$(Pl.compile [||wrap||]) - where - val :: () -> () -> Pl.ScriptContext -> Bool - val _ _ _ = False - - wrap = Pl.mkUntypedValidator - -- | This validator ensures that the given public key signs the transaction. requireSignerValidator :: Pl.PubKeyHash -> Pl.TypedValidator MockContract requireSignerValidator = @@ -182,9 +158,9 @@ useReferenceScript spendingSubmitter theScript = do tests :: TestTree tests = testGroup - "reference scripts" + "Reference scripts" [ testGroup "putting reference scripts on chain and retreiving them" $ - let theRefScript = noValidator + let theRefScript = alwaysFalseValidator theRefScriptHash = toScriptHash theRefScript in [ testCase "on a public key output" $ testSucceedsFrom' @@ -204,7 +180,7 @@ tests = Just theRefScriptHash .==. mScriptHash ) def - $ putRefScriptOnScriptOutput yesValidator theRefScript + $ putRefScriptOnScriptOutput alwaysTrueValidator theRefScript >>= retrieveRefScriptHash, testCase "retreiving the complete script from its hash" $ testSucceedsFrom' @@ -227,12 +203,12 @@ tests = def (== "there is no reference input with the correct script hash") ) - $ putRefScriptOnWalletOutput (wallet 3) noValidator - >>= checkReferenceScriptOnOref (toScriptHash yesValidator), + $ putRefScriptOnWalletOutput (wallet 3) alwaysFalseValidator + >>= checkReferenceScriptOnOref (toScriptHash alwaysTrueValidator), testCase "succeed if correct reference script" $ testSucceeds def $ - putRefScriptOnWalletOutput (wallet 3) yesValidator - >>= checkReferenceScriptOnOref (toScriptHash yesValidator) + putRefScriptOnWalletOutput (wallet 3) alwaysTrueValidator + >>= checkReferenceScriptOnOref (toScriptHash alwaysTrueValidator) ], testGroup "using reference scripts" @@ -256,7 +232,7 @@ tests = txSkelTemplate { txSkelOuts = [ paysScript - yesValidator + (alwaysTrueValidator @MockContract) () (Pl.lovelaceValueOf 42_000_000) ], @@ -280,14 +256,14 @@ tests = ) def $ do - scriptOref <- putRefScriptOnWalletOutput (wallet 3) noValidator + scriptOref <- putRefScriptOnWalletOutput (wallet 3) alwaysFalseValidator (oref, _) : _ <- utxosFromCardanoTx <$> validateTxSkel txSkelTemplate { txSkelOuts = [ paysScript - yesValidator + (alwaysTrueValidator @MockContract) () (Pl.lovelaceValueOf 42_000_000) ], @@ -309,14 +285,14 @@ tests = ) def $ do - scriptOref <- putRefScriptOnWalletOutput (wallet 3) yesValidator + scriptOref <- putRefScriptOnWalletOutput (wallet 3) alwaysTrueValidator (oref, _) : _ <- utxosFromCardanoTx <$> validateTxSkel txSkelTemplate { txSkelOuts = [ paysScript - yesValidator + (alwaysTrueValidator @MockContract) () (Pl.lovelaceValueOf 42_000_000) ], diff --git a/tests/Cooked/ShowBSSpec.hs b/tests/Cooked/ShowBSSpec.hs index 0fd258a06..ae1d584e4 100644 --- a/tests/Cooked/ShowBSSpec.hs +++ b/tests/Cooked/ShowBSSpec.hs @@ -65,7 +65,7 @@ printTrace = do tests :: TestTree tests = testGroup - "printing to BuiltinString" + "BuiltinString serializing" [ testCase "a few simple examples" $ testConjoin $ map diff --git a/tests/Spec.hs b/tests/Spec.hs index 072b58aca..dc8836612 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -1,6 +1,4 @@ import qualified Cooked.AttackSpec as AttackSpec --- import qualified Cooked.BalanceSpec as Ba - import qualified Cooked.InitialDistributionSpec as InitDistrib import qualified Cooked.InlineDatumsSpec as InlineDatumsSpec import qualified Cooked.LtlSpec as LtlSpec @@ -10,34 +8,21 @@ import qualified Cooked.ReferenceInputsSpec as ReferenceInputsSpec import qualified Cooked.ReferenceScriptsSpec as ReferenceScriptsSpec import qualified Cooked.ShowBSSpec as ShowBSSpec import qualified Cooked.TweakSpec as TweakSpec --- import qualified Cooked.MockChain.Monad.StagedSpec as StagedSpec --- import qualified Cooked.MockChain.UtxoStateSpec as UtxoStateSpec --- import qualified Cooked.WalletSpec as WalletSpec --- import qualified Cooked.OutputReorderingSpec as OutputReorderingSpec --- import qualified Cooked.QuickValueSpec as QuickValueSpec import Test.Tasty main :: IO () -main = defaultMain tests - -tests :: TestTree -tests = - testGroup - "cooked-validators" - [ -- testGroup "Reordering outputs" OutputReorderingSpec.tests, - -- testGroup "Balancing transactions" Ba.tests, - -- testGroup "Quick values" QuickValueSpec.tests, - -- testGroup "Staged monad" StagedSpec.tests, - -- testGroup "UtxoState" UtxoStateSpec.tests, - -- testGroup "Wallet" WalletSpec.tests, - MinAdaSpec.tests, - InlineDatumsSpec.tests, - ReferenceInputsSpec.tests, - ReferenceScriptsSpec.tests, - AttackSpec.tests, - TweakSpec.tests, - LtlSpec.tests, - MockChainSpec.tests, - ShowBSSpec.tests, - InitDistrib.tests - ] +main = + defaultMain $ + testGroup + "cooked-validators" + [ MinAdaSpec.tests, + InlineDatumsSpec.tests, + ReferenceInputsSpec.tests, + ReferenceScriptsSpec.tests, + AttackSpec.tests, + TweakSpec.tests, + LtlSpec.tests, + MockChainSpec.tests, + ShowBSSpec.tests, + InitDistrib.tests + ]