apply suggestions and fix remaining haddock suggestions
This commit is contained in:
Emily Martins
parent
210a6195b6
commit
633c3bea9e
10 changed files with 70 additions and 34 deletions
|
|
@ -1,3 +1,10 @@
|
|||
{- |
|
||||
Module : Spec.Model.MultiSig
|
||||
Maintainer : emi@haskell.fyi
|
||||
Description: apropos-tx model and tests for 'MultiSig' functions
|
||||
|
||||
apropos-tx model and tests for 'MultiSig' functions
|
||||
-}
|
||||
module Spec.Model.MultiSig (
|
||||
plutarchTests,
|
||||
genTests,
|
||||
|
|
@ -7,7 +14,6 @@ import Data.List (intersect)
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutarch (compile)
|
||||
import Plutus.V1.Ledger.Api (
|
||||
Script,
|
||||
ScriptContext (scriptContextPurpose),
|
||||
|
|
@ -165,6 +171,7 @@ instance HasScriptRunner MultiSigProp MultiSigModel where
|
|||
(pcon PUnit)
|
||||
perror
|
||||
|
||||
-- | Consistency tests for the 'HasParameterisedGenerator' instance of 'MultiSigModel'
|
||||
genTests :: TestTree
|
||||
genTests =
|
||||
testGroup "genTests" $
|
||||
|
|
@ -175,6 +182,7 @@ genTests =
|
|||
Yes
|
||||
]
|
||||
|
||||
-- | Tests for the 'HasScriptRunner' instance of 'MultiSigModel'
|
||||
plutarchTests :: TestTree
|
||||
plutarchTests =
|
||||
testGroup "plutarchTests" $
|
||||
|
|
|
|||
|
|
@ -58,25 +58,30 @@ import Spec.Util (datumPair, toDatumHash)
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | 'Stake' parameters for 'LQ'.
|
||||
stake :: Stake LQ
|
||||
stake = Stake
|
||||
|
||||
-- | 'Stake' policy instance.
|
||||
policy :: MintingPolicy
|
||||
policy = mkMintingPolicy (stakePolicy stake)
|
||||
|
||||
policySymbol :: CurrencySymbol
|
||||
policySymbol = mintingPolicySymbol policy
|
||||
|
||||
-- | A sample 'PubKeyHash'.
|
||||
signer :: PubKeyHash
|
||||
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
|
||||
|
||||
-- | 'Stake' validator instance.
|
||||
validator :: Validator
|
||||
validator = mkValidator (stakeValidator stake)
|
||||
|
||||
-- | 'TokenName' that represents the hash of the 'Stake' validator.
|
||||
validatorHashTN :: TokenName
|
||||
validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
|
||||
|
||||
-- | This script context should be a valid transaction
|
||||
-- | This script context should be a valid transaction.
|
||||
stakeCreation :: ScriptContext
|
||||
stakeCreation =
|
||||
let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST
|
||||
|
|
@ -105,7 +110,7 @@ stakeCreation =
|
|||
, scriptContextPurpose = Minting policySymbol
|
||||
}
|
||||
|
||||
-- | This ScriptContext should fail because the datum has too much GT
|
||||
-- | This ScriptContext should fail because the datum has too much GT.
|
||||
stakeCreationWrongDatum :: ScriptContext
|
||||
stakeCreationWrongDatum =
|
||||
let datum :: Datum
|
||||
|
|
@ -115,7 +120,7 @@ stakeCreationWrongDatum =
|
|||
, scriptContextPurpose = Minting policySymbol
|
||||
}
|
||||
|
||||
-- | This ScriptContext should fail because the datum has too much GT
|
||||
-- | This ScriptContext should fail because the datum has too much GT.
|
||||
stakeCreationUnsigned :: ScriptContext
|
||||
stakeCreationUnsigned =
|
||||
ScriptContext
|
||||
|
|
@ -128,11 +133,15 @@ stakeCreationUnsigned =
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Config for creating a ScriptContext that deposits or withdraws.
|
||||
data DepositWithdrawExample = DepositWithdrawExample
|
||||
{ startAmount :: Integer
|
||||
-- ^ The amount of GT stored before the transaction.
|
||||
, delta :: Integer
|
||||
-- ^ The amount of GT deposited or withdrawn from the Stake.
|
||||
}
|
||||
|
||||
-- | Create a ScriptContext that deposits or withdraws, given the config for it.
|
||||
stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
|
||||
stakeDepositWithdraw config =
|
||||
let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ module Spec.Util (
|
|||
validatorSucceedsWith,
|
||||
validatorFailsWith,
|
||||
|
||||
-- * Plutus land utils
|
||||
-- * Plutus-land utils
|
||||
datumHash,
|
||||
toDatum,
|
||||
toDatumHash,
|
||||
|
|
@ -30,13 +30,11 @@ import Test.Tasty.HUnit (assertFailure, testCase)
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutarch
|
||||
import Plutarch.Api.V1 (PMintingPolicy, PValidator)
|
||||
import Plutarch.Builtin (pforgetData)
|
||||
import Plutarch.Crypto (pblake2b_256)
|
||||
import Plutarch.Evaluate (evalScript)
|
||||
import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
|
||||
import Plutarch.Prelude ()
|
||||
import Plutus.V1.Ledger.Contexts (ScriptContext)
|
||||
import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script)
|
||||
import PlutusTx.Builtins qualified as PlutusTx
|
||||
|
|
@ -44,6 +42,7 @@ import PlutusTx.IsData qualified as PlutusTx
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Check that a policy script succeeds, given a name and arguments.
|
||||
policySucceedsWith ::
|
||||
( PLift redeemer
|
||||
, PlutusTx.ToData (PLifted redeemer)
|
||||
|
|
@ -61,6 +60,7 @@ policySucceedsWith tag policy redeemer scriptContext =
|
|||
# pconstant scriptContext
|
||||
)
|
||||
|
||||
-- | Check that a policy script fails, given a name and arguments.
|
||||
policyFailsWith ::
|
||||
( PLift redeemer
|
||||
, PlutusTx.ToData (PLifted redeemer)
|
||||
|
|
@ -78,6 +78,7 @@ policyFailsWith tag policy redeemer scriptContext =
|
|||
# pconstant scriptContext
|
||||
)
|
||||
|
||||
-- | Check that a validator script succeeds, given a name and arguments.
|
||||
validatorSucceedsWith ::
|
||||
( PLift datum
|
||||
, PlutusTx.ToData (PLifted datum)
|
||||
|
|
@ -99,6 +100,7 @@ validatorSucceedsWith tag policy datum redeemer scriptContext =
|
|||
# pconstant scriptContext
|
||||
)
|
||||
|
||||
-- | Check that a validator script fails, given a name and arguments.
|
||||
validatorFailsWith ::
|
||||
( PLift datum
|
||||
, PlutusTx.ToData (PLifted datum)
|
||||
|
|
@ -120,6 +122,7 @@ validatorFailsWith tag policy datum redeemer scriptContext =
|
|||
# pconstant scriptContext
|
||||
)
|
||||
|
||||
-- | Check that an arbitrary script doesn't error when evaluated, given a name.
|
||||
scriptSucceeds :: String -> Script -> TestTree
|
||||
scriptSucceeds name script = testCase name $ do
|
||||
let (res, _budget, traces) = evalScript script
|
||||
|
|
@ -130,6 +133,7 @@ scriptSucceeds name script = testCase name $ do
|
|||
Right _v ->
|
||||
pure ()
|
||||
|
||||
-- | Check that an arbitrary script **does** error when evaluated, given a name.
|
||||
scriptFails :: String -> Script -> TestTree
|
||||
scriptFails name script = testCase name $ do
|
||||
let (res, _budget, traces) = evalScript script
|
||||
|
|
@ -142,7 +146,7 @@ scriptFails name script = testCase name $ do
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{- | Create a pair from data for use in 'txInfoData'
|
||||
{- | Create a pair from data for use in 'txInfoData'.
|
||||
|
||||
Example:
|
||||
@
|
||||
|
|
@ -152,13 +156,18 @@ scriptFails name script = testCase name $ do
|
|||
datumPair :: PlutusTx.ToData a => a -> (DatumHash, Datum)
|
||||
datumPair = (,) <$> toDatumHash <*> toDatum
|
||||
|
||||
-- | Calculate the blake2b-256 hash of a Datum.
|
||||
datumHash :: Datum -> DatumHash
|
||||
datumHash (Datum data') = toDatumHash data'
|
||||
|
||||
-- | Convenience function to create a Datum from any type that implements ToData.
|
||||
toDatum :: PlutusTx.ToData a => a -> Datum
|
||||
toDatum = Datum . PlutusTx.toBuiltinData
|
||||
|
||||
-- Shamelessly go through plutus.
|
||||
{- | Calculate the blake2b-256 hash of any type that implements ToData
|
||||
|
||||
Shamelessly go through plutus.
|
||||
-}
|
||||
toDatumHash :: PlutusTx.ToData a => a -> DatumHash
|
||||
toDatumHash datum =
|
||||
DatumHash $
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue