diff --git a/.gitignore b/.gitignore index 5ae1889..a2329d2 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,7 @@ TAGS # direnv files .envrc .direnv/ + +# Haddock files and Hoogle databases +haddock +hoo diff --git a/Makefile b/Makefile index 35cd401..38026f3 100644 --- a/Makefile +++ b/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: + 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 diff --git a/agora.cabal b/agora.cabal index c26f23b..ab38454 100644 --- a/agora.cabal +++ b/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: + , agora , plutarch-benchmark - , agora \ No newline at end of file diff --git a/docs/tech-design/treasury.md b/docs/tech-design/treasury.md index be532dd..395f128 100644 --- a/docs/tech-design/treasury.md +++ b/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 diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs new file mode 100644 index 0000000..02ca842 --- /dev/null +++ b/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