remove Int apropos-tx example, move Model.* to Spec.Model.*

This commit is contained in:
Emily Martins 2022-03-21 15:39:38 +01:00
parent 0b422f83da
commit f7721f13eb
4 changed files with 36 additions and 144 deletions

View file

@ -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
]
]
]

View file

@ -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
]

View file

@ -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

View file

@ -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