From 2a940eb47783747becbde719a7a826791ae524c6 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Thu, 24 Mar 2022 15:59:51 +0000
Subject: [PATCH] Began carving out apropos treasury tests

---
 agora-test/Spec/Model/Treasury.hs | 97 +++++++++++++++++++++++++++++++
 agora.cabal                       |  1 +
 hie.yaml                          |  2 +-
 3 files changed, 99 insertions(+), 1 deletion(-)
 create mode 100644 agora-test/Spec/Model/Treasury.hs

diff --git a/agora-test/Spec/Model/Treasury.hs b/agora-test/Spec/Model/Treasury.hs
new file mode 100644
index 0000000..c9f0956
--- /dev/null
+++ b/agora-test/Spec/Model/Treasury.hs
@@ -0,0 +1,97 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
+module Spec.Model.Treasury (
+  ) where
+
+import Apropos (
+  Apropos (Apropos),
+  Enumerable (enumerated),
+  Formula (
+    ExactlyOne,
+    Not,
+    Var,
+    Yes,
+    (:&&:),
+    (:->:)
+  ),
+  Gen,
+  HasLogicalModel (satisfiesProperty),
+  HasParameterisedGenerator (parameterisedGenerator),
+  LogicalModel (logic),
+  runGeneratorTestsWhere,
+  (:+),
+ )
+import Apropos.Script (HasScriptRunner (expect, runScriptTestsWhere, script))
+import Data.Set (Set)
+import Plutus.V1.Ledger.Api (CurrencySymbol, ScriptContext)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Hedgehog (fromGroup)
+
+{-
+
+A Treasury transaction should pass if:
+
+1. A GAT is burned.
+2. All GATs are valid.
+
+If either of these things do _not_ hold, then the transaction
+should fail.
+
+-}
+
+data TreasuryTxProp
+  = GATIsBurned
+  | GATIsNotBurned
+  | AllGATsValid
+  | SomeGATsInvalid
+  deriving stock (Show, Eq, Ord, Enum, Bounded)
+
+data TreasuryTxModel = TreasuryTxModel
+  { gatCs :: CurrencySymbol
+  , ctx :: ScriptContext
+  }
+
+instance Enumerable TreasuryTxProp where
+  enumerated :: [TreasuryTxProp]
+  enumerated = [minBound .. maxBound]
+
+instance LogicalModel TreasuryTxProp where
+  logic :: Formula TreasuryTxProp
+  logic =
+    ExactlyOne [Var GATIsBurned, Var GATIsNotBurned]
+      :&&: Var SomeGATsInvalid :->: Not (Var AllGATsValid)
+
+instance HasLogicalModel TreasuryTxProp TreasuryTxModel where
+  satisfiesProperty :: TreasuryTxProp -> TreasuryTxModel -> Bool
+  satisfiesProperty GATIsBurned trModel = undefined
+  satisfiesProperty GATIsNotBurned trModel = undefined
+  satisfiesProperty AllGATsValid trModel = undefined
+  satisfiesProperty SomeGATsInvalid trModel = undefined
+
+-- instance HasParameterisedGenerator TreasuryTxProp Int where
+--   parameterisedGenerator :: Set TreasuryTxProp -> Gen Int
+--   parameterisedGenerator = undefined
+
+-- instance HasScriptRunner TreasuryTxProp Int where
+--   expect = undefined
+--   script = undefined
+
+-- genTests :: TestTree
+-- genTests =
+--   testGroup "genTests" $
+--     fromGroup
+--       <$> [ runGeneratorTestsWhere
+--               (Apropos :: Int :+ TreasuryTxProp)
+--               "Generator"
+--               Yes
+--           ]
+
+-- plutarchTests :: TestTree
+-- plutarchTests =
+--   testGroup "plutarchTests" $
+--     fromGroup
+--       <$> [ runScriptTestsWhere
+--               (Apropos :: Int :+ TreasuryTxProp)
+--               "ScriptValid"
+--               Yes
+--           ]
diff --git a/agora.cabal b/agora.cabal
index 403e259..7c1f98d 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -148,6 +148,7 @@ test-suite agora-test
   main-is:        Spec.hs
   hs-source-dirs: agora-test
   other-modules:
+    Spec.Model.Treasury
     Spec.Model.MultiSig
     Spec.Sample.Stake
     Spec.Sample.Treasury
diff --git a/hie.yaml b/hie.yaml
index e1be10a..6020af6 100644
--- a/hie.yaml
+++ b/hie.yaml
@@ -1,6 +1,6 @@
 cradle:
   cabal:
-    - path: "./agora-src"
+    - path: "./agora"
       component: "lib:agora"
     - path: "./agora-bench"
       component: "benchmark:agora-bench"