diff --git a/agora-specs/Property/Generator.hs b/agora-specs/Property/Generator.hs index c6d7146..3a176ad 100644 --- a/agora-specs/Property/Generator.hs +++ b/agora-specs/Property/Generator.hs @@ -16,7 +16,7 @@ module Property.Generator ( -- * Values genValue, genAssetClass, - genAnyValue, + genSingletonValue, ) where import Control.Applicative (Applicative (liftA2)) @@ -74,14 +74,16 @@ genAddress :: Gen Address genAddress = flip Address Nothing <$> genCredential {- | Random Value of given AssetClass -`genAnyValue` will create a random value with a random assetclass. +`genSingletonValue` will create a random value with a random assetclass. -} genValue :: AssetClass -> Gen Value genValue ac = assetClassValue ac . abs <$> (arbitrary :: Gen Integer) +-- | Random bytestring but only with alphabets for better legibility. genPrettyByteString :: Gen C.ByteString genPrettyByteString = C.pack <$> listOf1 (elements ['a' .. 'z']) +-- | Random @AssetClass@ with pretty token name. genAssetClass :: Gen AssetClass genAssetClass = AssetClass @@ -90,5 +92,6 @@ genAssetClass = (currencySymbol <$> genHashByteString) (tokenName <$> genPrettyByteString) -genAnyValue :: Gen Value -genAnyValue = genAssetClass >>= genValue +-- | Random *singleton* value with random @AssetClass@. +genSingletonValue :: Gen Value +genSingletonValue = genAssetClass >>= genValue diff --git a/agora-specs/Property/MultiSig.hs b/agora-specs/Property/MultiSig.hs index efca9ca..070b9e3 100644 --- a/agora-specs/Property/MultiSig.hs +++ b/agora-specs/Property/MultiSig.hs @@ -28,7 +28,7 @@ import Plutus.V1.Ledger.Api ( ScriptContext (scriptContextTxInfo), TxInfo (txInfoSignatories), ) -import Property.Generator (genAnyValue, genPubKeyHash) +import Property.Generator (genPubKeyHash, genSingletonValue) import Test.Tasty (TestTree) import Test.Tasty.Plutarch.Property (classifiedProperty) import Test.Tasty.QuickCheck ( @@ -63,7 +63,7 @@ genMultiSigProp :: MultiSigProp -> Gen MultiSigModel genMultiSigProp prop = do size <- chooseInt (4, 20) pkhs <- vectorOf size genPubKeyHash - vutxo <- ValidatorUTXO () <$> genAnyValue + vutxo <- ValidatorUTXO () <$> genSingletonValue minSig <- chooseInt (1, length pkhs) othersigners <- take 20 <$> listOf genPubKeyHash @@ -89,6 +89,7 @@ classifyMultiSigProp (MultiSig keys (fromIntegral -> minsig), ctx) shrinkMultiSigProp :: MultiSigModel -> [MultiSigModel] shrinkMultiSigProp = const [] +-- | Expected behavior of @pvalidatedByMultisig@. expected :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PMaybe PBool) expected = plam $ \x -> unTermCont $ do ms <- tclet $ pfstBuiltin # x @@ -98,12 +99,14 @@ expected = plam $ \x -> unTermCont $ do validSigners = plength #$ pfilter # plam (\x -> pelem # x # multsig.keys) # signers pure $ pcon $ PJust $ pfromData multsig.minSigs #<= validSigners +-- | Actual implementation of @pvalidatedByMultisig@. actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool) actual = plam $ \x -> unTermCont $ do ms <- tclet $ pfstBuiltin # x sc <- tclet $ psndBuiltin # x pure $ pvalidatedByMultisig # ms # (pfield @"txInfo" # sc) +-- | Proposed property. prop :: Property prop = classifiedProperty genMultiSigProp shrinkMultiSigProp expected classifyMultiSigProp actual