remove Int apropos-tx example, move Model.* to Spec.Model.*
This commit is contained in:
parent
0b422f83da
commit
f7721f13eb
4 changed files with 36 additions and 144 deletions
|
|
@ -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
|
||||
]
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
]
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue