diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index fada856..d326e84 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -8,8 +8,7 @@ import Test.Tasty (defaultMain, testGroup) -------------------------------------------------------------------------------- -import Model.MultiSig qualified -import Spec.Int +import Spec.Model.MultiSig qualified as MultiSig import Spec.Stake qualified as Stake main :: IO () @@ -18,18 +17,14 @@ main = testGroup "test suite" [ testGroup - "sample-tests" + "Stake tests" Stake.tests , testGroup - "apropos-tx" + "Multisig tests" [ testGroup - "Int" - [ intPlutarchTests - ] - , testGroup "MultiSig" - [ Model.MultiSig.plutarchTests - , Model.MultiSig.genTests + [ MultiSig.plutarchTests + , MultiSig.genTests ] ] ] diff --git a/agora-test/Spec/Int.hs b/agora-test/Spec/Int.hs deleted file mode 100644 index f89abdc..0000000 --- a/agora-test/Spec/Int.hs +++ /dev/null @@ -1,97 +0,0 @@ -module Spec.Int (HasLogicalModel (..), IntProp (..), intGenTests, intPureTests, intPlutarchTests) where - -import Apropos -import Apropos.Script -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (fromGroup) - -import Plutarch (compile) - -data IntProp - = IsNegative - | IsPositive - | IsZero - | IsLarge - | IsSmall - | IsMaxBound - | IsMinBound - deriving stock (Eq, Ord, Enum, Show, Bounded) - -instance Enumerable IntProp where - enumerated = [minBound .. maxBound] - -instance LogicalModel IntProp where - logic = - ExactlyOne [Var IsNegative, Var IsPositive, Var IsZero] - :&&: ExactlyOne [Var IsLarge, Var IsSmall] - :&&: (Var IsZero :->: Var IsSmall) - :&&: (Var IsMaxBound :->: (Var IsLarge :&&: Var IsPositive)) - :&&: (Var IsMinBound :->: (Var IsLarge :&&: Var IsNegative)) - -instance HasLogicalModel IntProp Int where - satisfiesProperty IsNegative i = i < 0 - satisfiesProperty IsPositive i = i > 0 - satisfiesProperty IsMaxBound i = i == maxBound - satisfiesProperty IsMinBound i = i == minBound - satisfiesProperty IsZero i = i == 0 - satisfiesProperty IsLarge i = i > 10 || i < -10 - satisfiesProperty IsSmall i = i <= 10 && i >= -10 - -instance HasParameterisedGenerator IntProp Int where - parameterisedGenerator s = do - i <- - if IsZero `elem` s - then pure 0 - else - if IsSmall `elem` s - then int (linear 1 10) - else - if IsMaxBound `elem` s - then pure maxBound - else int (linear 11 (maxBound - 1)) - if IsNegative `elem` s - then - if IsMinBound `elem` s - then pure minBound - else pure (-i) - else pure i - -intGenTests :: TestTree -intGenTests = - testGroup "intGenTests" $ - fromGroup - <$> [ runGeneratorTestsWhere (Apropos :: Int :+ IntProp) "Int Generator" Yes - ] - -instance HasPureRunner IntProp Int where - expect _ = Var IsSmall :&&: Var IsNegative - script _ i = i < 0 && i >= -10 - -intPureTests :: TestTree -intPureTests = - testGroup "intPureTests" $ - fromGroup - <$> [ runPureTestsWhere (Apropos :: Int :+ IntProp) "AcceptsSmallNegativeInts" Yes - ] - -instance HasScriptRunner IntProp Int where - expect _ = Var IsSmall :&&: Var IsNegative - script _ i = - let ii = fromIntegral i :: Integer - in compile - ( pif - ( ( fromInteger ii - #< (0 :: Term s PInteger) - ) - #&& ((fromInteger (-10) :: Term s PInteger) #<= fromInteger ii) - ) - (pcon PUnit) - perror - ) - -intPlutarchTests :: TestTree -intPlutarchTests = - testGroup "intPlutarchTests" $ - fromGroup - <$> [ runScriptTestsWhere (Apropos :: Int :+ IntProp) "AcceptsSmallNegativeInts" Yes - ] diff --git a/agora-test/Model/MultiSig.hs b/agora-test/Spec/Model/MultiSig.hs similarity index 89% rename from agora-test/Model/MultiSig.hs rename to agora-test/Spec/Model/MultiSig.hs index 8630617..67fea2d 100644 --- a/agora-test/Model/MultiSig.hs +++ b/agora-test/Spec/Model/MultiSig.hs @@ -1,21 +1,12 @@ -module Model.MultiSig (plutarchTests, genTests) where +module Spec.Model.MultiSig ( + plutarchTests, + genTests, +) where -import Agora.MultiSig (MultiSig (..), validatedByMultisig) -import Apropos ( - Apropos (Apropos), - Formula (ExactlyOne, Var, Yes), - HasLogicalModel (..), - HasParameterisedGenerator, - LogicalModel (logic), - parameterisedGenerator, - runGeneratorTestsWhere, - (:+), - ) -import Apropos.Gen (Gen, choice, int, linear, list) -import Apropos.LogicalModel (Enumerable) -import Apropos.LogicalModel.Enumerable (Enumerable (enumerated)) -import Apropos.Script (HasScriptRunner (expect, runScriptTestsWhere, script)) import Data.List (intersect) + +-------------------------------------------------------------------------------- + import Plutarch (compile) import Plutus.V1.Ledger.Api ( Script, @@ -40,29 +31,31 @@ import Plutus.V1.Ledger.Contexts (ScriptContext (ScriptContext), TxInfo (TxInfo) import Plutus.V1.Ledger.Crypto (PubKeyHash) import Plutus.V1.Ledger.Interval qualified as Interval import Plutus.V1.Ledger.Value qualified as Value + +-------------------------------------------------------------------------------- + +import Apropos ( + Apropos (Apropos), + Formula (ExactlyOne, Var, Yes), + HasLogicalModel (..), + HasParameterisedGenerator, + LogicalModel (logic), + parameterisedGenerator, + runGeneratorTestsWhere, + (:+), + ) +import Apropos.Gen (Gen, choice, int, linear, list) +import Apropos.LogicalModel (Enumerable) +import Apropos.LogicalModel.Enumerable (Enumerable (enumerated)) +import Apropos.Script (HasScriptRunner (expect, runScriptTestsWhere, script)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (fromGroup) -{- Function definitions for reference: +-------------------------------------------------------------------------------- -{- | A MultiSig represents a proof that a particular set of - signatures are present on a transaction. --} -data MultiSig = MultiSig - { keys :: [PubKeyHash] - -- ^ List of PubKeyHashes that must be present in the list of signatories. - , minSigs :: Integer - } - deriving stock (GHC.Generic, Eq, Show) - deriving anyclass (Generic) +import Agora.MultiSig (MultiSig (..), validatedByMultisig) --- | Check if a Haskell-level MultiSig signs this transaction. -validatedByMultisig :: MultiSig -> Term s (PTxInfo :--> PBool) -validatedByMultisig params = - phoistAcyclic $ - pvalidatedByMultisig # pconstant params - --} +-------------------------------------------------------------------------------- -- | apropos model for testing multisigs. data MultiSigModel = MultiSigModel diff --git a/agora.cabal b/agora.cabal index be8ab96..23748b3 100644 --- a/agora.cabal +++ b/agora.cabal @@ -148,10 +148,11 @@ test-suite agora-test main-is: Spec.hs hs-source-dirs: agora-test other-modules: - Spec.Int - Spec.Sample.Stake Spec.Stake - Model.MultiSig + Spec.Sample.Stake + + Spec.Model.MultiSig + Spec.Util build-depends: agora