Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

added Docstrings

Browse source 
Emily's suggestions
This commit is contained in:
Seungheon Oh 2022-06-01 10:34:51 -05:00
parent 9b95e61400
commit 00bc19bf80
2 changed files with 12 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

11
agora-specs/Property/Generator.hs
View file

@ -16,7 +16,7 @@ module Property.Generator (
-- * Values -- * Values
genValue, genValue,
genAssetClass, genAssetClass,
genAnyValue, genSingletonValue,
) where ) where
import Control.Applicative (Applicative (liftA2)) import Control.Applicative (Applicative (liftA2))
@ -74,14 +74,16 @@ genAddress :: Gen Address
genAddress = flip Address Nothing <$> genCredential genAddress = flip Address Nothing <$> genCredential
{- | Random Value of given AssetClass {- | 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 :: AssetClass -> Gen Value
genValue ac = assetClassValue ac . abs <$> (arbitrary :: Gen Integer) genValue ac = assetClassValue ac . abs <$> (arbitrary :: Gen Integer)
-- | Random bytestring but only with alphabets for better legibility.
genPrettyByteString :: Gen C.ByteString genPrettyByteString :: Gen C.ByteString
genPrettyByteString = C.pack <$> listOf1 (elements ['a' .. 'z']) genPrettyByteString = C.pack <$> listOf1 (elements ['a' .. 'z'])
-- | Random @AssetClass@ with pretty token name.
genAssetClass :: Gen AssetClass genAssetClass :: Gen AssetClass
genAssetClass = genAssetClass =
AssetClass AssetClass
@ -90,5 +92,6 @@ genAssetClass =
(currencySymbol <$> genHashByteString) (currencySymbol <$> genHashByteString)
(tokenName <$> genPrettyByteString) (tokenName <$> genPrettyByteString)
genAnyValue :: Gen Value -- | Random *singleton* value with random @AssetClass@.
genAnyValue = genAssetClass >>= genValue genSingletonValue :: Gen Value
genSingletonValue = genAssetClass >>= genValue

7
agora-specs/Property/MultiSig.hs
View file

@ -28,7 +28,7 @@ import Plutus.V1.Ledger.Api (
ScriptContext (scriptContextTxInfo), ScriptContext (scriptContextTxInfo),
TxInfo (txInfoSignatories), TxInfo (txInfoSignatories),
) )
import Property.Generator (genAnyValue, genPubKeyHash) import Property.Generator (genPubKeyHash, genSingletonValue)
import Test.Tasty (TestTree) import Test.Tasty (TestTree)
import Test.Tasty.Plutarch.Property (classifiedProperty) import Test.Tasty.Plutarch.Property (classifiedProperty)
import Test.Tasty.QuickCheck ( import Test.Tasty.QuickCheck (
@ -63,7 +63,7 @@ genMultiSigProp :: MultiSigProp -> Gen MultiSigModel
genMultiSigProp prop = do genMultiSigProp prop = do
size <- chooseInt (4, 20) size <- chooseInt (4, 20)
pkhs <- vectorOf size genPubKeyHash pkhs <- vectorOf size genPubKeyHash
vutxo <- ValidatorUTXO () <$> genAnyValue vutxo <- ValidatorUTXO () <$> genSingletonValue
minSig <- chooseInt (1, length pkhs) minSig <- chooseInt (1, length pkhs)
othersigners <- take 20 <$> listOf genPubKeyHash othersigners <- take 20 <$> listOf genPubKeyHash
@ -89,6 +89,7 @@ classifyMultiSigProp (MultiSig keys (fromIntegral -> minsig), ctx)
shrinkMultiSigProp :: MultiSigModel -> [MultiSigModel] shrinkMultiSigProp :: MultiSigModel -> [MultiSigModel]
shrinkMultiSigProp = const [] shrinkMultiSigProp = const []
-- | Expected behavior of @pvalidatedByMultisig@.
expected :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PMaybe PBool) expected :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PMaybe PBool)
expected = plam $ \x -> unTermCont $ do expected = plam $ \x -> unTermCont $ do
ms <- tclet $ pfstBuiltin # x ms <- tclet $ pfstBuiltin # x
@ -98,12 +99,14 @@ expected = plam $ \x -> unTermCont $ do
validSigners = plength #$ pfilter # plam (\x -> pelem # x # multsig.keys) # signers validSigners = plength #$ pfilter # plam (\x -> pelem # x # multsig.keys) # signers
pure $ pcon $ PJust $ pfromData multsig.minSigs #<= validSigners pure $ pcon $ PJust $ pfromData multsig.minSigs #<= validSigners
-- | Actual implementation of @pvalidatedByMultisig@.
actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool) actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool)
actual = plam $ \x -> unTermCont $ do actual = plam $ \x -> unTermCont $ do
ms <- tclet $ pfstBuiltin # x ms <- tclet $ pfstBuiltin # x
sc <- tclet $ psndBuiltin # x sc <- tclet $ psndBuiltin # x
pure $ pvalidatedByMultisig # ms # (pfield @"txInfo" # sc) pure $ pvalidatedByMultisig # ms # (pfield @"txInfo" # sc)
-- | Proposed property.
prop :: Property prop :: Property
prop = classifiedProperty genMultiSigProp shrinkMultiSigProp expected classifyMultiSigProp actual prop = classifiedProperty genMultiSigProp shrinkMultiSigProp expected classifyMultiSigProp actual