From f417f32f4e9c88ba4ce3214096e05e9d432601db Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 18 Mar 2022 12:19:45 +0000 Subject: [PATCH] paired programming work --- agora-test/Model/MultiSig.hs | 59 ++++++++++++++++++++++++++++++++++++ agora-test/Spec/Int.hs | 11 ++++++- agora.cabal | 9 ++---- 3 files changed, 72 insertions(+), 7 deletions(-) create mode 100644 agora-test/Model/MultiSig.hs diff --git a/agora-test/Model/MultiSig.hs b/agora-test/Model/MultiSig.hs new file mode 100644 index 0000000..bafb9b4 --- /dev/null +++ b/agora-test/Model/MultiSig.hs @@ -0,0 +1,59 @@ +module Model.MultiSig () where + +import Agora.MultiSig (MultiSig (..)) +import Apropos (Apropos (Apropos), Formula (ExactlyOne), (:+)) +import Apropos.Script (HasScriptRunner (expect, script)) +import Plutus.V1.Ledger.Api (PubKeyHash, Script) + +{- + +1. Create proposition sum type. +2. Create logical model defining relationships between propositions. +3. Associating propositions with the "concrete" type i.e. MultiSig. +4. Create Generators. +5. Run tests (with magic). + +-} + +{- + +1. Create a + +Define a prop, as if it is the way a script can pass. + 1. keys signed exceeds `minSigs` + 2. `minSigs` is lte zero. + +Props not passing: + 1. No signatures present. + 2. Signatures present is less than `minSigs`. + +-} + +data MultiSigModel = MultiSigModel + { ms :: MultiSig + , ctx :: ScriptContext + } + +data MultiSigProp + = MeetsMinSigs + | DoesNotMeetMinSigs + +instance LogicalModel MultiSigModel where + logic = ExactlyOne [Var MeetsMinSigs, Var DoesNotMeetMinSigs] + +instance HasLogicalModel MultiSigProp MultiSigModel where + satisfiesProperty :: MultiSigProp -> MultiSigModel -> Bool + satisfiesProperty p m = + let minSigs = m.ms.minSigs + signatories = m.ctx.txInfo.txInfoSignatories + matchingSigs = intersect m.ms.keys signatories + in case p of + MeetsMinSigs -> length matchingSigs >= minSigs + DoesNotMeetMinSigs -> length matchingSigs < minSigs + +instance HasScriptRunner MultiSigProp MultiSig where + expect :: (MultiSigModel :+ MultiSigProp) -> Formula MultiSigProp + expect = undefined + + script :: (MultiSigModel :+ MultiSigProp) -> MultiSig -> Script + script Apropos msm = compile $ validatedByMultisig msm . ms diff --git a/agora-test/Spec/Int.hs b/agora-test/Spec/Int.hs index 8063784..f89abdc 100644 --- a/agora-test/Spec/Int.hs +++ b/agora-test/Spec/Int.hs @@ -78,7 +78,16 @@ instance HasScriptRunner IntProp Int where expect _ = Var IsSmall :&&: Var IsNegative script _ i = let ii = fromIntegral i :: Integer - in compile (pif ((fromInteger ii #< (0 :: Term s PInteger)) #&& ((fromInteger (-10) :: Term s PInteger) #<= fromInteger ii)) (pcon PUnit) perror) + in compile + ( pif + ( ( fromInteger ii + #< (0 :: Term s PInteger) + ) + #&& ((fromInteger (-10) :: Term s PInteger) #<= fromInteger ii) + ) + (pcon PUnit) + perror + ) intPlutarchTests :: TestTree intPlutarchTests = diff --git a/agora.cabal b/agora.cabal index 8d17d47..6ffd3b3 100644 --- a/agora.cabal +++ b/agora.cabal @@ -107,12 +107,12 @@ common deps common test-deps build-depends: + , apropos-tx , QuickCheck , quickcheck-instances , tasty , tasty-hedgehog , tasty-hunit - , apropos-tx library import: lang, deps @@ -151,16 +151,13 @@ test-suite agora-test Spec.Int Spec.Sample.Stake Spec.Stake - Spec.Util - build-depends: - , agora + build-depends: agora benchmark agora-bench import: lang, deps hs-source-dirs: agora-bench main-is: Main.hs type: exitcode-stdio-1.0 - build-depends: - , agora + build-depends: agora