Initialised skeleton for treasury

.gitignore

@@ -21,3 +21,7 @@ TAGS
 # direnv files
 .envrc
 .direnv/
+
+# Haddock files and Hoogle databases 
+haddock 
+hoo

Makefile

@@ -8,13 +8,18 @@ usage:
 	@echo "Available commands:"
 	@echo "  hoogle -- Start local hoogle"
 	@echo "  format -- Format the project"
+	@echo "  haddock -- Generate Haddock docs for project"
 
-HOOGLE_PORT=8081
 hoogle: 
-	hoogle server --local --port $(HOOGLE_PORT) > /dev/null &
+	hoogle generate --local=haddock --database=hoo/local.hoo
+	hoogle server --local -p 8081 >> /dev/null &
+	hoogle server --local --database=hoo/local.hoo -p 8082 >> /dev/null &
 
 FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -XOverloadedRecordDot
 format:
 	find -name '*.hs' -not -path './dist-*/*' | xargs fourmolu $(FORMAT_EXTENSIONS) -m inplace
 	git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.nix' | xargs nixfmt
 	git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.cabal' | xargs cabal-fmt -i
+
+haddock:
+	cabal haddock --haddock-html --haddock-hoogle --builddir=haddock

agora.cabal

@@ -23,6 +23,7 @@ common lang
     pprelude (PPrelude as Prelude)
 
   default-extensions:
+    UndecidableInstances
     NoStarIsType
     BangPatterns
     BinaryLiterals
@@ -92,6 +93,7 @@ common deps
     , containers
     , data-default
     , data-default-class
+    , generics-sop
     , plutarch
     , plutus-core
     , plutus-ledger-api
@@ -112,7 +114,10 @@ common test-deps
 
 library
   import:          lang, deps
-  exposed-modules: Agora.AuthorityToken
+  exposed-modules:
+    Agora.AuthorityToken
+    Agora.Treasury
+
   other-modules:
   hs-source-dirs:  src
 
@@ -137,5 +142,5 @@ benchmark agora-bench
   main-is:        Main.hs
   type:           exitcode-stdio-1.0
   build-depends:
-    , plutarch-benchmark
     , agora
+    , plutarch-benchmark

docs/tech-design/treasury.md

@@ -2,7 +2,7 @@
 
 | Specification | Implementation    | Last revision |
 |:-----------:|:--------------:|:-------------:|
-| WIP         |  WIP           | v0.1 2022-02-07 |
+| Draft         |  WIP           | v0.1 2022-03-01 |
 
 ---
 
@@ -20,7 +20,8 @@
 
 **Current Status**:
 
-Initial conceptual draft. Requires review from [Emily Martins].
+- Conceptual draft agreed upon. 
+- Requires technical details and review from [Emily Martins].
 
 ---
 
@@ -46,3 +47,20 @@ The treasury will further be the initial holder of all a governance system's GT.
 3.  How much do they receive in their reward?
 
 are all, naturally, protocol-specific. A simple method for creating such a bespoke reward structure is **not** considered in-scope for Agora v1. Agora v1 will offer a simple, prescribed reward structure, that allows the treasury to determine the reward eligibility of a user and allow them to redeem said amount.
+
+## Script 
+
+The script for an Agora treasury is described in this section.
+
+### Datum 
+
+```hs 
+data TreasuryD = TreasuryD
+  { reserves :: Value
+  , stateThread :: CurrencySymbol
+  }
+```
+
+### Redeemers 
+
+### Validators

src/Agora/Treasury.hs

@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
+{- |
+Module: Agora.Treasury
+Maintainer: jack@mlabs.city
+Description: Treasury scripts.
+
+Contains the datum, redeemer and validator for a template DAO
+treasury.
+-}
+module Agora.Treasury where
+
+import GHC.Generics qualified as GHC
+import Generics.SOP
+import Plutarch.Api.V1.Contexts (PScriptContext)
+import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
+import Plutarch.DataRepr (
+  PDataFields,
+  PIsDataReprInstances (PIsDataReprInstances),
+ )
+import Plutarch.Monadic qualified as P
+
+{- | Validator ensuring that transactions consuming the treasury
+     do so in a valid manner.
+-}
+treasuryV ::
+  Term
+    s
+    ( PAsData PTreasuryDatum
+        :--> PAsData PTreasuryRedeemer
+        :--> PAsData PScriptContext
+        :--> PUnit
+    )
+treasuryV = plam $ \_d r ctx' -> P.do
+  ctx <- pletFields @["txInfo", "purpose"] ctx'
+  pmatch (pfromData r) $ \case
+    -- Validation for receiving funds.
+    PReceiveFunds _ -> pconstant ()
+    -- Validation for witnessing transaction.
+    PWitnessTreasury _ -> pconstant ()
+
+{- | Plutarch level type representing datum of the treasury.
+     Contains:
+
+       - @reserves@ representing the current value kept in the
+         treasury.
+       - @stateThread@ representing the asset class of the
+         treasury's state thread token.
+-}
+newtype PTreasuryDatum (s :: S)
+  = PTreasuryDatum
+      ( Term
+          s
+          ( PDataRecord
+              '[ "reserves" ':= PValue
+               , "stateThread" ':= PCurrencySymbol
+               ]
+          )
+      )
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData, PDataFields)
+    via PIsDataReprInstances PTreasuryDatum
+
+{- | Plutarch level type representing valid redeemers of the
+     treasury.
+-}
+data PTreasuryRedeemer (s :: S)
+  = -- | Receive funds and place them in the treasury.
+    PReceiveFunds (Term s (PDataRecord '["_0" ':= PValue]))
+  | -- | Serve as a witness for any transaction. Must remain unaltered.
+    PWitnessTreasury (Term s (PDataRecord '[]))
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData)
+    via PIsDataReprInstances PTreasuryRedeemer