From 3ad50b218bca6055444a26886b7a314a783ad643 Mon Sep 17 00:00:00 2001 From: Seungheon Oh Date: Wed, 1 Jun 2022 12:28:21 -0500 Subject: [PATCH] Use native `expected` function --- agora-specs/Property/MultiSig.hs | 16 ++++++---------- flake.lock | 13 +++++++------ flake.nix | 2 +- 3 files changed, 14 insertions(+), 17 deletions(-) diff --git a/agora-specs/Property/MultiSig.hs b/agora-specs/Property/MultiSig.hs index 070b9e3..7868c40 100644 --- a/agora-specs/Property/MultiSig.hs +++ b/agora-specs/Property/MultiSig.hs @@ -30,7 +30,7 @@ import Plutus.V1.Ledger.Api ( ) import Property.Generator (genPubKeyHash, genSingletonValue) import Test.Tasty (TestTree) -import Test.Tasty.Plutarch.Property (classifiedProperty) +import Test.Tasty.Plutarch.Property (classifiedPropertyNative) import Test.Tasty.QuickCheck ( Gen, Property, @@ -90,14 +90,10 @@ 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 - sc <- tclet $ psndBuiltin # x - 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 +expectedHs :: MultiSigModel -> Maybe Bool +expectedHs model = case classifyMultiSigProp model of + MeetsMinSigs -> Just True + _ -> Just False -- | Actual implementation of @pvalidatedByMultisig@. actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool) @@ -108,7 +104,7 @@ actual = plam $ \x -> unTermCont $ do -- | Proposed property. prop :: Property -prop = classifiedProperty genMultiSigProp shrinkMultiSigProp expected classifyMultiSigProp actual +prop = classifiedPropertyNative genMultiSigProp shrinkMultiSigProp expectedHs classifyMultiSigProp actual props :: [TestTree] props = diff --git a/flake.lock b/flake.lock index 27b2d9f..78e0841 100644 --- a/flake.lock +++ b/flake.lock @@ -6877,11 +6877,11 @@ }, "nixpkgs-2111_3": { "locked": { - "lastModified": 1653830209, - "narHash": "sha256-V+HnLKJzvk2HZcLUKt9z2puZ46vLo74chOakxbLfXek=", + "lastModified": 1653996475, + "narHash": "sha256-r/UA7h3Dfgf4dlOCkakpqejf1Tagfb+6T+9OdT0qBgU=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "cc257c49c495b2d0d7d40c5753a452d0abc8adf3", + "rev": "ec6eaba9dfcfdd11547d75a193e91e26701bf7e3", "type": "github" }, "original": { @@ -8377,15 +8377,16 @@ "plutarch": "plutarch_5" }, "locked": { - "lastModified": 1653434038, - "narHash": "sha256-0eAtAVkD3MKkLCmHbI1NncaEK73UmweWtrYKOuwMLWY=", + "lastModified": 1654103825, + "narHash": "sha256-i9M7qIp4mnt4Oce3R9zdLHQQaww8lQCpjtz2YkfcyBY=", "owner": "liqwid-labs", "repo": "plutarch-quickcheck", - "rev": "853a1135a401660c87771e698334d5b15b77e031", + "rev": "60bd32efe3be8830de3d1ac796b436eaed01826f", "type": "github" }, "original": { "owner": "liqwid-labs", + "ref": "staging", "repo": "plutarch-quickcheck", "type": "github" } diff --git a/flake.nix b/flake.nix index 41d723c..23640dd 100644 --- a/flake.nix +++ b/flake.nix @@ -24,7 +24,7 @@ # Testing inputs.plutarch-quickcheck.url = - "github:liqwid-labs/plutarch-quickcheck"; + "github:liqwid-labs/plutarch-quickcheck?ref=staging"; inputs.plutarch-context-builder.url = "git+ssh://git@github.com/Liqwid-Labs/plutarch-context-builder?ref=main";