Use native expected function

This commit is contained in:
Seungheon Oh 2022-06-01 12:28:21 -05:00
parent 00bc19bf80
commit 632ac6dc47
3 changed files with 14 additions and 17 deletions

View file

@ -30,7 +30,7 @@ import Plutus.V1.Ledger.Api (
) )
import Property.Generator (genPubKeyHash, genSingletonValue) import Property.Generator (genPubKeyHash, genSingletonValue)
import Test.Tasty (TestTree) import Test.Tasty (TestTree)
import Test.Tasty.Plutarch.Property (classifiedProperty) import Test.Tasty.Plutarch.Property (classifiedPropertyNative)
import Test.Tasty.QuickCheck ( import Test.Tasty.QuickCheck (
Gen, Gen,
Property, Property,
@ -90,14 +90,10 @@ shrinkMultiSigProp :: MultiSigModel -> [MultiSigModel]
shrinkMultiSigProp = const [] shrinkMultiSigProp = const []
-- | Expected behavior of @pvalidatedByMultisig@. -- | Expected behavior of @pvalidatedByMultisig@.
expected :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PMaybe PBool) expectedHs :: MultiSigModel -> Maybe Bool
expected = plam $ \x -> unTermCont $ do expectedHs model = case classifyMultiSigProp model of
ms <- tclet $ pfstBuiltin # x MeetsMinSigs -> Just True
sc <- tclet $ psndBuiltin # x _ -> Just False
multsig <- tcont $ pletFields @'["keys", "minSigs"] ms
let signers = pfromData $ pfield @"signatories" #$ pfromData (pfield @"txInfo" # sc)
validSigners = plength #$ pfilter # plam (\x -> pelem # x # multsig.keys) # signers
pure $ pcon $ PJust $ pfromData multsig.minSigs #<= validSigners
-- | Actual implementation of @pvalidatedByMultisig@. -- | Actual implementation of @pvalidatedByMultisig@.
actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool) actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool)
@ -108,7 +104,7 @@ actual = plam $ \x -> unTermCont $ do
-- | Proposed property. -- | Proposed property.
prop :: Property prop :: Property
prop = classifiedProperty genMultiSigProp shrinkMultiSigProp expected classifyMultiSigProp actual prop = classifiedPropertyNative genMultiSigProp shrinkMultiSigProp expectedHs classifyMultiSigProp actual
props :: [TestTree] props :: [TestTree]
props = props =

13
flake.lock generated
View file

@ -6877,11 +6877,11 @@
}, },
"nixpkgs-2111_3": { "nixpkgs-2111_3": {
"locked": { "locked": {
"lastModified": 1653830209, "lastModified": 1653996475,
"narHash": "sha256-V+HnLKJzvk2HZcLUKt9z2puZ46vLo74chOakxbLfXek=", "narHash": "sha256-r/UA7h3Dfgf4dlOCkakpqejf1Tagfb+6T+9OdT0qBgU=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "cc257c49c495b2d0d7d40c5753a452d0abc8adf3", "rev": "ec6eaba9dfcfdd11547d75a193e91e26701bf7e3",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -8377,15 +8377,16 @@
"plutarch": "plutarch_5" "plutarch": "plutarch_5"
}, },
"locked": { "locked": {
"lastModified": 1653434038, "lastModified": 1654103825,
"narHash": "sha256-0eAtAVkD3MKkLCmHbI1NncaEK73UmweWtrYKOuwMLWY=", "narHash": "sha256-i9M7qIp4mnt4Oce3R9zdLHQQaww8lQCpjtz2YkfcyBY=",
"owner": "liqwid-labs", "owner": "liqwid-labs",
"repo": "plutarch-quickcheck", "repo": "plutarch-quickcheck",
"rev": "853a1135a401660c87771e698334d5b15b77e031", "rev": "60bd32efe3be8830de3d1ac796b436eaed01826f",
"type": "github" "type": "github"
}, },
"original": { "original": {
"owner": "liqwid-labs", "owner": "liqwid-labs",
"ref": "staging",
"repo": "plutarch-quickcheck", "repo": "plutarch-quickcheck",
"type": "github" "type": "github"
} }

View file

@ -24,7 +24,7 @@
# Testing # Testing
inputs.plutarch-quickcheck.url = inputs.plutarch-quickcheck.url =
"github:liqwid-labs/plutarch-quickcheck"; "github:liqwid-labs/plutarch-quickcheck?ref=staging";
inputs.plutarch-context-builder.url = inputs.plutarch-context-builder.url =
"git+ssh://git@github.com/Liqwid-Labs/plutarch-context-builder?ref=main"; "git+ssh://git@github.com/Liqwid-Labs/plutarch-context-builder?ref=main";