paired programming work

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

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 =

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