From bbddc5e34bcf37b8f55563269ba9f5d417c6430f Mon Sep 17 00:00:00 2001 From: Peter Dragos Date: Thu, 24 Mar 2022 17:13:44 -0400 Subject: [PATCH 01/31] update flake --- agora/Agora/AuthorityToken.hs | 4 +- agora/Agora/Utils.hs | 4 +- flake.lock | 33 ++++++++-- flake.nix | 116 ++++++++++++++++------------------ 4 files changed, 84 insertions(+), 73 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 3a00148..4050348 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -15,14 +15,14 @@ import Plutarch.Api.V1 ( PAddress (..), PCredential (..), PCurrencySymbol (..), - PMap (..), PScriptContext (..), PScriptPurpose (..), PTxInInfo (..), PTxInfo (..), PTxOut (..), - PValue (..), ) +import Plutarch.Api.V1.AssocMap (PMap (PMap)) +import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (pforgetData) import Plutarch.List (pfoldr') import Plutarch.Monadic qualified as P diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 2afa33a..7cb9825 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -41,7 +41,6 @@ import Plutarch.Api.V1 ( PCurrencySymbol, PDatum, PDatumHash, - PMap (PMap), PMaybeData (PDJust), PPubKeyHash, PTokenName, @@ -50,8 +49,9 @@ import Plutarch.Api.V1 ( PTxInfo (PTxInfo), PTxOut (PTxOut), PTxOutRef, - PValue (PValue), ) +import Plutarch.Api.V1.AssocMap (PMap (PMap)) +import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (ppairDataBuiltin) import Plutarch.Internal (punsafeCoerce) import Plutarch.Monadic qualified as P diff --git a/flake.lock b/flake.lock index 713ed75..a5cacae 100644 --- a/flake.lock +++ b/flake.lock @@ -679,7 +679,7 @@ "nixpkgs": [ "apropos-tx", "haskell-nix", - "nixpkgs-2105" + "nixpkgs-unstable" ], "nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2105": "nixpkgs-2105", @@ -731,6 +731,8 @@ "hpc-coveralls": "hpc-coveralls_2", "nix-tools": "nix-tools_2", "nixpkgs": [ + "plutarch", + "haskell-nix", "nixpkgs-2111" ], "nixpkgs-2003": "nixpkgs-2003_2", @@ -1123,6 +1125,22 @@ "type": "github" } }, + "nixpkgs-2111_4": { + "locked": { + "lastModified": 1647902355, + "narHash": "sha256-SySJ8IRaogpc/BPOkysA+kzq9URvXthoeKIemaTKCiM=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "31aa631dbc496500efd2507baaed39626f6650f2", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-nixops": { "locked": { "lastModified": 1630248577, @@ -1274,6 +1292,7 @@ "haskell-nix", "nixpkgs-unstable" ], + "nixpkgs-2111": "nixpkgs-2111_4", "plutus": "plutus_2", "protolude": "protolude", "safe-coloured-text": "safe-coloured-text", @@ -1283,17 +1302,17 @@ "validity": "validity" }, "locked": { - "lastModified": 1646941827, - "narHash": "sha256-/TmkSDVOYD0Nsf6/tsyCSWhFUIeefwPn0Lz1oeZ7lyQ=", - "owner": "Plutonomicon", + "lastModified": 1648145467, + "narHash": "sha256-yrq0CJbZPrDmrEeI/RqNmKGHoHasMsnknug7kPLUsRU=", + "owner": "peter-mlabs", "repo": "plutarch", - "rev": "cb29ca64df4ed193d94a062e3fe26aa37e59b7bc", + "rev": "2ddf1d1b6efc43598ca3502471f6ace596f920ec", "type": "github" }, "original": { - "owner": "Plutonomicon", + "owner": "peter-mlabs", + "ref": "liqwid/extra", "repo": "plutarch", - "rev": "cb29ca64df4ed193d94a062e3fe26aa37e59b7bc", "type": "github" } }, diff --git a/flake.nix b/flake.nix index fdf0dd8..87be54c 100644 --- a/flake.nix +++ b/flake.nix @@ -3,6 +3,12 @@ inputs.nixpkgs.follows = "plutarch/nixpkgs"; inputs.haskell-nix.follows = "plutarch/haskell-nix"; + # temporary fix for nix versions that have the transitive follows bug + # see https://github.com/NixOS/nix/issues/6013 + inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; + + inputs.plutarch.url = "github:peter-mlabs/plutarch/liqwid/extra"; + inputs.plutarch.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; # https://github.com/mlabs-haskell/apropos-tx/pull/28 inputs.apropos-tx.url = @@ -10,48 +16,33 @@ inputs.apropos-tx.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; - # temporary fix for nix versions that have the transitive follows bug - # see https://github.com/NixOS/nix/issues/6013 - inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; - - inputs.plutarch.url = - "github:Plutonomicon/plutarch?rev=cb29ca64df4ed193d94a062e3fe26aa37e59b7bc"; - inputs.plutarch.inputs.nixpkgs.follows = - "plutarch/haskell-nix/nixpkgs-unstable"; - outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }: let - supportedSystems = with nixpkgs.lib.systems.supported; - tier1 ++ tier2 ++ tier3; + supportedSystems = with nixpkgs.lib.systems.supported; tier1 ++ tier2 ++ tier3; perSystem = nixpkgs.lib.genAttrs supportedSystems; - nixpkgsFor = system: - import nixpkgs { - inherit system; - overlays = [ haskell-nix.overlay ]; - inherit (haskell-nix) config; - }; - - nixpkgsFor' = system: - import nixpkgs { - inherit system; - inherit (haskell-nix) config; - }; + nixpkgsFor = system: import nixpkgs { inherit system; overlays = [ haskell-nix.overlay ]; inherit (haskell-nix) config; }; + nixpkgsFor' = system: import nixpkgs { inherit system; inherit (haskell-nix) config; }; ghcVersion = "ghc921"; projectFor = system: - let pkgs = nixpkgsFor system; - in let pkgs' = nixpkgsFor' system; - in (nixpkgsFor system).haskell-nix.cabalProject' { + let pkgs = nixpkgsFor system; in + let pkgs' = nixpkgsFor' system; in + (nixpkgsFor system).haskell-nix.cabalProject' { src = ./.; compiler-nix-name = ghcVersion; inherit (plutarch) cabalProjectLocal; extraSources = plutarch.extraSources ++ [ { src = inputs.plutarch; - subdirs = [ "." "plutarch-test" "plutarch-extra" ]; + subdirs = [ + "." + "plutarch-test" + "plutarch-extra" + "plutarch-numeric" + ]; } { src = inputs.apropos-tx; @@ -66,24 +57,28 @@ # We use the ones from Nixpkgs, since they are cached reliably. # Eventually we will probably want to build these with haskell.nix. - nativeBuildInputs = [ - pkgs'.git - pkgs'.haskellPackages.apply-refact - pkgs'.fd - pkgs'.cabal-install - pkgs'.haskell.packages."${ghcVersion}".hlint - pkgs'.haskellPackages.cabal-fmt - pkgs'.nixpkgs-fmt - pkgs'.graphviz - ]; + nativeBuildInputs = with pkgs'; + [ + entr + haskellPackages.apply-refact + git + fd + cabal-install + hlint + haskellPackages.cabal-fmt + nixpkgs-fmt + graphviz + ]; inherit (plutarch) tools; additional = ps: [ ps.plutarch - ps.plutarch-test + ps.tasty-quickcheck ps.apropos-tx ps.plutarch-extra + ps.plutarch-numeric + ps.plutarch-test ]; }; }; @@ -92,45 +87,42 @@ let pkgs = nixpkgsFor system; pkgs' = nixpkgsFor' system; - inherit (pkgs.haskell-nix.tools ghcVersion { - inherit (plutarch.tools) fourmolu hlint; - }) - fourmolu hlint; - in pkgs.runCommand "format-check" { - nativeBuildInputs = [ - pkgs'.git - pkgs'.fd - pkgs'.haskellPackages.cabal-fmt - pkgs'.nixpkgs-fmt - fourmolu - hlint - ]; - } '' + in + pkgs.runCommand "format-check" + { + nativeBuildInputs = [ pkgs'.git pkgs'.fd pkgs'.haskellPackages.cabal-fmt pkgs'.nixpkgs-fmt (pkgs.haskell-nix.tools ghcVersion { inherit (plutarch.tools) fourmolu; }).fourmolu ]; + } '' export LC_CTYPE=C.UTF-8 export LC_ALL=C.UTF-8 export LANG=C.UTF-8 cd ${self} make format_check mkdir $out - ''; - in { + '' + ; + in + { project = perSystem projectFor; flake = perSystem (system: (projectFor system).flake { }); packages = perSystem (system: self.flake.${system}.packages); checks = perSystem (system: - self.flake.${system}.checks // { + self.flake.${system}.checks + // { formatCheck = formatCheckFor system; - }); + } + ); check = perSystem (system: - (nixpkgsFor system).runCommand "combined-test" { - checksss = builtins.attrValues self.checks.${system}; - } '' + (nixpkgsFor system).runCommand "combined-test" + { + checksss = builtins.attrValues self.checks.${system}; + } '' echo $checksss touch $out - ''); + '' + ); devShell = perSystem (system: self.flake.${system}.devShell); - defaultPackage = - perSystem (system: self.flake.${system}.packages."agora:lib:agora"); }; } + + From a9e8f43ca5e004b8455144c2055474a51e71c31b Mon Sep 17 00:00:00 2001 From: Peter Dragos Date: Thu, 24 Mar 2022 19:15:10 -0400 Subject: [PATCH 02/31] upstream Agora `extra`s --- agora.cabal | 3 +- agora/Plutarch/Api/V1/These.hs | 62 ---------------------------------- agora/Plutarch/These.hs | 12 ------- flake.lock | 24 ++++++------- 4 files changed, 13 insertions(+), 88 deletions(-) delete mode 100644 agora/Plutarch/Api/V1/These.hs delete mode 100644 agora/Plutarch/These.hs diff --git a/agora.cabal b/agora.cabal index 8d17d47..65039ad 100644 --- a/agora.cabal +++ b/agora.cabal @@ -95,6 +95,7 @@ common deps , data-default-class , generics-sop , plutarch + , plutarch-extra , plutus-core , plutus-ledger-api , plutus-tx @@ -128,8 +129,6 @@ library other-modules: Agora.Utils Agora.Utils.Value - Plutarch.Api.V1.These - Plutarch.These hs-source-dirs: agora diff --git a/agora/Plutarch/Api/V1/These.hs b/agora/Plutarch/Api/V1/These.hs deleted file mode 100644 index e1ae1ed..0000000 --- a/agora/Plutarch/Api/V1/These.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# OPTIONS_GHC -Wno-orphans #-} - -module Plutarch.Api.V1.These (PTheseData (..)) where - -import GHC.Generics qualified as GHC -import Generics.SOP -import Plutarch.DataRepr (PIsDataReprInstances (PIsDataReprInstances)) -import Plutarch.Lift ( - PConstantRepr, - PConstanted, - PLifted, - PUnsafeLiftDecl, - pconstantFromRepr, - pconstantToRepr, - ) -import Plutus.V1.Ledger.Api qualified as Plutus -import PlutusTx.These qualified as PlutusThese - -data PTheseData (a :: PType) (b :: PType) (s :: S) - = PDThis (Term s (PDataRecord '["_0" ':= a])) - | PDThat (Term s (PDataRecord '["_0" ':= b])) - | PDThese (Term s (PDataRecord '["_0" ':= a, "_1" ':= b])) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances (PTheseData a b) - -instance - ( Plutus.ToData (PLifted a) - , Plutus.ToData (PLifted b) - , Plutus.FromData (PLifted a) - , Plutus.FromData (PLifted b) - , PLift a - , PLift b - ) => - PUnsafeLiftDecl (PTheseData a b) - where - type PLifted (PTheseData a b) = PlutusThese.These (PLifted a) (PLifted b) - -{- TODO: Make PTheseData an instance of PConstant: - https://github.com/Plutonomicon/plutarch/pull/355 --} - -instance - ( PLifted (PConstanted a) ~ a - , Plutus.ToData b - , Plutus.FromData b - , Plutus.ToData a - , Plutus.FromData a - , PConstant a - , PLifted (PConstanted b) ~ b - , Plutus.FromData b - , Plutus.ToData b - , PConstant b - ) => - PConstant (PlutusThese.These a b) - where - type PConstantRepr (PlutusThese.These a b) = [(Plutus.Data, Plutus.Data)] - type PConstanted (PlutusThese.These a b) = PTheseData (PConstanted a) (PConstanted b) - pconstantToRepr _t = undefined - pconstantFromRepr _t = undefined diff --git a/agora/Plutarch/These.hs b/agora/Plutarch/These.hs deleted file mode 100644 index f9b225a..0000000 --- a/agora/Plutarch/These.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Plutarch.These (PThese (..)) where - -import GHC.Generics qualified as GHC -import Generics.SOP - --- | Plutus These type with Scott-encoded representation. -data PThese (a :: PType) (b :: PType) (s :: S) - = PThis (Term s a) - | PThat (Term s b) - | PThese (Term s a) (Term s b) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PlutusType) diff --git a/flake.lock b/flake.lock index a5cacae..a8f99c4 100644 --- a/flake.lock +++ b/flake.lock @@ -885,11 +885,11 @@ "iohk-nix_2": { "flake": false, "locked": { - "lastModified": 1646330344, - "narHash": "sha256-EbhMDeneH26wDi+x5kz8nfru/dE9JZ241hJed4a8lz8=", + "lastModified": 1648032999, + "narHash": "sha256-3uCz+gJppvM7z6CUCkBbFSu60WgIE+e3oXwXiAiGWSY=", "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "0a0126d8fb1bdc61ce1fd2ef61cf396de800fdad", + "rev": "5e667b374153327c7bdfdbfab8ef19b1f27d4aac", "type": "github" }, "original": { @@ -1095,11 +1095,11 @@ }, "nixpkgs-2111_2": { "locked": { - "lastModified": 1646844010, - "narHash": "sha256-NRDLmpjmBMNBRr/BiztSsGht5wJYl8WZFzj+b+6LhLk=", + "lastModified": 1647902355, + "narHash": "sha256-SySJ8IRaogpc/BPOkysA+kzq9URvXthoeKIemaTKCiM=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "d59edd3833597be12763f1f017c7ad666cf1b810", + "rev": "31aa631dbc496500efd2507baaed39626f6650f2", "type": "github" }, "original": { @@ -1127,11 +1127,11 @@ }, "nixpkgs-2111_4": { "locked": { - "lastModified": 1647902355, - "narHash": "sha256-SySJ8IRaogpc/BPOkysA+kzq9URvXthoeKIemaTKCiM=", + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "31aa631dbc496500efd2507baaed39626f6650f2", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", "type": "github" }, "original": { @@ -1302,11 +1302,11 @@ "validity": "validity" }, "locked": { - "lastModified": 1648145467, - "narHash": "sha256-yrq0CJbZPrDmrEeI/RqNmKGHoHasMsnknug7kPLUsRU=", + "lastModified": 1648163186, + "narHash": "sha256-UfaSb4nk9HWzsj1Kb8RJuPV+iw1Nl4E2+97KOwIwcao=", "owner": "peter-mlabs", "repo": "plutarch", - "rev": "2ddf1d1b6efc43598ca3502471f6ace596f920ec", + "rev": "0638dbd706bc2c5f48f9f40be7bbe1986a778698", "type": "github" }, "original": { From 87ff8ba34388901ed77d05f559829953b87b738e Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Sat, 26 Mar 2022 10:37:32 +0100 Subject: [PATCH 03/31] stub out Proposal, Governor. kill hoogle before starting a new one. --- Makefile | 1 + agora.cabal | 3 +- agora/Agora/Governor.hs | 8 ++++++ agora/Agora/Proposal.hs | 62 +++++++++++++++++++++++++++++++++++++++++ agora/Agora/Voting.hs | 3 -- 5 files changed, 73 insertions(+), 4 deletions(-) create mode 100644 agora/Agora/Governor.hs create mode 100644 agora/Agora/Proposal.hs diff --git a/Makefile b/Makefile index a2a17e7..50df7e5 100644 --- a/Makefile +++ b/Makefile @@ -12,6 +12,7 @@ usage: @echo " haddock -- Generate Haddock docs for project" hoogle: + pkill 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 & diff --git a/agora.cabal b/agora.cabal index b50a55b..7fdf830 100644 --- a/agora.cabal +++ b/agora.cabal @@ -124,7 +124,8 @@ library Agora.SafeMoney.QQ Agora.Stake Agora.Treasury - Agora.Voting + Agora.Governor + Agora.Proposal other-modules: Agora.Utils diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs new file mode 100644 index 0000000..5dea361 --- /dev/null +++ b/agora/Agora/Governor.hs @@ -0,0 +1,8 @@ +{- | +Module : Agora.Governor +Maintainer : emi@haskell.fyi +Description: Governor entity scripts acting as authority of entire system. + +Governor entity scripts acting as authority of entire system. +-} +module Agora.Governor () where diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs new file mode 100644 index 0000000..f215d30 --- /dev/null +++ b/agora/Agora/Proposal.hs @@ -0,0 +1,62 @@ +{- | +Module : Agora.Proposal +Maintainer : emi@haskell.fyi +Description: Proposal scripts encoding effects that operate on the system. + +Proposal scripts encoding effects that operate on the system. +-} +module Agora.Proposal ( + ProposalDatum (..), + ProposalStatus (..), + ResultTag (..), +) where + +import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash) + +-------------------------------------------------------------------------------- + +{- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this: + + "No" ~ EffectTag 0 + "Yes" ~ EffectTag 1 +-} +newtype ResultTag = ResultTag {getResultTag :: Integer} + +{- | The 'status' of the proposal. This is only useful for __actual__ + state transitions, as opposed to time-based 'phases'. + + If the proposal is 'VotingReady', for instance, that doesn't necessarily + mean that voting is possible, as this also requires the timing to be right. +-} +data ProposalStatus + = -- | A draft proposal represents a proposal that has yet to be realized. + -- In effect, this means one which didn't have enough LQ to be a full + -- proposal, and needs cosigners to enable that to happen. This is + -- similar to a "temperature check", but only useful if multiple people + -- want to pool governance tokens together. If the proposal doesn't get to + -- 'VotingReady' on time, the proposal will **never** be able to get + -- voted on. + Draft + | -- | The proposal has/had enough GT cosigned in order to be a fully fledged + -- proposal. This means that once the timing requirements align, + -- proposal will be able to be voted on. + VotingReady + | -- | The proposal has finished for whatever reason. This can mean it's been + -- voted on and completed, but it can also mean the proposal failed due to + -- time constraints or didn't get to 'VotingReady' first. + -- + -- TODO: The owner of the proposal may choose to reclaim their proposal. + Finished + +data ProposalDatum = ProposalDatum + { -- TODO: could we encode this more efficiently? + -- This is shaped this way for future proofing. + -- See https://github.com/Liqwid-Labs/agora/issues/39 + effects :: [(ResultTag, [(ValidatorHash, DatumHash)])] + -- ^ Effect lookup table. First by result, then by + , status :: ProposalStatus + -- ^ The status the proposal is in. + , proposers :: [PubKeyHash] + -- ^ Who created the proposal initially. + -- We may want to remove this. + } diff --git a/agora/Agora/Voting.hs b/agora/Agora/Voting.hs index 5436960..066956c 100644 --- a/agora/Agora/Voting.hs +++ b/agora/Agora/Voting.hs @@ -6,6 +6,3 @@ Description: Types for votes and vote counting module Agora.Voting ( Vote (..), ) where - --- | Type representing direction of vote. -data Vote = InFavorOf | OpposedTo From 8a98ec9ec3e723fd0dc5986f6e3f9597e043d40a Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Sat, 26 Mar 2022 11:52:52 +0100 Subject: [PATCH 04/31] rework SafeMoney to use tags instead of MoneyClass --- Makefile | 2 +- agora-test/Spec/Sample/Stake.hs | 15 ++++- agora/Agora/SafeMoney.hs | 105 ++++++++++++++------------------ agora/Agora/SafeMoney/QQ.hs | 8 +-- agora/Agora/Stake.hs | 80 ++++++++---------------- 5 files changed, 89 insertions(+), 121 deletions(-) diff --git a/Makefile b/Makefile index 50df7e5..90ae380 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ usage: @echo " haddock -- Generate Haddock docs for project" hoogle: - pkill hoogle + pkill hoogle || true 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 & diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index 4bb0073..ccb4e52 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -47,7 +47,7 @@ import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Contexts (TxOut (TxOut), TxOutRef (TxOutRef)) import Plutus.V1.Ledger.Interval qualified as Interval import Plutus.V1.Ledger.Scripts (Validator) -import Plutus.V1.Ledger.Value (TokenName (TokenName)) +import Plutus.V1.Ledger.Value (AssetClass (AssetClass), TokenName (TokenName)) import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- @@ -59,8 +59,17 @@ import Spec.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- -- | 'Stake' parameters for 'LQ'. -stake :: Stake LQ -stake = Stake +stake :: Stake +stake = + Stake + { gtClassRef = + AssetClassRef + ( AssetClass + ( "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" + , "LQ" + ) + ) + } -- | 'Stake' policy instance. policy :: MintingPolicy diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index bec07c5..2809566 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -7,9 +7,14 @@ Phantom-type protected types for handling money in Plutus. -} module Agora.SafeMoney ( -- * Types - MoneyClass, PDiscrete, + -- * Tags and refs + AssetClassRef (..), + ADATag, + GTTag, + adaRef, + -- * Utility functions paddDiscrete, pgeqDiscrete, @@ -18,24 +23,14 @@ module Agora.SafeMoney ( -- * Conversions pdiscreteValue, pvalueDiscrete, - - -- * Example MoneyClasses - LQ, - ADA, ) where -import Data.Proxy (Proxy (Proxy)) -import Data.String -import GHC.TypeLits ( - KnownSymbol, - Nat, - Symbol, - symbolVal, - ) import Prelude -------------------------------------------------------------------------------- +import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) + import Plutarch.Api.V1 (PValue) import Plutarch.Builtin () import Plutarch.Internal () @@ -43,39 +38,46 @@ import Plutarch.Monadic qualified as P -------------------------------------------------------------------------------- -import Agora.Utils (passetClassValueOf, psingletonValue) +import Agora.Utils ( + passetClassValueOf', + psingletonValue, + ) + +-------------------------------------------------------------------------------- +-- Example tags + +-- | Governance token +data GTTag + +-- | ADA +data ADATag -------------------------------------------------------------------------------- --- | Type-level unique identifier for an 'Plutus.V1.Ledger.Value.AssetClass' -type MoneyClass = - ( -- AssetClass - Symbol - , -- TokenName - Symbol - , -- Decimal places - Nat - ) +-- | A tagged AssetClass. Use to resolve a reference inside of a PDiscrete +data AssetClassRef (tag :: Type) = AssetClassRef {getAssetClass :: AssetClass} --- | A 'PDiscrete' amount of currency tagged on the type level with the 'MoneyClass' it belongs to -newtype PDiscrete (mc :: MoneyClass) (s :: S) +adaRef :: AssetClassRef ADATag +adaRef = AssetClassRef (AssetClass ("", "")) + +newtype PDiscrete (tag :: Type) (s :: S) = PDiscrete (Term s PInteger) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (PDiscrete mc) PInteger) + deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (PDiscrete tag) PInteger) -- | Check if one 'PDiscrete' is greater than another. -pgeqDiscrete :: forall (mc :: MoneyClass) (s :: S). Term s (PDiscrete mc :--> PDiscrete mc :--> PBool) +pgeqDiscrete :: forall (tag :: Type) (s :: S). Term s (PDiscrete tag :--> PDiscrete tag :--> PBool) pgeqDiscrete = phoistAcyclic $ plam $ \x y -> P.do PDiscrete x' <- pmatch x PDiscrete y' <- pmatch y y' #<= x' --- | Returns a zero-value 'PDiscrete' unit for any 'MoneyClass'. -pzeroDiscrete :: forall (mc :: MoneyClass) (s :: S). Term s (PDiscrete mc) +-- | Returns a zero-value 'PDiscrete' unit for any tag. +pzeroDiscrete :: forall (tag :: Type) (s :: S). Term s (PDiscrete tag) pzeroDiscrete = phoistAcyclic $ pcon (PDiscrete 0) --- | Add two 'PDiscrete' values of the same 'MoneyClass'. -paddDiscrete :: Term s (PDiscrete mc :--> PDiscrete mc :--> PDiscrete mc) +-- | Add two 'PDiscrete' values of the same tag. +paddDiscrete :: forall (tag :: Type) (s :: S). Term s (PDiscrete tag :--> PDiscrete tag :--> PDiscrete tag) paddDiscrete = phoistAcyclic $ -- In the future, this should use plutarch-numeric plam $ \x y -> P.do @@ -83,46 +85,29 @@ paddDiscrete = phoistAcyclic $ PDiscrete y' <- pmatch y pcon (PDiscrete $ x' + y') --- | The MoneyClass of LQ. -type LQ :: MoneyClass -type LQ = '("da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24", "LQ", 6) - --- | The MoneyClass of ADA. -type ADA :: MoneyClass -type ADA = '("", "", 6) - -------------------------------------------------------------------------------- -- | Downcast a `PValue` to a `PDiscrete` unit. pvalueDiscrete :: - forall (moneyClass :: MoneyClass) (ac :: Symbol) (n :: Symbol) (scale :: Nat) s. - ( KnownSymbol ac - , KnownSymbol n - , moneyClass ~ '(ac, n, scale) - ) => - Term s (PValue :--> PDiscrete moneyClass) -pvalueDiscrete = phoistAcyclic $ + forall (tag :: Type) (s :: S). + AssetClassRef tag -> + Term s (PValue :--> PDiscrete tag) +pvalueDiscrete (AssetClassRef ac) = phoistAcyclic $ plam $ \f -> - pcon . PDiscrete $ - passetClassValueOf # pconstant (fromString $ symbolVal $ Proxy @ac) - # pconstant (fromString $ symbolVal $ Proxy @n) - # f + pcon . PDiscrete $ passetClassValueOf' ac # f {- | Get a `PValue` from a `PDiscrete`. __NOTE__: `pdiscreteValue` after `pvalueDiscrete` is not a round-trip. - It filters for a particular 'MoneyClass'. + It filters for a particular tag. -} pdiscreteValue :: - forall (moneyClass :: MoneyClass) (ac :: Symbol) (n :: Symbol) (scale :: Nat) s. - ( KnownSymbol ac - , KnownSymbol n - , moneyClass ~ '(ac, n, scale) - ) => - Term s (PDiscrete moneyClass :--> PValue) -pdiscreteValue = phoistAcyclic $ + forall (tag :: Type) (s :: S). + AssetClassRef tag -> + Term s (PDiscrete tag :--> PValue) +pdiscreteValue (AssetClassRef (AssetClass (cs, tn))) = phoistAcyclic $ plam $ \f -> pmatch f $ \case PDiscrete p -> psingletonValue - # pconstant (fromString $ symbolVal $ Proxy @ac) - # pconstant (fromString $ symbolVal $ Proxy @n) + # pconstant cs + # pconstant tn # p diff --git a/agora/Agora/SafeMoney/QQ.hs b/agora/Agora/SafeMoney/QQ.hs index 3fdf161..00d4b79 100644 --- a/agora/Agora/SafeMoney/QQ.hs +++ b/agora/Agora/SafeMoney/QQ.hs @@ -33,11 +33,11 @@ import Prelude import Plutarch.Internal (punsafeCoerce) -import Agora.SafeMoney (MoneyClass, PDiscrete) +import Agora.SafeMoney (PDiscrete) -------------------------------------------------------------------------------- -{- | Generate 'PDiscrete' values tagged by a particular MoneyClass +{- | Generate 'PDiscrete' values tagged by a particular tag @ [discrete| 123.456 'Agora.SafeMoney.ADA' |] :: 'Term' s ('PDiscrete' 'Agora.SafeMoney.ADA') @@ -46,7 +46,7 @@ import Agora.SafeMoney (MoneyClass, PDiscrete) discrete :: QuasiQuoter discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration -discreteConstant :: forall (moneyClass :: MoneyClass) s. Integer -> Term s (PDiscrete moneyClass) +discreteConstant :: forall tag s. Integer -> Term s (PDiscrete tag) discreteConstant n = punsafeCoerce (pconstant n :: Term s PInteger) fixedToInteger :: Integer -> (Integer, Integer) -> Integer @@ -68,7 +68,7 @@ discreteExp s = case parseDiscreteRatioExp s of Just (num, mc) -> do mcName <- lookupTypeName mc >>= \case - Nothing -> fail $ "MoneyClass with the name " <> show mc <> " is not in scope." + Nothing -> fail $ "Type with the name " <> show mc <> " is not in scope." Just v -> pure v reified <- reify mcName case reified of diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 3929449..ee5c52c 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -20,13 +20,7 @@ module Agora.Stake ( -------------------------------------------------------------------------------- -import Data.Proxy (Proxy (Proxy)) -import Data.String (IsString (fromString)) import GHC.Generics qualified as GHC -import GHC.TypeLits ( - KnownSymbol, - symbolVal, - ) import Generics.SOP (Generic, I (I)) import Prelude @@ -59,7 +53,8 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -------------------------------------------------------------------------------- import Agora.SafeMoney ( - MoneyClass, + AssetClassRef (..), + GTTag, PDiscrete, paddDiscrete, pdiscreteValue, @@ -84,12 +79,15 @@ import Agora.Utils ( -------------------------------------------------------------------------------- -- | Parameters for creating Stake scripts. -data Stake (gt :: MoneyClass) = Stake +data Stake = Stake + { gtClassRef :: AssetClassRef GTTag + -- ^ Resolve governance token + } -- | Plutarch-level redeemer for Stake scripts. -data PStakeRedeemer (gt :: MoneyClass) (s :: S) +data PStakeRedeemer (s :: S) = -- | Deposit or withdraw a discrete amount of the staked governance token. - PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete gt])) + PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag])) | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. PDestroy (Term s (PDataRecord '[])) deriving stock (GHC.Generic) @@ -97,13 +95,7 @@ data PStakeRedeemer (gt :: MoneyClass) (s :: S) deriving anyclass (PIsDataRepr) deriving (PlutusType, PIsData) - via PIsDataReprInstances (PStakeRedeemer gt) - --- FIXME: 'StakeRedeemer' and 'StakeDatum' are stripped of their --- typesafe `PDiscrete` equivalent due to issues with `makeIsDataIndexed` --- when using the kind @gt :: MoneyClass@. This ought to be fixed with --- a future patch in Plutarch upstream. For now, we will deal with lower --- type safety off-chain. + via PIsDataReprInstances PStakeRedeemer -- | Haskell-level redeemer for Stake scripts. data StakeRedeemer @@ -116,16 +108,16 @@ data StakeRedeemer PlutusTx.makeIsDataIndexed ''StakeRedeemer [('DepositWithdraw, 0), ('Destroy, 1)] -- | Plutarch-level datum for Stake scripts. -newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum +newtype PStakeDatum (s :: S) = PStakeDatum { getStakeDatum :: - Term s (PDataRecord '["stakedAmount" ':= PDiscrete gt, "owner" ':= PPubKeyHash]) + Term s (PDataRecord '["stakedAmount" ':= PDiscrete GTTag, "owner" ':= PPubKeyHash]) } deriving stock (GHC.Generic) deriving anyclass (Generic) deriving anyclass (PIsDataRepr) deriving (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances (PStakeDatum gt)) + via (PIsDataReprInstances PStakeDatum) -- | Haskell-level datum for Stake scripts. data StakeDatum = StakeDatum @@ -154,14 +146,10 @@ PlutusTx.makeIsDataIndexed ''StakeDatum [('StakeDatum, 0)] -- | Policy for Stake state threads. stakePolicy :: - forall (gt :: MoneyClass) ac n scale s. - ( KnownSymbol ac - , KnownSymbol n - , gt ~ '(ac, n, scale) - ) => - Stake gt -> + forall (s :: S). + Stake -> Term s PMintingPolicy -stakePolicy _stake = +stakePolicy stake = plam $ \_redeemer ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet ctx.txInfo @@ -180,7 +168,7 @@ stakePolicy _stake = mintedST #== -1 passert "An unlocked input existed containing an ST" $ - anyInput @(PStakeDatum gt) # pfromData txInfo' + anyInput @PStakeDatum # pfromData txInfo' #$ plam $ \value _ stakeDatum' -> P.do let hasST = psymbolValueOf # ownSymbol # value #== 1 @@ -197,7 +185,7 @@ stakePolicy _stake = mintedST #== 1 passert "A UTXO must exist with the correct output" $ - anyOutput @(PStakeDatum gt) # pfromData txInfo' + anyOutput @PStakeDatum # pfromData txInfo' #$ plam $ \value address stakeDatum' -> P.do let cred = pfield @"credential" # address @@ -220,7 +208,7 @@ stakePolicy _stake = # 1 let expectedValue = paddValue - # (pdiscreteValue # stakeDatum.stakedAmount) + # (pdiscreteValue stake.gtClassRef # stakeDatum.stakedAmount) # stValue let ownerSignsTransaction = ptxSignedBy @@ -234,12 +222,7 @@ stakePolicy _stake = foldr1 (#&&) [ pgeqByClass' (AssetClass ("", "")) # value # expectedValue - , pgeqByClass' - ( AssetClass - ( fromString . symbolVal $ Proxy @ac - , fromString . symbolVal $ Proxy @n - ) - ) + , pgeqByClass' stake.gtClassRef.getAssetClass # value # expectedValue , pgeqByClass @@ -259,12 +242,8 @@ stakePolicy _stake = -- | Validator intended for Stake UTXOs to live in. stakeValidator :: - forall (gt :: MoneyClass) ac n scale s. - ( KnownSymbol ac - , KnownSymbol n - , gt ~ '(ac, n, scale) - ) => - Stake gt -> + forall (s :: S). + Stake -> Term s PValidator stakeValidator stake = plam $ \datum redeemer ctx' -> P.do @@ -273,9 +252,9 @@ stakeValidator stake = txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' -- Coercion is safe in that if coercion fails we crash hard. - let stakeRedeemer :: Term _ (PStakeRedeemer gt) + let stakeRedeemer :: Term _ PStakeRedeemer stakeRedeemer = pfromData $ punsafeCoerce redeemer - stakeDatum' :: Term _ (PStakeDatum gt) + stakeDatum' :: Term _ PStakeDatum stakeDatum' = pfromData $ punsafeCoerce datum stakeDatum <- pletFields @'["owner", "stakedAmount"] stakeDatum' @@ -310,7 +289,7 @@ stakeValidator stake = "Owner signs this transaction" ownerSignsTransaction passert "A UTXO must exist with the correct output" $ - anyOutput @(PStakeDatum gt) # txInfo' + anyOutput @PStakeDatum # txInfo' #$ plam $ \value address newStakeDatum' -> P.do newStakeDatum <- pletFields @'["owner", "stakedAmount"] newStakeDatum' @@ -325,7 +304,7 @@ stakeValidator stake = -- do we need to check this, really? pgeqDiscrete # (pfromData newStakeDatum.stakedAmount) # pzeroDiscrete ] - let expectedValue = paddValue # continuingValue # (pdiscreteValue # delta) + let expectedValue = paddValue # continuingValue # (pdiscreteValue stake.gtClassRef # delta) -- TODO: Same as above. This is quite inefficient now, as it does two lookups -- instead of a more efficient single pass, @@ -334,12 +313,7 @@ stakeValidator stake = foldr1 (#&&) [ pgeqByClass' (AssetClass ("", "")) # value # expectedValue - , pgeqByClass' - ( AssetClass - ( fromString . symbolVal $ Proxy @ac - , fromString . symbolVal $ Proxy @n - ) - ) + , pgeqByClass' stake.gtClassRef.getAssetClass # value # expectedValue , pgeqBySymbol @@ -360,7 +334,7 @@ stakeValidator stake = -------------------------------------------------------------------------------- -- | Check whether a Stake is locked. If it is locked, various actions are unavailable. -stakeLocked :: forall (gt :: MoneyClass) s. Term s (PStakeDatum gt :--> PBool) +stakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool) stakeLocked = phoistAcyclic $ plam $ \_stakeDatum -> -- TODO: when we extend this to support proposals, this will need to do something From 48541836c7cfc64e7da20922bbc57c15e98599bb Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Sat, 26 Mar 2022 13:01:56 +0100 Subject: [PATCH 05/31] add ToData/FromData instances to `Discrete` --- agora/Agora/SafeMoney.hs | 25 ++++++++++++++++++++++++- agora/Agora/Stake.hs | 2 +- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index 2809566..4289c27 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -29,7 +29,9 @@ import Prelude -------------------------------------------------------------------------------- +import Plutus.V1.Ledger.Api (BuiltinData (..), Data (..)) import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) +import PlutusTx.IsData.Class (FromData (..), ToData (..)) import Plutarch.Api.V1 (PValue) import Plutarch.Builtin () @@ -55,11 +57,32 @@ data ADATag -------------------------------------------------------------------------------- -- | A tagged AssetClass. Use to resolve a reference inside of a PDiscrete -data AssetClassRef (tag :: Type) = AssetClassRef {getAssetClass :: AssetClass} +newtype AssetClassRef (tag :: Type) = AssetClassRef {getAssetClass :: AssetClass} +-- | Resolves ada tags. adaRef :: AssetClassRef ADATag adaRef = AssetClassRef (AssetClass ("", "")) +{- | Represents a single asset in a 'Value' related to a particular 'AssetClass' + through 'AssetClassRef'. +-} +newtype Discrete (tag :: Type) + = Discrete Integer + deriving stock (Show, Eq) + +{- We have to manually write these instances because the `tag` will confuse + `makeIsDataIndexed`. +-} +instance forall tag. FromData (Discrete tag) where + fromBuiltinData (BuiltinData (I x)) = Just (Discrete x) + fromBuiltinData _ = Nothing + +instance forall tag. ToData (Discrete tag) where + toBuiltinData (Discrete x) = BuiltinData (I x) + +{- | Represents a single asset in a 'PValue' related to a particular 'AssetClass' + through 'AssetClassRef'. +-} newtype PDiscrete (tag :: Type) (s :: S) = PDiscrete (Term s PInteger) deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (PDiscrete tag) PInteger) diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index ee5c52c..9096427 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -79,7 +79,7 @@ import Agora.Utils ( -------------------------------------------------------------------------------- -- | Parameters for creating Stake scripts. -data Stake = Stake +newtype Stake = Stake { gtClassRef :: AssetClassRef GTTag -- ^ Resolve governance token } From 15d25f314ba9c71517337844878acd1f9f1f3b93 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Sat, 26 Mar 2022 15:08:11 +0100 Subject: [PATCH 06/31] migrate Haskell-level datums to use Discrete --- agora-test/Spec/Sample/Stake.hs | 15 ++---- agora-test/Spec/Stake.hs | 6 ++- agora.cabal | 1 - agora/Agora/Proposal.hs | 5 +- agora/Agora/SafeMoney.hs | 43 +++++++++------ agora/Agora/SafeMoney/QQ.hs | 96 --------------------------------- agora/Agora/Stake.hs | 10 ++-- agora/Agora/Voting.hs | 8 --- 8 files changed, 44 insertions(+), 140 deletions(-) delete mode 100644 agora/Agora/SafeMoney/QQ.hs delete mode 100644 agora/Agora/Voting.hs diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index ccb4e52..85b95ac 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -21,7 +21,6 @@ module Spec.Sample.Stake ( ) where -------------------------------------------------------------------------------- - import Plutarch.Api.V1 ( mintingPolicySymbol, mkMintingPolicy, @@ -144,9 +143,9 @@ stakeCreationUnsigned = -- | Config for creating a ScriptContext that deposits or withdraws. data DepositWithdrawExample = DepositWithdrawExample - { startAmount :: Integer + { startAmount :: Discrete GTTag -- ^ The amount of GT stored before the transaction. - , delta :: Integer + , delta :: Discrete GTTag -- ^ The amount of GT deposited or withdrawn from the Stake. } @@ -169,10 +168,7 @@ stakeDepositWithdraw config = { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing , txOutValue = st - <> Value.singleton - "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" - "LQ" - stakeBefore.stakedAmount + <> discreteValue stake.gtClassRef stakeBefore.stakedAmount , txOutDatumHash = Just (toDatumHash stakeAfter) } ] @@ -181,10 +177,7 @@ stakeDepositWithdraw config = { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing , txOutValue = st - <> Value.singleton - "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" - "LQ" - stakeAfter.stakedAmount + <> discreteValue stake.gtClassRef stakeAfter.stakedAmount , txOutDatumHash = Just (toDatumHash stakeAfter) } ] diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index 8064ddf..5ce5d79 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE QuasiQuotes #-} + {- | Module : Spec.Stake Maintainer : emi@haskell.fyi @@ -57,13 +59,13 @@ tests = "stakeDepositWithdraw withdraw" (stakeValidator Stake.stake) (toDatum $ StakeDatum 100_000 signer) - (toDatum $ DepositWithdraw (negate 100_000)) + (toDatum $ DepositWithdraw $ negate 100_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000}) , validatorFailsWith "stakeDepositWithdraw negative GT" (stakeValidator Stake.stake) (toDatum $ StakeDatum 100_000 signer) - (toDatum $ DepositWithdraw (negate 1_000_000)) + (toDatum $ DepositWithdraw 1_000_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000}) ] ] diff --git a/agora.cabal b/agora.cabal index 7fdf830..6d1005a 100644 --- a/agora.cabal +++ b/agora.cabal @@ -121,7 +121,6 @@ library Agora.AuthorityToken Agora.MultiSig Agora.SafeMoney - Agora.SafeMoney.QQ Agora.Stake Agora.Treasury Agora.Governor diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index f215d30..aa936ae 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -22,8 +22,8 @@ import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash) -} newtype ResultTag = ResultTag {getResultTag :: Integer} -{- | The 'status' of the proposal. This is only useful for __actual__ - state transitions, as opposed to time-based 'phases'. +{- | The "status" of the proposal. This is only useful for __actual__ + state transitions, as opposed to time-based "phases". If the proposal is 'VotingReady', for instance, that doesn't necessarily mean that voting is possible, as this also requires the timing to be right. @@ -48,6 +48,7 @@ data ProposalStatus -- TODO: The owner of the proposal may choose to reclaim their proposal. Finished +-- | Haskell-level datum for Proposal scripts. data ProposalDatum = ProposalDatum { -- TODO: could we encode this more efficiently? -- This is shaped this way for future proofing. diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index 4289c27..0862cef 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -7,7 +7,8 @@ Phantom-type protected types for handling money in Plutus. -} module Agora.SafeMoney ( -- * Types - PDiscrete, + PDiscrete (..), + Discrete (..), -- * Tags and refs AssetClassRef (..), @@ -23,15 +24,16 @@ module Agora.SafeMoney ( -- * Conversions pdiscreteValue, pvalueDiscrete, + discreteValue, ) where import Prelude -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Api (BuiltinData (..), Data (..)) -import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -import PlutusTx.IsData.Class (FromData (..), ToData (..)) +import Plutus.V1.Ledger.Value (AssetClass (AssetClass), Value) +import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx qualified import Plutarch.Api.V1 (PValue) import Plutarch.Builtin () @@ -63,22 +65,21 @@ newtype AssetClassRef (tag :: Type) = AssetClassRef {getAssetClass :: AssetClass adaRef :: AssetClassRef ADATag adaRef = AssetClassRef (AssetClass ("", "")) -{- | Represents a single asset in a 'Value' related to a particular 'AssetClass' +-- TODO: Currently it's possible to transmute from one discrete to another. +-- How do we prevent this? +-- +-- @ +-- transmute :: forall (a :: Type) (b :: Type). Discrete a -> Discrete b +-- transmute = Discrete . getDiscrete +-- @ + +{- | Represents a single asset in a 'Plutus.V1.Ledger.Value.Value' related to a particular 'AssetClass' through 'AssetClassRef'. -} -newtype Discrete (tag :: Type) - = Discrete Integer +newtype Discrete (tag :: Type) = Discrete {getDiscrete :: Integer} deriving stock (Show, Eq) - -{- We have to manually write these instances because the `tag` will confuse - `makeIsDataIndexed`. --} -instance forall tag. FromData (Discrete tag) where - fromBuiltinData (BuiltinData (I x)) = Just (Discrete x) - fromBuiltinData _ = Nothing - -instance forall tag. ToData (Discrete tag) where - toBuiltinData (Discrete x) = BuiltinData (I x) + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving newtype (Num) -- TODO: Use plutarch-numeric {- | Represents a single asset in a 'PValue' related to a particular 'AssetClass' through 'AssetClassRef'. @@ -134,3 +135,11 @@ pdiscreteValue (AssetClassRef (AssetClass (cs, tn))) = phoistAcyclic $ # pconstant cs # pconstant tn # p + +discreteValue :: + forall (tag :: Type). + AssetClassRef tag -> + Discrete tag -> + Value +discreteValue (AssetClassRef (AssetClass (cs, tn))) (Discrete v) = + Value.singleton cs tn v diff --git a/agora/Agora/SafeMoney/QQ.hs b/agora/Agora/SafeMoney/QQ.hs deleted file mode 100644 index 00d4b79..0000000 --- a/agora/Agora/SafeMoney/QQ.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -{- | -Module : Agora.SafeMoney.QQ -Maintainer : emi@haskell.fyi -Description: Quasiquoter for SafeMoney types. - -Quasiquoter for SafeMoney types. --} -module Agora.SafeMoney.QQ (discrete) where - -import GHC.Real (Ratio ((:%))) -import Language.Haskell.TH qualified as TH (Type) -import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter)) -import Language.Haskell.TH.Syntax ( - Dec (TySynD), - Exp (AppE, AppTypeE, LitE, VarE), - Info (TyConI), - Lit (IntegerL), - Pat, - Q, - TyLit (NumTyLit, StrTyLit), - Type (AppT, ConT, LitT, PromotedTupleT), - lookupTypeName, - reify, - ) -import Text.ParserCombinators.ReadP (readP_to_S, skipSpaces) -import Text.Read (lexP, readPrec_to_P) -import Text.Read.Lex (Lexeme (Ident, Number), Number, numberToFixed, numberToRational) -import Prelude - --------------------------------------------------------------------------------- - -import Plutarch.Internal (punsafeCoerce) - -import Agora.SafeMoney (PDiscrete) - --------------------------------------------------------------------------------- - -{- | Generate 'PDiscrete' values tagged by a particular tag - -@ - [discrete| 123.456 'Agora.SafeMoney.ADA' |] :: 'Term' s ('PDiscrete' 'Agora.SafeMoney.ADA') -@ --} -discrete :: QuasiQuoter -discrete = QuasiQuoter discreteExp errorDiscretePat errorDiscreteType errorDiscreteDiscretelaration - -discreteConstant :: forall tag s. Integer -> Term s (PDiscrete tag) -discreteConstant n = punsafeCoerce (pconstant n :: Term s PInteger) - -fixedToInteger :: Integer -> (Integer, Integer) -> Integer -fixedToInteger places (i, f) = i * 10 ^ places + f - -safeIntegerUpcast :: Integer -> Number -> Either String Integer -safeIntegerUpcast places num = - case (numberToFixed places num, numberToRational num * 10 ^ places) of - (Just (i, f), _n :% 1) -> - Right $ fixedToInteger places (i, f) - (Just (i, f), _n :% _d) -> - Left $ "Using more than the available decimal places (" <> show places <> "). Would round to " <> show i <> "." <> show f - _ -> Left "Some error occurred while getting number" - -discreteExp :: String -> Q Exp -discreteExp s = case parseDiscreteRatioExp s of - Nothing -> - fail $ "Input malformed. Got: " <> s - Just (num, mc) -> do - mcName <- - lookupTypeName mc >>= \case - Nothing -> fail $ "Type with the name " <> show mc <> " is not in scope." - Just v -> pure v - reified <- reify mcName - case reified of - TyConI (TySynD tyName [] (AppT (AppT (AppT (PromotedTupleT 3) (LitT (StrTyLit _))) (LitT _)) (LitT (NumTyLit n)))) -> - case safeIntegerUpcast n num of - Right i -> - pure $ AppE (AppTypeE (VarE 'discreteConstant) (ConT tyName)) (LitE (IntegerL i)) - Left e -> fail e - ty' -> fail $ "Could not reify type, got: " <> show ty' - -parseDiscreteRatioExp :: String -> Maybe (Number, String) -parseDiscreteRatioExp s = - let p = skipSpaces *> ((,) <$> readPrec_to_P lexP 0 <* skipSpaces <*> readPrec_to_P lexP 0) <* skipSpaces - in case readP_to_S p s of - [((Number n, Ident i), "")] -> Just (n, i) - _ -> Nothing - -errorDiscretePat :: String -> Q Pat -errorDiscretePat _ = fail "Cannot use 'discrete' in a pattern context." - -errorDiscreteType :: String -> Q TH.Type -errorDiscreteType _ = fail "Cannot use 'discrete' in a type context." - -errorDiscreteDiscretelaration :: String -> Q [Dec] -errorDiscreteDiscretelaration _ = fail "Cannot use 'discrete' in a declaration context." diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 9096427..8d3296e 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -54,6 +54,7 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) import Agora.SafeMoney ( AssetClassRef (..), + Discrete, GTTag, PDiscrete, paddDiscrete, @@ -66,6 +67,7 @@ import Agora.Utils ( anyOutput, paddValue, passert, + passetClassValueOf', pfindTxInByTxOutRef, pgeqByClass, pgeqByClass', @@ -100,7 +102,7 @@ data PStakeRedeemer (s :: S) -- | Haskell-level redeemer for Stake scripts. data StakeRedeemer = -- | Deposit or withdraw a discrete amount of the staked governance token. - DepositWithdraw Integer + DepositWithdraw (Discrete GTTag) | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. Destroy deriving stock (Show, GHC.Generic) @@ -121,8 +123,7 @@ newtype PStakeDatum (s :: S) = PStakeDatum -- | Haskell-level datum for Stake scripts. data StakeDatum = StakeDatum - { -- FIXME: This needs to be gt - stakedAmount :: Integer + { stakedAmount :: Discrete GTTag , owner :: PubKeyHash } deriving stock (Show, GHC.Generic) @@ -306,6 +307,9 @@ stakeValidator stake = ] let expectedValue = paddValue # continuingValue # (pdiscreteValue stake.gtClassRef # delta) + ptrace (pshow $ passetClassValueOf' stake.gtClassRef.getAssetClass # value) + ptrace (pshow $ passetClassValueOf' stake.gtClassRef.getAssetClass # expectedValue) + -- TODO: Same as above. This is quite inefficient now, as it does two lookups -- instead of a more efficient single pass, -- but it doesn't really matter for this. At least it's correct. diff --git a/agora/Agora/Voting.hs b/agora/Agora/Voting.hs deleted file mode 100644 index 066956c..0000000 --- a/agora/Agora/Voting.hs +++ /dev/null @@ -1,8 +0,0 @@ -{- | -Module : Agora.Voting -Maintainer : emi@haskell.fyi -Description: Types for votes and vote counting --} -module Agora.Voting ( - Vote (..), -) where From ae5c18aa00af40365138a6ab7f8494b50445fbdf Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Sat, 26 Mar 2022 16:07:21 +0100 Subject: [PATCH 07/31] add vote tally to Proposal datum --- agora.cabal | 1 + agora/Agora/Effect.hs | 8 ++++++ agora/Agora/Proposal.hs | 64 +++++++++++++++++++++++++++++++++++------ 3 files changed, 64 insertions(+), 9 deletions(-) create mode 100644 agora/Agora/Effect.hs diff --git a/agora.cabal b/agora.cabal index 6d1005a..aeb2adb 100644 --- a/agora.cabal +++ b/agora.cabal @@ -122,6 +122,7 @@ library Agora.MultiSig Agora.SafeMoney Agora.Stake + Agora.Effect Agora.Treasury Agora.Governor Agora.Proposal diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs new file mode 100644 index 0000000..b802044 --- /dev/null +++ b/agora/Agora/Effect.hs @@ -0,0 +1,8 @@ +{- | +Module : Agora.Effect +Maintainer : emi@haskell.fyi +Description: Helpers for constructing effects + +Helpers for constructing effects. +-} +module Agora.Effect () where diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index aa936ae..8b7d263 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -8,6 +8,8 @@ Proposal scripts encoding effects that operate on the system. module Agora.Proposal ( ProposalDatum (..), ProposalStatus (..), + ProposalThresholds (..), + ProposalVotes (..), ResultTag (..), ) where @@ -15,39 +17,79 @@ import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash) -------------------------------------------------------------------------------- +import Agora.SafeMoney (Discrete, GTTag) + +-------------------------------------------------------------------------------- + {- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this: - "No" ~ EffectTag 0 - "Yes" ~ EffectTag 1 +@ +"No" ~ 'ResultTag' 0 +"Yes" ~ 'ResultTag' 1 +@ -} newtype ResultTag = ResultTag {getResultTag :: Integer} -{- | The "status" of the proposal. This is only useful for __actual__ - state transitions, as opposed to time-based "phases". +{- | The "status" of the proposal. This is only useful for state transitions, + as opposed to time-based "phases". If the proposal is 'VotingReady', for instance, that doesn't necessarily mean that voting is possible, as this also requires the timing to be right. -} data ProposalStatus = -- | A draft proposal represents a proposal that has yet to be realized. + -- -- In effect, this means one which didn't have enough LQ to be a full -- proposal, and needs cosigners to enable that to happen. This is -- similar to a "temperature check", but only useful if multiple people -- want to pool governance tokens together. If the proposal doesn't get to - -- 'VotingReady' on time, the proposal will **never** be able to get + -- 'VotingReady' on time, the proposal will __never__ be able to get -- voted on. Draft | -- | The proposal has/had enough GT cosigned in order to be a fully fledged - -- proposal. This means that once the timing requirements align, + -- proposal. + -- + -- This means that once the timing requirements align, -- proposal will be able to be voted on. VotingReady - | -- | The proposal has finished for whatever reason. This can mean it's been - -- voted on and completed, but it can also mean the proposal failed due to - -- time constraints or didn't get to 'VotingReady' first. + | -- | The proposal has finished. + -- + -- This can mean it's been voted on and completed, but it can also mean + -- the proposal failed due to time constraints or didn't + -- get to 'VotingReady' first. -- -- TODO: The owner of the proposal may choose to reclaim their proposal. Finished +{- | The threshold values for various state transitions to happen. + This data is stored centrally (in the Governor) and copied over + to Proposals when they are created. +-} +data ProposalThresholds = ProposalThresholds + { execute :: Discrete GTTag + -- ^ How much GT minimum must a particular 'ResultTag' accumulate to fulfil. + , draft :: Discrete GTTag + -- ^ How much GT required to "create" a proposal. + , vote :: Discrete GTTag + -- ^ How much GT required to allow voting to happen. + -- (i.e. to move into 'VotingReady') + } + +{- | Map which encodes the total tally for each result. + It's important that the 'shape' is consistent with the shape of 'effects'. + + e.g. if the 'effects' field looks like the following: + + @[('ResultTag' 0, []), ('ResultTag' 1, [(vh, dh)])]@ + + Then 'ProposalVotes' need be of the shape: + + @[('ResultTag' 0, n), ('ResultTag' 1, m)]@ +-} +newtype ProposalVotes = ProposalVotes + { getProposalVotes :: [(ResultTag, Integer)] + } + -- | Haskell-level datum for Proposal scripts. data ProposalDatum = ProposalDatum { -- TODO: could we encode this more efficiently? @@ -60,4 +102,8 @@ data ProposalDatum = ProposalDatum , proposers :: [PubKeyHash] -- ^ Who created the proposal initially. -- We may want to remove this. + , thresholds :: ProposalThresholds + -- ^ Thresholds copied over on initialization. + , votes :: ProposalVotes + -- ^ Vote tally on the proposal } From 85344059202d3753a92dc55fc16510b04208dbab Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 12:20:47 +0200 Subject: [PATCH 08/31] flesh out Governor datum a bit more --- agora/Agora/Governor.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 5dea361..b4ad0bc 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -5,4 +5,24 @@ Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. -} -module Agora.Governor () where +module Agora.Governor (GovernorDatum (..)) where + +import Agora.Proposal (ProposalThresholds) + +data GovernorDatum = GovernorDatum + { proposalThresholds :: ProposalThresholds + -- ^ Gets copied over upon creation of a 'Proposal'. + } + +{- | Redeemer for Governor script. + + The governor has two primary responsibilities: + - The gating of Proposal creation + - The gating of minting authority tokens +-} +data GovernorRedeemer + = -- | Checks that a proposal was created lawfully, and allows it. + CreateProposal + | -- | Checks that a SINGLE proposal finished correctly, + -- and allows minting GATs for each effect script. + MintGATs From 64d006d025aee43589f9e7a7c672fda775c9fc15 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 13:12:16 +0200 Subject: [PATCH 09/31] add 'makeEffect' template stub --- agora/Agora/Effect.hs | 31 ++++++++++++++++++++++++++++++- agora/Agora/Governor.hs | 2 +- agora/PPrelude.hs | 5 +++-- 3 files changed, 34 insertions(+), 4 deletions(-) diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index b802044..fccb32e 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -5,4 +5,33 @@ Description: Helpers for constructing effects Helpers for constructing effects. -} -module Agora.Effect () where +module Agora.Effect (makeEffect) where + +import Plutarch.Api.V1 (PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator) +import Plutarch.Internal (punsafeCoerce) +import Plutarch.Monadic qualified as P + +-------------------------------------------------------------------------------- + +-- | Helper 'template' for creating effect validator. +makeEffect :: + forall (datum :: PType) (s :: S). + PIsData datum => + (Term s datum -> Term s PTxOutRef -> Term s PTxInfo -> Term s POpaque) -> + Term s PValidator +makeEffect f = + plam $ \datum _redeemer ctx' -> P.do + ctx <- pletFields @'["txInfo", "purpose"] ctx' + txInfo' <- plet ctx.txInfo + + let datum' :: Term _ datum + datum' = pfromData $ punsafeCoerce datum + + PSpending txOutRef <- pmatch $ pfromData ctx.purpose + txOutRef' <- plet (pfield @"_0" # txOutRef) + + -- TODO: Here, check that a *single* GAT is burned. + + f datum' txOutRef' txInfo' + +-------------------------------------------------------------------------------- diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index b4ad0bc..f44eda1 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -5,7 +5,7 @@ Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. -} -module Agora.Governor (GovernorDatum (..)) where +module Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) where import Agora.Proposal (ProposalThresholds) diff --git a/agora/PPrelude.hs b/agora/PPrelude.hs index 8fba4be..3232cf9 100644 --- a/agora/PPrelude.hs +++ b/agora/PPrelude.hs @@ -11,7 +11,8 @@ module PPrelude ( module Plutarch, ) where --- These are not exported by Plutarch.Prelude, for some reason. Maybe we can 'fix' this upstream? -import Plutarch (ClosedTerm, compile) +-- NOTE: These are not exported by Plutarch.Prelude, for some reason. +-- Maybe we can 'fix' this upstream? +import Plutarch (ClosedTerm, POpaque, compile) import Plutarch.Prelude import Prelude From 43f3b5c62a3e4a39133a20d0b7c76ea8fac18a85 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 13:34:09 +0200 Subject: [PATCH 10/31] add Plutarch versions of Proposal types for sanity check. --- agora/Agora/Proposal.hs | 91 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 87 insertions(+), 4 deletions(-) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 8b7d263..c9f2daa 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -6,20 +6,38 @@ Description: Proposal scripts encoding effects that operate on the system. Proposal scripts encoding effects that operate on the system. -} module Agora.Proposal ( + -- * Haskell-land ProposalDatum (..), ProposalStatus (..), ProposalThresholds (..), ProposalVotes (..), ResultTag (..), + + -- * Plutarch-land + PProposalDatum (..), + PResultTag (..), ) where +import GHC.Generics qualified as GHC +import Generics.SOP (Generic, I (I)) +import Plutarch.Api.V1 ( + PDatumHash, + PMap, + PPubKeyHash, + PValidatorHash, + ) +import Plutarch.DataRepr ( + PDataFields, + PIsDataReprInstances (PIsDataReprInstances), + ) import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash) -------------------------------------------------------------------------------- -import Agora.SafeMoney (Discrete, GTTag) +import Agora.SafeMoney (Discrete, GTTag, PDiscrete) -------------------------------------------------------------------------------- +-- Haskell-land {- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this: @@ -99,11 +117,76 @@ data ProposalDatum = ProposalDatum -- ^ Effect lookup table. First by result, then by , status :: ProposalStatus -- ^ The status the proposal is in. - , proposers :: [PubKeyHash] - -- ^ Who created the proposal initially. - -- We may want to remove this. + , cosigners :: [PubKeyHash] + -- ^ Who created the proposal initially + who cosigned. , thresholds :: ProposalThresholds -- ^ Thresholds copied over on initialization. , votes :: ProposalVotes -- ^ Vote tally on the proposal } + +-------------------------------------------------------------------------------- +-- Plutarch-land + +-- | Plutarch-level version of 'ResultTag'. +newtype PResultTag (s :: S) = PResultTag (Term s PInteger) + deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PResultTag PInteger) + +-- | Plutarch-level version of 'ProposalStatus'. +data PProposalStatus (s :: S) + = -- TODO: 'PProposalStatus' ought te be encoded as 'PInteger'. + -- e.g. like Tilde used 'pmatchEnum'. + PDraft (Term s (PDataRecord '[])) + | PVotingReady (Term s (PDataRecord '[])) + | PFinished (Term s (PDataRecord '[])) + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData) + via PIsDataReprInstances PProposalStatus + +-- | Plutarch-level version of 'ProposalThresholds'. +data PProposalThresholds (s :: S) = PProposalThresholds + { getProposalThresholds :: + Term + s + ( PDataRecord + '[ "execute" ':= PDiscrete GTTag + , "draft" ':= PDiscrete GTTag + , "vote" ':= PDiscrete GTTag + ] + ) + } + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields) + via (PIsDataReprInstances PProposalThresholds) + +-- | Plutarch-level version of 'ProposalVotes'. +newtype PProposalVotes (s :: S) + = PProposalVotes (Term s (PMap PResultTag PInteger)) + deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap PResultTag PInteger)) + +-- | Plutarch-level version of 'ProposalDatum'. +newtype PProposalDatum (s :: S) = PProposalDatum + { getProposalDatum :: + Term + s + ( PDataRecord + '[ "effects" ':= PMap PResultTag (PMap PValidatorHash PDatumHash) + , "status" ':= PProposalStatus + , "cosigners" ':= PBuiltinList PPubKeyHash + , "thresholds" ':= PProposalThresholds + , "votes" ':= PProposalVotes + ] + ) + } + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields) + via (PIsDataReprInstances PProposalDatum) From 8d50857dfdf4fcf05e6ce13f060371e5c695554d Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 13:51:30 +0200 Subject: [PATCH 11/31] add IsData instances to ProposalTypes --- agora/Agora/Proposal.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index c9f2daa..596a169 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + {- | Module : Agora.Proposal Maintainer : emi@haskell.fyi @@ -31,6 +33,7 @@ import Plutarch.DataRepr ( PIsDataReprInstances (PIsDataReprInstances), ) import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash) +import PlutusTx qualified -------------------------------------------------------------------------------- @@ -47,6 +50,7 @@ import Agora.SafeMoney (Discrete, GTTag, PDiscrete) @ -} newtype ResultTag = ResultTag {getResultTag :: Integer} + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) {- | The "status" of the proposal. This is only useful for state transitions, as opposed to time-based "phases". @@ -79,6 +83,8 @@ data ProposalStatus -- TODO: The owner of the proposal may choose to reclaim their proposal. Finished +PlutusTx.makeIsDataIndexed ''ProposalStatus [('Draft, 0), ('VotingReady, 1), ('Finished, 2)] + {- | The threshold values for various state transitions to happen. This data is stored centrally (in the Governor) and copied over to Proposals when they are created. @@ -93,6 +99,8 @@ data ProposalThresholds = ProposalThresholds -- (i.e. to move into 'VotingReady') } +PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)] + {- | Map which encodes the total tally for each result. It's important that the 'shape' is consistent with the shape of 'effects'. @@ -107,6 +115,7 @@ data ProposalThresholds = ProposalThresholds newtype ProposalVotes = ProposalVotes { getProposalVotes :: [(ResultTag, Integer)] } + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) -- | Haskell-level datum for Proposal scripts. data ProposalDatum = ProposalDatum @@ -125,6 +134,8 @@ data ProposalDatum = ProposalDatum -- ^ Vote tally on the proposal } +PlutusTx.makeIsDataIndexed ''ProposalDatum [('ProposalDatum, 0)] + -------------------------------------------------------------------------------- -- Plutarch-land From cf7f8a67923f563d9bed461341ef2f590062460d Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 13:55:47 +0200 Subject: [PATCH 12/31] fix `hie.yaml` path for agora main library --- hie.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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" From 107db1303dc8cb2cec7f093095846dde68f57daa Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 14:59:53 +0200 Subject: [PATCH 13/31] fix docs, hlint errors --- agora-test/Spec.hs | 2 +- agora-test/Spec/Model/MultiSig.hs | 4 ++-- agora-test/Spec/Stake.hs | 2 +- agora/Agora/Effect.hs | 2 +- agora/Agora/Governor.hs | 5 +++-- agora/Agora/MultiSig.hs | 4 ++-- agora/Agora/Proposal.hs | 9 +++++++-- agora/Agora/SafeMoney.hs | 5 +++-- agora/Agora/Utils.hs | 8 ++++---- 9 files changed, 24 insertions(+), 17 deletions(-) diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 502cb27..6442ae8 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -11,7 +11,7 @@ import Test.Tasty (defaultMain, testGroup) import Spec.Model.MultiSig qualified as MultiSig import Spec.Stake qualified as Stake --- | The Agora test suite +-- | The Agora test suite. main :: IO () main = defaultMain $ diff --git a/agora-test/Spec/Model/MultiSig.hs b/agora-test/Spec/Model/MultiSig.hs index 15dcfae..47dfda0 100644 --- a/agora-test/Spec/Model/MultiSig.hs +++ b/agora-test/Spec/Model/MultiSig.hs @@ -171,7 +171,7 @@ instance HasScriptRunner MultiSigProp MultiSigModel where (pcon PUnit) perror --- | Consistency tests for the 'HasParameterisedGenerator' instance of 'MultiSigModel' +-- | Consistency tests for the 'HasParameterisedGenerator' instance of 'MultiSigModel'. genTests :: TestTree genTests = testGroup "genTests" $ @@ -182,7 +182,7 @@ genTests = Yes ] --- | Tests for the 'HasScriptRunner' instance of 'MultiSigModel' +-- | Tests for the 'HasScriptRunner' instance of 'MultiSigModel'. plutarchTests :: TestTree plutarchTests = testGroup "plutarchTests" $ diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index 5ce5d79..ccd16e7 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -29,7 +29,7 @@ import Spec.Util (policyFailsWith, policySucceedsWith, toDatum, validatorFailsWi -------------------------------------------------------------------------------- --- | Stake tests +-- | Stake tests. tests :: [TestTree] tests = [ testGroup diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index fccb32e..82764d2 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -13,7 +13,7 @@ import Plutarch.Monadic qualified as P -------------------------------------------------------------------------------- --- | Helper 'template' for creating effect validator. +-- | Helper "template" for creating effect validator. makeEffect :: forall (datum :: PType) (s :: S). PIsData datum => diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index f44eda1..55b480e 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -9,9 +9,10 @@ module Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) where import Agora.Proposal (ProposalThresholds) -data GovernorDatum = GovernorDatum +-- | Datum for the Governor script. +newtype GovernorDatum = GovernorDatum { proposalThresholds :: ProposalThresholds - -- ^ Gets copied over upon creation of a 'Proposal'. + -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. } {- | Redeemer for Governor script. diff --git a/agora/Agora/MultiSig.hs b/agora/Agora/MultiSig.hs index 6e8270d..93cf3e6 100644 --- a/agora/Agora/MultiSig.hs +++ b/agora/Agora/MultiSig.hs @@ -77,13 +77,13 @@ deriving via (DerivePConstantViaData MultiSig PMultiSig) instance (PConstant Mul -------------------------------------------------------------------------------- --- | Check if a Haskell-level MultiSig signs this transaction +-- | Check if a Haskell-level MultiSig signs this transaction. validatedByMultisig :: MultiSig -> Term s (PTxInfo :--> PBool) validatedByMultisig params = phoistAcyclic $ pvalidatedByMultisig # pconstant params --- | Check if a Plutarch-level MultiSig signs this transaction +-- | Check if a Plutarch-level MultiSig signs this transaction. pvalidatedByMultisig :: Term s (PMultiSig :--> PTxInfo :--> PBool) pvalidatedByMultisig = phoistAcyclic $ diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 596a169..0584b99 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -9,6 +9,7 @@ Proposal scripts encoding effects that operate on the system. -} module Agora.Proposal ( -- * Haskell-land + Proposal (..), ProposalDatum (..), ProposalStatus (..), ProposalThresholds (..), @@ -50,6 +51,7 @@ import Agora.SafeMoney (Discrete, GTTag, PDiscrete) @ -} newtype ResultTag = ResultTag {getResultTag :: Integer} + deriving stock (Eq, Show) deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) {- | The "status" of the proposal. This is only useful for state transitions, @@ -102,7 +104,7 @@ data ProposalThresholds = ProposalThresholds PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)] {- | Map which encodes the total tally for each result. - It's important that the 'shape' is consistent with the shape of 'effects'. + It's important that the "shape" is consistent with the shape of 'effects'. e.g. if the 'effects' field looks like the following: @@ -136,6 +138,9 @@ data ProposalDatum = ProposalDatum PlutusTx.makeIsDataIndexed ''ProposalDatum [('ProposalDatum, 0)] +-- | Parameters that identify the Proposal validator script. +data Proposal = Proposal + -------------------------------------------------------------------------------- -- Plutarch-land @@ -158,7 +163,7 @@ data PProposalStatus (s :: S) via PIsDataReprInstances PProposalStatus -- | Plutarch-level version of 'ProposalThresholds'. -data PProposalThresholds (s :: S) = PProposalThresholds +newtype PProposalThresholds (s :: S) = PProposalThresholds { getProposalThresholds :: Term s diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index 0862cef..d8c3da0 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -50,10 +50,10 @@ import Agora.Utils ( -------------------------------------------------------------------------------- -- Example tags --- | Governance token +-- | Governance token. data GTTag --- | ADA +-- | ADA. data ADATag -------------------------------------------------------------------------------- @@ -136,6 +136,7 @@ pdiscreteValue (AssetClassRef (AssetClass (cs, tn))) = phoistAcyclic $ # pconstant tn # p +-- | Get a `Value` from a `Discrete`. discreteValue :: forall (tag :: Type). AssetClassRef tag -> diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 9c5224a..2f875b0 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -183,21 +183,21 @@ passetClassValueOf' :: AssetClass -> Term s (PValue :--> PInteger) passetClassValueOf' (AssetClass (sym, token)) = passetClassValueOf # pconstant sym # pconstant token --- | Return '>=' on two values comparing by only a particular AssetClass +-- | Return '>=' on two values comparing by only a particular AssetClass. pgeqByClass :: Term s (PCurrencySymbol :--> PTokenName :--> PValue :--> PValue :--> PBool) pgeqByClass = phoistAcyclic $ plam $ \cs tn a b -> passetClassValueOf # cs # tn # b #<= passetClassValueOf # cs # tn # a --- | Return '>=' on two values comparing by only a particular CurrencySymbol +-- | Return '>=' on two values comparing by only a particular CurrencySymbol. pgeqBySymbol :: Term s (PCurrencySymbol :--> PValue :--> PValue :--> PBool) pgeqBySymbol = phoistAcyclic $ plam $ \cs a b -> psymbolValueOf # cs # b #<= psymbolValueOf # cs # a --- | Return '>=' on two values comparing by only a particular Haskell-level AssetClass +-- | Return '>=' on two values comparing by only a particular Haskell-level AssetClass. pgeqByClass' :: AssetClass -> Term s (PValue :--> PValue :--> PBool) pgeqByClass' ac = phoistAcyclic $ @@ -233,7 +233,7 @@ pmapUnionWith = phoistAcyclic $ # ys pcon (PMap $ pconcat # ls # rs) --- | Add two 'PValue's together +-- | Add two 'PValue's together. paddValue :: forall s. Term s (PValue :--> PValue :--> PValue) paddValue = phoistAcyclic $ plam $ \a' b' -> P.do From 2e312599e5ad403f040d98124b10355c0460c53c Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Mon, 28 Mar 2022 14:20:34 +0100 Subject: [PATCH 14/31] Bumped apropos --- agora-test/Spec/Model/MultiSig.hs | 6 +- agora.cabal | 1 + flake.lock | 434 +++++++++++++++++++++++++++--- flake.nix | 10 +- 4 files changed, 408 insertions(+), 43 deletions(-) diff --git a/agora-test/Spec/Model/MultiSig.hs b/agora-test/Spec/Model/MultiSig.hs index 15dcfae..9b4e4ca 100644 --- a/agora-test/Spec/Model/MultiSig.hs +++ b/agora-test/Spec/Model/MultiSig.hs @@ -53,7 +53,7 @@ import Apropos ( import Apropos.Gen (Gen, choice, int, linear, list) import Apropos.LogicalModel (Enumerable) import Apropos.LogicalModel.Enumerable (Enumerable (enumerated)) -import Apropos.Script (HasScriptRunner (expect, runScriptTestsWhere, script)) +import Apropos.Script (ScriptModel (expect, runScriptTestsWhere, script)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (fromGroup) @@ -157,7 +157,7 @@ instance HasParameterisedGenerator MultiSigProp MultiSigModel where -- Return the generated model. pure (MultiSigModel msig ctx) -instance HasScriptRunner MultiSigProp MultiSigModel where +instance ScriptModel MultiSigProp MultiSigModel where -- When the script runs, we want the model to meet the minimum signatures. expect :: (MultiSigModel :+ MultiSigProp) -> Formula MultiSigProp expect Apropos = Var MeetsMinSigs @@ -182,7 +182,7 @@ genTests = Yes ] --- | Tests for the 'HasScriptRunner' instance of 'MultiSigModel' +-- | Tests for the 'ScriptModel' instance of 'MultiSigModel' plutarchTests :: TestTree plutarchTests = testGroup "plutarchTests" $ diff --git a/agora.cabal b/agora.cabal index b50a55b..4030dee 100644 --- a/agora.cabal +++ b/agora.cabal @@ -108,6 +108,7 @@ common deps common test-deps build-depends: + , apropos , apropos-tx , QuickCheck , quickcheck-instances diff --git a/flake.lock b/flake.lock index a8f99c4..e1e9ea4 100644 --- a/flake.lock +++ b/flake.lock @@ -32,6 +32,22 @@ "type": "github" } }, + "HTTP_3": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, "Shrinker": { "flake": false, "locked": { @@ -48,11 +64,37 @@ "type": "github" } }, - "apropos-tx": { + "apropos": { "inputs": { "flake-compat": "flake-compat", "flake-compat-ci": "flake-compat-ci", "haskell-nix": "haskell-nix", + "nixpkgs": [ + "apropos", + "haskell-nix", + "nixpkgs-unstable" + ] + }, + "locked": { + "lastModified": 1647683439, + "narHash": "sha256-r76rHhZSZsazHxTBHbqK7zlMB9rjjGmGWOUbR0fuxn8=", + "owner": "jhodgdev", + "repo": "apropos", + "rev": "c6c580aeab8b5c2a6512a49823dd17936e87b70a", + "type": "github" + }, + "original": { + "owner": "jhodgdev", + "repo": "apropos", + "rev": "c6c580aeab8b5c2a6512a49823dd17936e87b70a", + "type": "github" + } + }, + "apropos-tx": { + "inputs": { + "flake-compat": "flake-compat_2", + "flake-compat-ci": "flake-compat-ci_2", + "haskell-nix": "haskell-nix_2", "nixpkgs": [ "plutarch", "haskell-nix", @@ -61,17 +103,17 @@ "plutus": "plutus" }, "locked": { - "lastModified": 1646436508, - "narHash": "sha256-4QevdgeSSHfOyJEqdiNx6SovGpLZv1vw9i6r0XbpQ3U=", - "owner": "mlabs-haskell", + "lastModified": 1647684164, + "narHash": "sha256-spKe45P4XNJ6iZvSb2ircBh1OlF95o+im+Se2hlCbkQ=", + "owner": "jhodgdev", "repo": "apropos-tx", - "rev": "5b74ba897a6f02718c163bf588a08c5e3e9de204", + "rev": "582496d0dfb88ce007bb0d2a2dcbc72ea0bb1cd1", "type": "github" }, "original": { - "owner": "mlabs-haskell", + "owner": "jhodgdev", "repo": "apropos-tx", - "rev": "5b74ba897a6f02718c163bf588a08c5e3e9de204", + "rev": "582496d0dfb88ce007bb0d2a2dcbc72ea0bb1cd1", "type": "github" } }, @@ -110,6 +152,23 @@ } }, "cabal-32_2": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", + "owner": "haskell", + "repo": "cabal", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-32_3": { "flake": false, "locked": { "lastModified": 1603716527, @@ -144,6 +203,23 @@ } }, "cabal-34_2": { + "flake": false, + "locked": { + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", + "owner": "haskell", + "repo": "cabal", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34_3": { "flake": false, "locked": { "lastModified": 1622475795, @@ -178,6 +254,23 @@ } }, "cabal-36_2": { + "flake": false, + "locked": { + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", + "owner": "haskell", + "repo": "cabal", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36_3": { "flake": false, "locked": { "lastModified": 1640163203, @@ -308,6 +401,22 @@ "type": "github" } }, + "cardano-shell_3": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, "cryptonite": { "flake": false, "locked": { @@ -371,6 +480,21 @@ "type": "github" } }, + "flake-compat-ci_3": { + "locked": { + "lastModified": 1641672839, + "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "type": "github" + } + }, "flake-compat_2": { "flake": false, "locked": { @@ -388,6 +512,22 @@ } }, "flake-compat_3": { + "flake": false, + "locked": { + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_4": { "flake": false, "locked": { "lastModified": 1606424373, @@ -404,7 +544,7 @@ "type": "github" } }, - "flake-compat_4": { + "flake-compat_5": { "flake": false, "locked": { "lastModified": 1606424373, @@ -436,6 +576,21 @@ } }, "flake-utils_2": { + "locked": { + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_3": { "locked": { "lastModified": 1623875721, "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", @@ -518,6 +673,23 @@ "type": "github" } }, + "ghc-8.6.5-iohk_3": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, "gitignore-nix": { "flake": false, "locked": { @@ -599,6 +771,22 @@ } }, "hackage_2": { + "flake": false, + "locked": { + "lastModified": 1646270198, + "narHash": "sha256-SakG546Zr9RuNPs5mhtT7CYPpvEDMGrWisWK/VpCvr0=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "4cf90b36955597d0151940eabfb1b61a8ec42256", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage_3": { "flake": false, "locked": { "lastModified": 1642554756, @@ -677,9 +865,9 @@ "hpc-coveralls": "hpc-coveralls", "nix-tools": "nix-tools", "nixpkgs": [ - "apropos-tx", + "apropos", "haskell-nix", - "nixpkgs-unstable" + "nixpkgs-2105" ], "nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2105": "nixpkgs-2105", @@ -703,7 +891,29 @@ } }, "haskell-nix_2": { - "flake": false, + "inputs": { + "HTTP": "HTTP_2", + "cabal-32": "cabal-32_2", + "cabal-34": "cabal-34_2", + "cabal-36": "cabal-36_2", + "cardano-shell": "cardano-shell_2", + "flake-utils": "flake-utils_2", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", + "hackage": "hackage_2", + "hpc-coveralls": "hpc-coveralls_2", + "nix-tools": "nix-tools_2", + "nixpkgs": [ + "apropos-tx", + "haskell-nix", + "nixpkgs-2105" + ], + "nixpkgs-2003": "nixpkgs-2003_2", + "nixpkgs-2105": "nixpkgs-2105_2", + "nixpkgs-2111": "nixpkgs-2111_2", + "nixpkgs-unstable": "nixpkgs-unstable_2", + "old-ghc-nix": "old-ghc-nix_2", + "stackage": "stackage_2" + }, "locked": { "lastModified": 1646278384, "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", @@ -719,28 +929,44 @@ } }, "haskell-nix_3": { + "flake": false, + "locked": { + "lastModified": 1646278384, + "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_4": { "inputs": { - "HTTP": "HTTP_2", - "cabal-32": "cabal-32_2", - "cabal-34": "cabal-34_2", - "cabal-36": "cabal-36_2", - "cardano-shell": "cardano-shell_2", - "flake-utils": "flake-utils_2", - "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", - "hackage": "hackage_2", - "hpc-coveralls": "hpc-coveralls_2", - "nix-tools": "nix-tools_2", + "HTTP": "HTTP_3", + "cabal-32": "cabal-32_3", + "cabal-34": "cabal-34_3", + "cabal-36": "cabal-36_3", + "cardano-shell": "cardano-shell_3", + "flake-utils": "flake-utils_3", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", + "hackage": "hackage_3", + "hpc-coveralls": "hpc-coveralls_3", + "nix-tools": "nix-tools_3", "nixpkgs": [ "plutarch", "haskell-nix", "nixpkgs-2111" ], - "nixpkgs-2003": "nixpkgs-2003_2", - "nixpkgs-2105": "nixpkgs-2105_2", - "nixpkgs-2111": "nixpkgs-2111_3", - "nixpkgs-unstable": "nixpkgs-unstable_2", - "old-ghc-nix": "old-ghc-nix_2", - "stackage": "stackage_2" + "nixpkgs-2003": "nixpkgs-2003_3", + "nixpkgs-2105": "nixpkgs-2105_3", + "nixpkgs-2111": "nixpkgs-2111_4", + "nixpkgs-unstable": "nixpkgs-unstable_3", + "old-ghc-nix": "old-ghc-nix_3", + "stackage": "stackage_3" }, "locked": { "lastModified": 1642811877, @@ -757,7 +983,7 @@ "type": "github" } }, - "haskell-nix_4": { + "haskell-nix_5": { "flake": false, "locked": { "lastModified": 1629380841, @@ -775,7 +1001,7 @@ }, "hercules-ci-agent": { "inputs": { - "flake-compat": "flake-compat_4", + "flake-compat": "flake-compat_5", "nix-darwin": "nix-darwin", "nixos-20_09": "nixos-20_09", "nixos-unstable": "nixos-unstable", @@ -798,7 +1024,7 @@ }, "hercules-ci-effects": { "inputs": { - "flake-compat": "flake-compat_3", + "flake-compat": "flake-compat_4", "hercules-ci-agent": "hercules-ci-agent", "nixpkgs": "nixpkgs_3", "nixpkgs-nixops": "nixpkgs-nixops" @@ -849,6 +1075,22 @@ "type": "github" } }, + "hpc-coveralls_3": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, "hs-memory": { "flake": false, "locked": { @@ -949,6 +1191,22 @@ } }, "nix-tools_2": { + "flake": false, + "locked": { + "lastModified": 1644395812, + "narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, + "nix-tools_3": { "flake": false, "locked": { "lastModified": 1636018067, @@ -1045,6 +1303,22 @@ "type": "github" } }, + "nixpkgs-2003_3": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2105": { "locked": { "lastModified": 1642244250, @@ -1062,6 +1336,22 @@ } }, "nixpkgs-2105_2": { + "locked": { + "lastModified": 1642244250, + "narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105_3": { "locked": { "lastModified": 1640283157, "narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=", @@ -1094,6 +1384,22 @@ } }, "nixpkgs-2111_2": { + "locked": { + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_3": { "locked": { "lastModified": 1647902355, "narHash": "sha256-SySJ8IRaogpc/BPOkysA+kzq9URvXthoeKIemaTKCiM=", @@ -1109,7 +1415,7 @@ "type": "github" } }, - "nixpkgs-2111_3": { + "nixpkgs-2111_4": { "locked": { "lastModified": 1640283207, "narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=", @@ -1125,7 +1431,7 @@ "type": "github" } }, - "nixpkgs-2111_4": { + "nixpkgs-2111_5": { "locked": { "lastModified": 1644510859, "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", @@ -1174,6 +1480,22 @@ } }, "nixpkgs-unstable_2": { + "locked": { + "lastModified": 1644486793, + "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable_3": { "locked": { "lastModified": 1641285291, "narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=", @@ -1270,6 +1592,23 @@ "type": "github" } }, + "old-ghc-nix_3": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, "plutarch": { "inputs": { "Shrinker": "Shrinker", @@ -1278,12 +1617,12 @@ "cardano-crypto": "cardano-crypto", "cardano-prelude": "cardano-prelude", "cryptonite": "cryptonite", - "flake-compat": "flake-compat_2", - "flake-compat-ci": "flake-compat-ci_2", + "flake-compat": "flake-compat_3", + "flake-compat-ci": "flake-compat-ci_3", "flat": "flat", "foundation": "foundation", "haskell-language-server": "haskell-language-server_2", - "haskell-nix": "haskell-nix_3", + "haskell-nix": "haskell-nix_4", "hercules-ci-effects": "hercules-ci-effects", "hs-memory": "hs-memory", "iohk-nix": "iohk-nix_2", @@ -1292,7 +1631,7 @@ "haskell-nix", "nixpkgs-unstable" ], - "nixpkgs-2111": "nixpkgs-2111_4", + "nixpkgs-2111": "nixpkgs-2111_5", "plutus": "plutus_2", "protolude": "protolude", "safe-coloured-text": "safe-coloured-text", @@ -1322,7 +1661,7 @@ "gitignore-nix": "gitignore-nix", "hackage-nix": "hackage-nix", "haskell-language-server": "haskell-language-server", - "haskell-nix": "haskell-nix_2", + "haskell-nix": "haskell-nix_3", "iohk-nix": "iohk-nix", "nixpkgs": "nixpkgs", "pre-commit-hooks-nix": "pre-commit-hooks-nix", @@ -1349,7 +1688,7 @@ "gitignore-nix": "gitignore-nix_2", "hackage-nix": "hackage-nix_2", "haskell-language-server": "haskell-language-server_3", - "haskell-nix": "haskell-nix_4", + "haskell-nix": "haskell-nix_5", "iohk-nix": "iohk-nix_3", "nixpkgs": "nixpkgs_4", "pre-commit-hooks-nix": "pre-commit-hooks-nix_3", @@ -1438,6 +1777,7 @@ }, "root": { "inputs": { + "apropos": "apropos", "apropos-tx": "apropos-tx", "haskell-nix": [ "plutarch", @@ -1447,7 +1787,7 @@ "plutarch", "nixpkgs" ], - "nixpkgs-2111": "nixpkgs-2111_2", + "nixpkgs-2111": "nixpkgs-2111_3", "plutarch": "plutarch" } }, @@ -1566,6 +1906,22 @@ } }, "stackage_2": { + "flake": false, + "locked": { + "lastModified": 1646270328, + "narHash": "sha256-WFzBTbZW9zKnZtHLBLGui9F1tBDKX7ixBtaQOG5SK/M=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "b3171527569b52b3924d8e70e0aed753d3f55cc4", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage_3": { "flake": false, "locked": { "lastModified": 1642468901, diff --git a/flake.nix b/flake.nix index e49426e..5bb313e 100644 --- a/flake.nix +++ b/flake.nix @@ -13,10 +13,13 @@ # https://github.com/mlabs-haskell/apropos-tx/pull/28 inputs.apropos-tx.url = - "github:mlabs-haskell/apropos-tx?rev=5b74ba897a6f02718c163bf588a08c5e3e9de204"; + "github:jhodgdev/apropos-tx?rev=582496d0dfb88ce007bb0d2a2dcbc72ea0bb1cd1"; inputs.apropos-tx.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; + inputs.apropos.url = + "github:jhodgdev/apropos?rev=c6c580aeab8b5c2a6512a49823dd17936e87b70a"; + outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }: let supportedSystems = with nixpkgs.lib.systems.supported; @@ -55,6 +58,10 @@ src = inputs.apropos-tx; subdirs = [ "." ]; } + { + src = inputs.apropos; + subdirs = [ "." ]; + } ]; modules = [ (plutarch.haskellModule system) ]; shell = { @@ -85,6 +92,7 @@ ps.plutarch-extra ps.plutarch-numeric ps.plutarch-test + ps.apropos ]; }; }; From 24e4f74399749ad7bf7d9565ca4d2fb4b2ad5a0d Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Mon, 28 Mar 2022 14:37:04 +0100 Subject: [PATCH 15/31] Added disclaimer wrt apropos branch --- flake.nix | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/flake.nix b/flake.nix index 5bb313e..e0fa78b 100644 --- a/flake.nix +++ b/flake.nix @@ -11,15 +11,19 @@ inputs.plutarch.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; - # https://github.com/mlabs-haskell/apropos-tx/pull/28 + # Follows jhodgdev's forks of apropos and apropos-tx, as these + # are not constrained to `base ^>= 4.14`. Once these are merged + # to their respective master branches, we should change the + # inputs to follow a commit on those master branches. For more + # info, see: https://github.com/mlabs-haskell/apropos-tx/pull/37 inputs.apropos-tx.url = "github:jhodgdev/apropos-tx?rev=582496d0dfb88ce007bb0d2a2dcbc72ea0bb1cd1"; inputs.apropos-tx.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; - inputs.apropos.url = "github:jhodgdev/apropos?rev=c6c580aeab8b5c2a6512a49823dd17936e87b70a"; + outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }: let supportedSystems = with nixpkgs.lib.systems.supported; From 522051657c0d38988871ac0e6890cc54c35c8643 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 28 Mar 2022 18:01:27 +0200 Subject: [PATCH 16/31] apply docs suggestions --- agora.cabal | 1 + agora/Agora/Governor.hs | 14 +++++++++----- agora/Agora/Proposal.hs | 12 ++++++------ agora/Agora/Stake.hs | 2 +- 4 files changed, 17 insertions(+), 12 deletions(-) diff --git a/agora.cabal b/agora.cabal index c41b6af..3afdca4 100644 --- a/agora.cabal +++ b/agora.cabal @@ -96,6 +96,7 @@ common deps , generics-sop , plutarch , plutarch-extra + , plutarch-numeric , plutus-core , plutus-ledger-api , plutus-tx diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 55b480e..33584e1 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -5,7 +5,7 @@ Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. -} -module Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) where +module Agora.Governor (GovernorDatum (..), GovernorRedeemer (..), Governor (..)) where import Agora.Proposal (ProposalThresholds) @@ -15,11 +15,11 @@ newtype GovernorDatum = GovernorDatum -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. } -{- | Redeemer for Governor script. +{- | Redeemer for Governor script. The governor has two primary + responsibilities: - The governor has two primary responsibilities: - - The gating of Proposal creation - - The gating of minting authority tokens + 1. The gating of Proposal creation. + 2. The gating of minting authority tokens. -} data GovernorRedeemer = -- | Checks that a proposal was created lawfully, and allows it. @@ -27,3 +27,7 @@ data GovernorRedeemer | -- | Checks that a SINGLE proposal finished correctly, -- and allows minting GATs for each effect script. MintGATs + +-- | Parameters for creating Governor scripts. +data Governor + = Governor diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 0584b99..ddad144 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -88,12 +88,12 @@ data ProposalStatus PlutusTx.makeIsDataIndexed ''ProposalStatus [('Draft, 0), ('VotingReady, 1), ('Finished, 2)] {- | The threshold values for various state transitions to happen. - This data is stored centrally (in the Governor) and copied over - to Proposals when they are created. + This data is stored centrally (in the 'Agora.Governor.Governor') and copied over + to 'Proposal's when they are created. -} data ProposalThresholds = ProposalThresholds { execute :: Discrete GTTag - -- ^ How much GT minimum must a particular 'ResultTag' accumulate to fulfil. + -- ^ How much GT minimum must a particular 'ResultTag' accumulate for it to pass. , draft :: Discrete GTTag -- ^ How much GT required to "create" a proposal. , vote :: Discrete GTTag @@ -110,7 +110,7 @@ PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)] @[('ResultTag' 0, []), ('ResultTag' 1, [(vh, dh)])]@ - Then 'ProposalVotes' need be of the shape: + Then 'ProposalVotes' needs be of the shape: @[('ResultTag' 0, n), ('ResultTag' 1, m)]@ -} @@ -125,11 +125,11 @@ data ProposalDatum = ProposalDatum -- This is shaped this way for future proofing. -- See https://github.com/Liqwid-Labs/agora/issues/39 effects :: [(ResultTag, [(ValidatorHash, DatumHash)])] - -- ^ Effect lookup table. First by result, then by + -- ^ Effect lookup table. First by result, then by effect hash. , status :: ProposalStatus -- ^ The status the proposal is in. , cosigners :: [PubKeyHash] - -- ^ Who created the proposal initially + who cosigned. + -- ^ Who created the proposal initially, and who cosigned it later. , thresholds :: ProposalThresholds -- ^ Thresholds copied over on initialization. , votes :: ProposalVotes diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 8d3296e..67184bf 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -83,7 +83,7 @@ import Agora.Utils ( -- | Parameters for creating Stake scripts. newtype Stake = Stake { gtClassRef :: AssetClassRef GTTag - -- ^ Resolve governance token + -- ^ Used when inlining the AssetClass of a 'PDiscrete' in the script code. } -- | Plutarch-level redeemer for Stake scripts. From 097e055f199717c44299a48c9bfe6117b0bb183b Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 30 Mar 2022 15:32:50 +0200 Subject: [PATCH 17/31] use plutarch-safemoney instead of local Agora.SafeMoney --- agora-test/Spec/Sample/Stake.hs | 13 ++-- agora.cabal | 1 + agora/Agora/Proposal.hs | 9 ++- agora/Agora/SafeMoney.hs | 125 ++------------------------------ agora/Agora/Stake.hs | 78 ++++++++++---------- flake.lock | 14 ++-- flake.nix | 14 +++- 7 files changed, 75 insertions(+), 179 deletions(-) diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index 85b95ac..e0ed848 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -51,8 +51,9 @@ import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- -import Agora.SafeMoney +import Agora.SafeMoney (GTTag) import Agora.Stake +import Plutarch.SafeMoney import Spec.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- @@ -62,7 +63,7 @@ stake :: Stake stake = Stake { gtClassRef = - AssetClassRef + Tagged ( AssetClass ( "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" , "LQ" @@ -143,9 +144,9 @@ stakeCreationUnsigned = -- | Config for creating a ScriptContext that deposits or withdraws. data DepositWithdrawExample = DepositWithdrawExample - { startAmount :: Discrete GTTag + { startAmount :: Tagged GTTag Integer -- ^ The amount of GT stored before the transaction. - , delta :: Discrete GTTag + , delta :: Tagged GTTag Integer -- ^ The amount of GT deposited or withdrawn from the Stake. } @@ -168,7 +169,7 @@ stakeDepositWithdraw config = { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing , txOutValue = st - <> discreteValue stake.gtClassRef stakeBefore.stakedAmount + <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount) , txOutDatumHash = Just (toDatumHash stakeAfter) } ] @@ -177,7 +178,7 @@ stakeDepositWithdraw config = { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing , txOutValue = st - <> discreteValue stake.gtClassRef stakeAfter.stakedAmount + <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount) , txOutDatumHash = Just (toDatumHash stakeAfter) } ] diff --git a/agora.cabal b/agora.cabal index 3afdca4..046a5c8 100644 --- a/agora.cabal +++ b/agora.cabal @@ -97,6 +97,7 @@ common deps , plutarch , plutarch-extra , plutarch-numeric + , plutarch-safemoney , plutus-core , plutus-ledger-api , plutus-tx diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index ddad144..a5dbbd9 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -38,7 +38,8 @@ import PlutusTx qualified -------------------------------------------------------------------------------- -import Agora.SafeMoney (Discrete, GTTag, PDiscrete) +import Agora.SafeMoney (GTTag) +import Plutarch.SafeMoney (PDiscrete, Tagged) -------------------------------------------------------------------------------- -- Haskell-land @@ -92,11 +93,11 @@ PlutusTx.makeIsDataIndexed ''ProposalStatus [('Draft, 0), ('VotingReady, 1), ('F to 'Proposal's when they are created. -} data ProposalThresholds = ProposalThresholds - { execute :: Discrete GTTag + { execute :: Tagged GTTag Integer -- ^ How much GT minimum must a particular 'ResultTag' accumulate for it to pass. - , draft :: Discrete GTTag + , draft :: Tagged GTTag Integer -- ^ How much GT required to "create" a proposal. - , vote :: Discrete GTTag + , vote :: Tagged GTTag Integer -- ^ How much GT required to allow voting to happen. -- (i.e. to move into 'VotingReady') } diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index d8c3da0..8791ff9 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -1,51 +1,21 @@ {- | Module : Agora.SafeMoney Maintainer : emi@haskell.fyi -Description: Phantom-type protected types for handling money in Plutus. +Description: Tags and bonuses for Plutarch.SafeMoney. -Phantom-type protected types for handling money in Plutus. +Tags and bonuses for "Plutarch.SafeMoney". -} module Agora.SafeMoney ( - -- * Types - PDiscrete (..), - Discrete (..), - - -- * Tags and refs - AssetClassRef (..), ADATag, GTTag, adaRef, - - -- * Utility functions - paddDiscrete, - pgeqDiscrete, - pzeroDiscrete, - - -- * Conversions - pdiscreteValue, - pvalueDiscrete, - discreteValue, ) where -import Prelude - -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Value (AssetClass (AssetClass), Value) -import Plutus.V1.Ledger.Value qualified as Value -import PlutusTx qualified +import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -import Plutarch.Api.V1 (PValue) -import Plutarch.Builtin () -import Plutarch.Internal () -import Plutarch.Monadic qualified as P - --------------------------------------------------------------------------------- - -import Agora.Utils ( - passetClassValueOf', - psingletonValue, - ) +import Plutarch.SafeMoney -------------------------------------------------------------------------------- -- Example tags @@ -58,89 +28,6 @@ data ADATag -------------------------------------------------------------------------------- --- | A tagged AssetClass. Use to resolve a reference inside of a PDiscrete -newtype AssetClassRef (tag :: Type) = AssetClassRef {getAssetClass :: AssetClass} - -- | Resolves ada tags. -adaRef :: AssetClassRef ADATag -adaRef = AssetClassRef (AssetClass ("", "")) - --- TODO: Currently it's possible to transmute from one discrete to another. --- How do we prevent this? --- --- @ --- transmute :: forall (a :: Type) (b :: Type). Discrete a -> Discrete b --- transmute = Discrete . getDiscrete --- @ - -{- | Represents a single asset in a 'Plutus.V1.Ledger.Value.Value' related to a particular 'AssetClass' - through 'AssetClassRef'. --} -newtype Discrete (tag :: Type) = Discrete {getDiscrete :: Integer} - deriving stock (Show, Eq) - deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) - deriving newtype (Num) -- TODO: Use plutarch-numeric - -{- | Represents a single asset in a 'PValue' related to a particular 'AssetClass' - through 'AssetClassRef'. --} -newtype PDiscrete (tag :: Type) (s :: S) - = PDiscrete (Term s PInteger) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (PDiscrete tag) PInteger) - --- | Check if one 'PDiscrete' is greater than another. -pgeqDiscrete :: forall (tag :: Type) (s :: S). Term s (PDiscrete tag :--> PDiscrete tag :--> PBool) -pgeqDiscrete = phoistAcyclic $ - plam $ \x y -> P.do - PDiscrete x' <- pmatch x - PDiscrete y' <- pmatch y - y' #<= x' - --- | Returns a zero-value 'PDiscrete' unit for any tag. -pzeroDiscrete :: forall (tag :: Type) (s :: S). Term s (PDiscrete tag) -pzeroDiscrete = phoistAcyclic $ pcon (PDiscrete 0) - --- | Add two 'PDiscrete' values of the same tag. -paddDiscrete :: forall (tag :: Type) (s :: S). Term s (PDiscrete tag :--> PDiscrete tag :--> PDiscrete tag) -paddDiscrete = phoistAcyclic $ - -- In the future, this should use plutarch-numeric - plam $ \x y -> P.do - PDiscrete x' <- pmatch x - PDiscrete y' <- pmatch y - pcon (PDiscrete $ x' + y') - --------------------------------------------------------------------------------- - --- | Downcast a `PValue` to a `PDiscrete` unit. -pvalueDiscrete :: - forall (tag :: Type) (s :: S). - AssetClassRef tag -> - Term s (PValue :--> PDiscrete tag) -pvalueDiscrete (AssetClassRef ac) = phoistAcyclic $ - plam $ \f -> - pcon . PDiscrete $ passetClassValueOf' ac # f - -{- | Get a `PValue` from a `PDiscrete`. - __NOTE__: `pdiscreteValue` after `pvalueDiscrete` is not a round-trip. - It filters for a particular tag. --} -pdiscreteValue :: - forall (tag :: Type) (s :: S). - AssetClassRef tag -> - Term s (PDiscrete tag :--> PValue) -pdiscreteValue (AssetClassRef (AssetClass (cs, tn))) = phoistAcyclic $ - plam $ \f -> pmatch f $ \case - PDiscrete p -> - psingletonValue - # pconstant cs - # pconstant tn - # p - --- | Get a `Value` from a `Discrete`. -discreteValue :: - forall (tag :: Type). - AssetClassRef tag -> - Discrete tag -> - Value -discreteValue (AssetClassRef (AssetClass (cs, tn))) (Discrete v) = - Value.singleton cs tn v +adaRef :: Tagged ADATag AssetClass +adaRef = Tagged (AssetClass ("", "")) diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 67184bf..ff362e0 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -22,7 +22,7 @@ module Agora.Stake ( import GHC.Generics qualified as GHC import Generics.SOP (Generic, I (I)) -import Prelude +import Prelude hiding (Num (..)) -------------------------------------------------------------------------------- @@ -52,16 +52,7 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -------------------------------------------------------------------------------- -import Agora.SafeMoney ( - AssetClassRef (..), - Discrete, - GTTag, - PDiscrete, - paddDiscrete, - pdiscreteValue, - pgeqDiscrete, - pzeroDiscrete, - ) +import Agora.SafeMoney (GTTag) import Agora.Utils ( anyInput, anyOutput, @@ -77,38 +68,41 @@ import Agora.Utils ( ptxSignedBy, pvalueSpent, ) +import Plutarch.Numeric +import Plutarch.SafeMoney ( + PDiscrete, + Tagged (..), + pdiscreteValue, + untag, + ) -------------------------------------------------------------------------------- -- | Parameters for creating Stake scripts. newtype Stake = Stake - { gtClassRef :: AssetClassRef GTTag + { gtClassRef :: Tagged GTTag AssetClass -- ^ Used when inlining the AssetClass of a 'PDiscrete' in the script code. } --- | Plutarch-level redeemer for Stake scripts. -data PStakeRedeemer (s :: S) - = -- | Deposit or withdraw a discrete amount of the staked governance token. - PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag])) - | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. - PDestroy (Term s (PDataRecord '[])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances PStakeRedeemer - -- | Haskell-level redeemer for Stake scripts. data StakeRedeemer = -- | Deposit or withdraw a discrete amount of the staked governance token. - DepositWithdraw (Discrete GTTag) + DepositWithdraw (Tagged GTTag Integer) | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. Destroy deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''StakeRedeemer [('DepositWithdraw, 0), ('Destroy, 1)] +-- | Haskell-level datum for Stake scripts. +data StakeDatum = StakeDatum + { stakedAmount :: Tagged GTTag Integer + , owner :: PubKeyHash + } + deriving stock (Show, GHC.Generic) + +PlutusTx.makeIsDataIndexed ''StakeDatum [('StakeDatum, 0)] + -- | Plutarch-level datum for Stake scripts. newtype PStakeDatum (s :: S) = PStakeDatum { getStakeDatum :: @@ -121,14 +115,18 @@ newtype PStakeDatum (s :: S) = PStakeDatum (PlutusType, PIsData, PDataFields) via (PIsDataReprInstances PStakeDatum) --- | Haskell-level datum for Stake scripts. -data StakeDatum = StakeDatum - { stakedAmount :: Discrete GTTag - , owner :: PubKeyHash - } - deriving stock (Show, GHC.Generic) - -PlutusTx.makeIsDataIndexed ''StakeDatum [('StakeDatum, 0)] +-- | Plutarch-level redeemer for Stake scripts. +data PStakeRedeemer (s :: S) + = -- | Deposit or withdraw a discrete amount of the staked governance token. + PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag])) + | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. + PDestroy (Term s (PDataRecord '[])) + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData) + via PIsDataReprInstances PStakeRedeemer -------------------------------------------------------------------------------- {- What this Policy does @@ -223,7 +221,7 @@ stakePolicy stake = foldr1 (#&&) [ pgeqByClass' (AssetClass ("", "")) # value # expectedValue - , pgeqByClass' stake.gtClassRef.getAssetClass + , pgeqByClass' (untag stake.gtClassRef) # value # expectedValue , pgeqByClass @@ -300,15 +298,15 @@ stakeValidator stake = foldr1 (#&&) [ stakeDatum.owner #== newStakeDatum.owner - , (paddDiscrete # stakeDatum.stakedAmount # delta) #== newStakeDatum.stakedAmount + , (stakeDatum.stakedAmount + delta) #== newStakeDatum.stakedAmount , -- We can't magically conjure GT anyway (no input to spend!) -- do we need to check this, really? - pgeqDiscrete # (pfromData newStakeDatum.stakedAmount) # pzeroDiscrete + zero #<= pfromData newStakeDatum.stakedAmount ] let expectedValue = paddValue # continuingValue # (pdiscreteValue stake.gtClassRef # delta) - ptrace (pshow $ passetClassValueOf' stake.gtClassRef.getAssetClass # value) - ptrace (pshow $ passetClassValueOf' stake.gtClassRef.getAssetClass # expectedValue) + ptrace (pshow $ passetClassValueOf' (untag stake.gtClassRef) # value) + ptrace (pshow $ passetClassValueOf' (untag stake.gtClassRef) # expectedValue) -- TODO: Same as above. This is quite inefficient now, as it does two lookups -- instead of a more efficient single pass, @@ -317,7 +315,7 @@ stakeValidator stake = foldr1 (#&&) [ pgeqByClass' (AssetClass ("", "")) # value # expectedValue - , pgeqByClass' stake.gtClassRef.getAssetClass + , pgeqByClass' (untag stake.gtClassRef) # value # expectedValue , pgeqBySymbol diff --git a/flake.lock b/flake.lock index 89b8ae5..3f6d571 100644 --- a/flake.lock +++ b/flake.lock @@ -1381,11 +1381,11 @@ }, "nixpkgs-2111_3": { "locked": { - "lastModified": 1648420413, - "narHash": "sha256-AHejj7EsbTt+CMOoy15wwkFsFNmx8oinGgDZR22lS6g=", + "lastModified": 1648608655, + "narHash": "sha256-pTjZg9DwU89ZZ1fdtt6/i1X4vSNXoRJYUArgVZPh9F8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "d6778e0b5d608eb6738af2a64e26d99cdc5b9e86", + "rev": "ba93b1d8253ed4b359b9e81d10e02c106d3f8b11", "type": "github" }, "original": { @@ -1621,17 +1621,17 @@ "validity": "validity" }, "locked": { - "lastModified": 1648163186, - "narHash": "sha256-UfaSb4nk9HWzsj1Kb8RJuPV+iw1Nl4E2+97KOwIwcao=", + "lastModified": 1648639396, + "narHash": "sha256-pAkEsIDXJckVYufVPUzD/4sq4/uE7iyV0IR2BuLhZjY=", "owner": "peter-mlabs", "repo": "plutarch", - "rev": "0638dbd706bc2c5f48f9f40be7bbe1986a778698", + "rev": "a7a410da209b9c14c834a41e07b1c197c2a4dcd6", "type": "github" }, "original": { "owner": "peter-mlabs", - "ref": "liqwid/extra", "repo": "plutarch", + "rev": "a7a410da209b9c14c834a41e07b1c197c2a4dcd6", "type": "github" } }, diff --git a/flake.nix b/flake.nix index b944b18..abedaff 100644 --- a/flake.nix +++ b/flake.nix @@ -7,7 +7,9 @@ # see https://github.com/NixOS/nix/issues/6013 inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; - inputs.plutarch.url = "github:peter-mlabs/plutarch/liqwid/extra"; + # Rev is this PR https://github.com/peter-mlabs/plutarch/pull/5. + inputs.plutarch.url = + "github:peter-mlabs/plutarch?rev=a7a410da209b9c14c834a41e07b1c197c2a4dcd6"; inputs.plutarch.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; @@ -56,8 +58,13 @@ extraSources = plutarch.extraSources ++ [ { src = inputs.plutarch; - subdirs = - [ "." "plutarch-test" "plutarch-extra" "plutarch-numeric" ]; + subdirs = [ + "." + "plutarch-test" + "plutarch-extra" + "plutarch-numeric" + "plutarch-safemoney" + ]; } { src = inputs.apropos-tx; @@ -96,6 +103,7 @@ ps.apropos-tx ps.plutarch-extra ps.plutarch-numeric + ps.plutarch-safemoney ps.plutarch-test ps.apropos ]; From b0eb044bf229156d302aeab4d1747ff79b93822f Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Thu, 31 Mar 2022 16:48:59 +0200 Subject: [PATCH 18/31] lock field in Stake datum, `singleAuthorityTokenBurned` helper --- agora-test/Spec/Sample/Stake.hs | 6 +-- agora-test/Spec/Stake.hs | 6 +-- agora/Agora/AuthorityToken.hs | 32 ++++++++++++++- agora/Agora/Effect.hs | 25 +++++++++--- agora/Agora/Proposal.hs | 18 +++++++++ agora/Agora/Stake.hs | 70 +++++++++++++++++++++++++++++++-- agora/Agora/Treasury.hs | 16 +++----- 7 files changed, 146 insertions(+), 27 deletions(-) diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index e0ed848..08bd0e1 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -95,7 +95,7 @@ stakeCreation :: ScriptContext stakeCreation = let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST datum :: Datum - datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer) + datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer []) in ScriptContext { scriptContextTxInfo = TxInfo @@ -123,7 +123,7 @@ stakeCreation = stakeCreationWrongDatum :: ScriptContext stakeCreationWrongDatum = let datum :: Datum - datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer) -- Too much GT + datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer []) -- Too much GT in ScriptContext { scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]} , scriptContextPurpose = Minting policySymbol @@ -155,7 +155,7 @@ stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext stakeDepositWithdraw config = let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST stakeBefore :: StakeDatum - stakeBefore = StakeDatum config.startAmount signer + stakeBefore = StakeDatum config.startAmount signer [] stakeAfter :: StakeDatum stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta} diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index ccd16e7..8f2538d 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -52,19 +52,19 @@ tests = , validatorSucceedsWith "stakeDepositWithdraw deposit" (stakeValidator Stake.stake) - (toDatum $ StakeDatum 100_000 signer) + (toDatum $ StakeDatum 100_000 signer []) (toDatum $ DepositWithdraw 100_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000}) , validatorSucceedsWith "stakeDepositWithdraw withdraw" (stakeValidator Stake.stake) - (toDatum $ StakeDatum 100_000 signer) + (toDatum $ StakeDatum 100_000 signer []) (toDatum $ DepositWithdraw $ negate 100_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000}) , validatorFailsWith "stakeDepositWithdraw negative GT" (stakeValidator Stake.stake) - (toDatum $ StakeDatum 100_000 signer) + (toDatum $ StakeDatum 100_000 signer []) (toDatum $ DepositWithdraw 1_000_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000}) ] diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 4050348..dadabe4 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -8,6 +8,7 @@ Tokens acting as redeemable proofs of DAO authority. module Agora.AuthorityToken ( authorityTokenPolicy, authorityTokensValidIn, + singleAuthorityTokenBurned, AuthorityToken (..), ) where @@ -32,7 +33,15 @@ import Prelude -------------------------------------------------------------------------------- -import Agora.Utils (allOutputs, passert, passetClassValueOf, passetClassValueOf', plookup) +import Agora.Utils ( + allInputs, + allOutputs, + passert, + passetClassValueOf, + passetClassValueOf', + plookup, + psymbolValueOf, + ) -------------------------------------------------------------------------------- @@ -85,6 +94,27 @@ authorityTokensValidIn = phoistAcyclic $ -- No GATs exist at this output! pconstant True +-- | Assert that a single authority token has been burned. +singleAuthorityTokenBurned :: + forall (s :: S). + Term s PCurrencySymbol -> + Term s (PAsData PTxInfo) -> + Term s PValue -> + Term s PBool +singleAuthorityTokenBurned gatCs txInfo mint = P.do + let gatAmountMinted :: Term _ PInteger + gatAmountMinted = psymbolValueOf # gatCs # mint + + foldr1 + (#&&) + [ ptraceIfFalse "GAT not burned." $ gatAmountMinted #== -1 + , ptraceIfFalse "All inputs only have valid GATs" $ + allInputs @PUnit # pfromData txInfo #$ plam $ \txOut _value _address _datum -> + authorityTokensValidIn + # gatCs + # txOut + ] + -- | Policy given 'AuthorityToken' params. authorityTokenPolicy :: AuthorityToken -> diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index 82764d2..69ddc1c 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -7,19 +7,28 @@ Helpers for constructing effects. -} module Agora.Effect (makeEffect) where -import Plutarch.Api.V1 (PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator) +import Agora.AuthorityToken (singleAuthorityTokenBurned) +import Agora.Utils (passert) +import Plutarch.Api.V1 (PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue) import Plutarch.Internal (punsafeCoerce) import Plutarch.Monadic qualified as P +import Plutus.V1.Ledger.Value (CurrencySymbol) -------------------------------------------------------------------------------- --- | Helper "template" for creating effect validator. +{- | Helper "template" for creating effect validator. + + In some situations, it may be the case that we need more control over how + an effect is implemented. In such situations, it's okay to not use this + helper. +-} makeEffect :: forall (datum :: PType) (s :: S). PIsData datum => - (Term s datum -> Term s PTxOutRef -> Term s PTxInfo -> Term s POpaque) -> + CurrencySymbol -> + (Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) -> Term s PValidator -makeEffect f = +makeEffect gatCs' f = plam $ \datum _redeemer ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet ctx.txInfo @@ -30,7 +39,13 @@ makeEffect f = PSpending txOutRef <- pmatch $ pfromData ctx.purpose txOutRef' <- plet (pfield @"_0" # txOutRef) - -- TODO: Here, check that a *single* GAT is burned. + txInfo <- pletFields @'["mint"] txInfo' + let mint :: Term s PValue + mint = txInfo.mint + + gatCs <- plet $ pconstant gatCs' + + passert "singleAuthorityTokenBurned" $ singleAuthorityTokenBurned gatCs txInfo' mint f datum' txOutRef' txInfo' diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index a5dbbd9..f063b6d 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -14,10 +14,15 @@ module Agora.Proposal ( ProposalStatus (..), ProposalThresholds (..), ProposalVotes (..), + ProposalTag (..), ResultTag (..), -- * Plutarch-land PProposalDatum (..), + PProposalStatus (..), + PProposalThresholds (..), + PProposalVotes (..), + PProposalTag (..), PResultTag (..), ) where @@ -85,6 +90,7 @@ data ProposalStatus -- -- TODO: The owner of the proposal may choose to reclaim their proposal. Finished + deriving stock (Eq, Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''ProposalStatus [('Draft, 0), ('VotingReady, 1), ('Finished, 2)] @@ -101,6 +107,7 @@ data ProposalThresholds = ProposalThresholds -- ^ How much GT required to allow voting to happen. -- (i.e. to move into 'VotingReady') } + deriving stock (Eq, Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)] @@ -119,6 +126,7 @@ newtype ProposalVotes = ProposalVotes { getProposalVotes :: [(ResultTag, Integer)] } deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving stock (Eq, Show, GHC.Generic) -- | Haskell-level datum for Proposal scripts. data ProposalDatum = ProposalDatum @@ -136,9 +144,15 @@ data ProposalDatum = ProposalDatum , votes :: ProposalVotes -- ^ Vote tally on the proposal } + deriving stock (Eq, Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''ProposalDatum [('ProposalDatum, 0)] +-- | Identifies a Proposal, issued upon creation of a proposal. +newtype ProposalTag = ProposalTag {proposalTag :: Integer} + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving stock (Eq, Show, GHC.Generic) + -- | Parameters that identify the Proposal validator script. data Proposal = Proposal @@ -149,6 +163,10 @@ data Proposal = Proposal newtype PResultTag (s :: S) = PResultTag (Term s PInteger) deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PResultTag PInteger) +-- | Plutarch-level version of 'PProposalTag'. +newtype PProposalTag (s :: S) = PProposalTag (Term s PInteger) + deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalTag PInteger) + -- | Plutarch-level version of 'ProposalStatus'. data PProposalStatus (s :: S) = -- TODO: 'PProposalStatus' ought te be encoded as 'PInteger'. diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index ff362e0..814b2f2 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -12,6 +12,8 @@ module Agora.Stake ( PStakeRedeemer (..), StakeDatum (..), StakeRedeemer (..), + ProposalLock (..), + PProposalLock (..), Stake (..), stakePolicy, stakeValidator, @@ -43,15 +45,18 @@ import Plutarch.Api.V1 ( mkMintingPolicy, ) import Plutarch.DataRepr ( + DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Internal (punsafeCoerce) +import Plutarch.Lift (PUnsafeLiftDecl (..)) import Plutarch.Monadic qualified as P import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -------------------------------------------------------------------------------- +import Agora.Proposal (PProposalTag, PResultTag, ProposalTag (..), ResultTag (..)) import Agora.SafeMoney (GTTag) import Agora.Utils ( anyInput, @@ -94,19 +99,48 @@ data StakeRedeemer PlutusTx.makeIsDataIndexed ''StakeRedeemer [('DepositWithdraw, 0), ('Destroy, 1)] +data ProposalLock = ProposalLock + { vote :: ResultTag + -- ^ What was voted on. This allows retracting votes to + -- undo their vote. + , proposalTag :: ProposalTag + -- ^ Identifies the proposal. + } + deriving stock (Show, GHC.Generic) + +PlutusTx.makeIsDataIndexed ''ProposalLock [('ProposalLock, 0)] + -- | Haskell-level datum for Stake scripts. data StakeDatum = StakeDatum { stakedAmount :: Tagged GTTag Integer + -- ^ Tracks the amount of governance token staked in the datum. + -- This also acts as the voting weight for 'Proposal's. , owner :: PubKeyHash + -- ^ The hash of the public key this stake belongs to. + -- + -- TODO Support for MultiSig/Scripts is tracked here: + -- https://github.com/Liqwid-Labs/agora/issues/45 + , lockedBy :: [ProposalLock] + -- ^ The proposal locks in place. This field must be empty + -- for the stake to be usable for deposits and withdrawals. } deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''StakeDatum [('StakeDatum, 0)] +-------------------------------------------------------------------------------- + -- | Plutarch-level datum for Stake scripts. newtype PStakeDatum (s :: S) = PStakeDatum { getStakeDatum :: - Term s (PDataRecord '["stakedAmount" ':= PDiscrete GTTag, "owner" ':= PPubKeyHash]) + Term + s + ( PDataRecord + '[ "stakedAmount" ':= PDiscrete GTTag + , "owner" ':= PPubKeyHash + , "lockedBy" ':= PBuiltinList (PAsData PProposalLock) + ] + ) } deriving stock (GHC.Generic) deriving anyclass (Generic) @@ -115,6 +149,9 @@ newtype PStakeDatum (s :: S) = PStakeDatum (PlutusType, PIsData, PDataFields) via (PIsDataReprInstances PStakeDatum) +instance PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum +deriving via (DerivePConstantViaData StakeDatum PStakeDatum) instance (PConstant StakeDatum) + -- | Plutarch-level redeemer for Stake scripts. data PStakeRedeemer (s :: S) = -- | Deposit or withdraw a discrete amount of the staked governance token. @@ -128,6 +165,29 @@ data PStakeRedeemer (s :: S) (PlutusType, PIsData) via PIsDataReprInstances PStakeRedeemer +instance PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer +deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (PConstant StakeRedeemer) + +newtype PProposalLock (s :: S) = PProposalLock + { getProposalLock :: + Term + s + ( PDataRecord + '[ "vote" ':= PResultTag + , "proposalTag" ':= PProposalTag + ] + ) + } + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields) + via (PIsDataReprInstances PProposalLock) + +instance PUnsafeLiftDecl PProposalLock where type PLifted PProposalLock = ProposalLock +deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (PConstant ProposalLock) + -------------------------------------------------------------------------------- {- What this Policy does @@ -338,6 +398,8 @@ stakeValidator stake = -- | Check whether a Stake is locked. If it is locked, various actions are unavailable. stakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool) stakeLocked = phoistAcyclic $ - plam $ \_stakeDatum -> - -- TODO: when we extend this to support proposals, this will need to do something - pcon PFalse + plam $ \stakeDatum -> + let locks :: Term _ (PBuiltinList (PAsData PProposalLock)) + locks = pfield @"lockedBy" # stakeDatum + in -- 'pnotNull' ? + pelimList (\_ _ -> pcon PTrue) (pcon PFalse) locks diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index ff4ab36..df11f65 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -21,8 +21,8 @@ import Plutus.V1.Ledger.Value (CurrencySymbol) -------------------------------------------------------------------------------- -import Agora.AuthorityToken (authorityTokensValidIn) -import Agora.Utils (allInputs, passert, psymbolValueOf) +import Agora.AuthorityToken (singleAuthorityTokenBurned) +import Agora.Utils (passert) {- | Validator ensuring that transactions consuming the treasury do so in a valid manner. @@ -37,7 +37,7 @@ treasuryV :: :--> PAsData PScriptContext :--> PUnit ) -treasuryV cs = plam $ \_d r ctx' -> P.do +treasuryV gatCs' = plam $ \_d r ctx' -> P.do -- plet required fields from script context. ctx <- pletFields @["txInfo", "purpose"] ctx' @@ -52,16 +52,10 @@ treasuryV cs = plam $ \_d r ctx' -> P.do txInfo <- pletFields @'["mint"] txInfo' let mint :: Term s PValue mint = txInfo.mint - gatAmountMinted :: Term s PInteger - gatAmountMinted = psymbolValueOf # pconstant cs # mint - passert "GAT not burned." $ gatAmountMinted #== -1 + gatCs <- plet $ pconstant gatCs' - passert "All inputs only have valid GATs" $ - allInputs @PUnit # pfromData ctx.txInfo #$ plam $ \txOut _value _address _datum -> - authorityTokensValidIn - # pconstant cs - # txOut + passert "singleAuthorityTokenBurned" $ singleAuthorityTokenBurned gatCs txInfo' mint pconstant () From 715b5d857586f15eb2f2262c5134c3d012bad740 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 1 Apr 2022 10:50:10 +0100 Subject: [PATCH 19/31] updated deps --- flake.lock | 434 ++++++++++++++++++++++++++++++++++++++++++++++++----- flake.nix | 10 +- 2 files changed, 404 insertions(+), 40 deletions(-) diff --git a/flake.lock b/flake.lock index a8f99c4..3a16dd7 100644 --- a/flake.lock +++ b/flake.lock @@ -32,6 +32,22 @@ "type": "github" } }, + "HTTP_3": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, "Shrinker": { "flake": false, "locked": { @@ -48,11 +64,37 @@ "type": "github" } }, - "apropos-tx": { + "apropos": { "inputs": { "flake-compat": "flake-compat", "flake-compat-ci": "flake-compat-ci", "haskell-nix": "haskell-nix", + "nixpkgs": [ + "apropos", + "haskell-nix", + "nixpkgs-unstable" + ] + }, + "locked": { + "lastModified": 1648746740, + "narHash": "sha256-C2gQrd5hFvQ+BsjAJs6V0iP9PRzd9dZMKtpk7kOjhwc=", + "owner": "mlabs-haskell", + "repo": "apropos", + "rev": "3734bb3baa297ed990725a5ef14efcbb6a1c1c23", + "type": "github" + }, + "original": { + "owner": "mlabs-haskell", + "repo": "apropos", + "rev": "3734bb3baa297ed990725a5ef14efcbb6a1c1c23", + "type": "github" + } + }, + "apropos-tx": { + "inputs": { + "flake-compat": "flake-compat_2", + "flake-compat-ci": "flake-compat-ci_2", + "haskell-nix": "haskell-nix_2", "nixpkgs": [ "plutarch", "haskell-nix", @@ -61,17 +103,17 @@ "plutus": "plutus" }, "locked": { - "lastModified": 1646436508, - "narHash": "sha256-4QevdgeSSHfOyJEqdiNx6SovGpLZv1vw9i6r0XbpQ3U=", - "owner": "mlabs-haskell", + "lastModified": 1648805998, + "narHash": "sha256-TWEiUifHkhgCHqe70aNn9j6LdFFWv2nMbSWV8hR59oE=", + "owner": "jhodgdev", "repo": "apropos-tx", - "rev": "5b74ba897a6f02718c163bf588a08c5e3e9de204", + "rev": "4eca3fac23c339caee04ea6176e641a4b3857a25", "type": "github" }, "original": { - "owner": "mlabs-haskell", + "owner": "jhodgdev", "repo": "apropos-tx", - "rev": "5b74ba897a6f02718c163bf588a08c5e3e9de204", + "rev": "4eca3fac23c339caee04ea6176e641a4b3857a25", "type": "github" } }, @@ -110,6 +152,23 @@ } }, "cabal-32_2": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", + "owner": "haskell", + "repo": "cabal", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-32_3": { "flake": false, "locked": { "lastModified": 1603716527, @@ -144,6 +203,23 @@ } }, "cabal-34_2": { + "flake": false, + "locked": { + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", + "owner": "haskell", + "repo": "cabal", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34_3": { "flake": false, "locked": { "lastModified": 1622475795, @@ -178,6 +254,23 @@ } }, "cabal-36_2": { + "flake": false, + "locked": { + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", + "owner": "haskell", + "repo": "cabal", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36_3": { "flake": false, "locked": { "lastModified": 1640163203, @@ -308,6 +401,22 @@ "type": "github" } }, + "cardano-shell_3": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, "cryptonite": { "flake": false, "locked": { @@ -371,6 +480,21 @@ "type": "github" } }, + "flake-compat-ci_3": { + "locked": { + "lastModified": 1641672839, + "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "type": "github" + } + }, "flake-compat_2": { "flake": false, "locked": { @@ -388,6 +512,22 @@ } }, "flake-compat_3": { + "flake": false, + "locked": { + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_4": { "flake": false, "locked": { "lastModified": 1606424373, @@ -404,7 +544,7 @@ "type": "github" } }, - "flake-compat_4": { + "flake-compat_5": { "flake": false, "locked": { "lastModified": 1606424373, @@ -436,6 +576,21 @@ } }, "flake-utils_2": { + "locked": { + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_3": { "locked": { "lastModified": 1623875721, "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", @@ -518,6 +673,23 @@ "type": "github" } }, + "ghc-8.6.5-iohk_3": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, "gitignore-nix": { "flake": false, "locked": { @@ -599,6 +771,22 @@ } }, "hackage_2": { + "flake": false, + "locked": { + "lastModified": 1646270198, + "narHash": "sha256-SakG546Zr9RuNPs5mhtT7CYPpvEDMGrWisWK/VpCvr0=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "4cf90b36955597d0151940eabfb1b61a8ec42256", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage_3": { "flake": false, "locked": { "lastModified": 1642554756, @@ -677,9 +865,9 @@ "hpc-coveralls": "hpc-coveralls", "nix-tools": "nix-tools", "nixpkgs": [ - "apropos-tx", + "apropos", "haskell-nix", - "nixpkgs-unstable" + "nixpkgs-2105" ], "nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2105": "nixpkgs-2105", @@ -703,7 +891,29 @@ } }, "haskell-nix_2": { - "flake": false, + "inputs": { + "HTTP": "HTTP_2", + "cabal-32": "cabal-32_2", + "cabal-34": "cabal-34_2", + "cabal-36": "cabal-36_2", + "cardano-shell": "cardano-shell_2", + "flake-utils": "flake-utils_2", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", + "hackage": "hackage_2", + "hpc-coveralls": "hpc-coveralls_2", + "nix-tools": "nix-tools_2", + "nixpkgs": [ + "apropos-tx", + "haskell-nix", + "nixpkgs-2105" + ], + "nixpkgs-2003": "nixpkgs-2003_2", + "nixpkgs-2105": "nixpkgs-2105_2", + "nixpkgs-2111": "nixpkgs-2111_2", + "nixpkgs-unstable": "nixpkgs-unstable_2", + "old-ghc-nix": "old-ghc-nix_2", + "stackage": "stackage_2" + }, "locked": { "lastModified": 1646278384, "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", @@ -719,28 +929,44 @@ } }, "haskell-nix_3": { + "flake": false, + "locked": { + "lastModified": 1646278384, + "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_4": { "inputs": { - "HTTP": "HTTP_2", - "cabal-32": "cabal-32_2", - "cabal-34": "cabal-34_2", - "cabal-36": "cabal-36_2", - "cardano-shell": "cardano-shell_2", - "flake-utils": "flake-utils_2", - "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", - "hackage": "hackage_2", - "hpc-coveralls": "hpc-coveralls_2", - "nix-tools": "nix-tools_2", + "HTTP": "HTTP_3", + "cabal-32": "cabal-32_3", + "cabal-34": "cabal-34_3", + "cabal-36": "cabal-36_3", + "cardano-shell": "cardano-shell_3", + "flake-utils": "flake-utils_3", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", + "hackage": "hackage_3", + "hpc-coveralls": "hpc-coveralls_3", + "nix-tools": "nix-tools_3", "nixpkgs": [ "plutarch", "haskell-nix", "nixpkgs-2111" ], - "nixpkgs-2003": "nixpkgs-2003_2", - "nixpkgs-2105": "nixpkgs-2105_2", - "nixpkgs-2111": "nixpkgs-2111_3", - "nixpkgs-unstable": "nixpkgs-unstable_2", - "old-ghc-nix": "old-ghc-nix_2", - "stackage": "stackage_2" + "nixpkgs-2003": "nixpkgs-2003_3", + "nixpkgs-2105": "nixpkgs-2105_3", + "nixpkgs-2111": "nixpkgs-2111_4", + "nixpkgs-unstable": "nixpkgs-unstable_3", + "old-ghc-nix": "old-ghc-nix_3", + "stackage": "stackage_3" }, "locked": { "lastModified": 1642811877, @@ -757,7 +983,7 @@ "type": "github" } }, - "haskell-nix_4": { + "haskell-nix_5": { "flake": false, "locked": { "lastModified": 1629380841, @@ -775,7 +1001,7 @@ }, "hercules-ci-agent": { "inputs": { - "flake-compat": "flake-compat_4", + "flake-compat": "flake-compat_5", "nix-darwin": "nix-darwin", "nixos-20_09": "nixos-20_09", "nixos-unstable": "nixos-unstable", @@ -798,7 +1024,7 @@ }, "hercules-ci-effects": { "inputs": { - "flake-compat": "flake-compat_3", + "flake-compat": "flake-compat_4", "hercules-ci-agent": "hercules-ci-agent", "nixpkgs": "nixpkgs_3", "nixpkgs-nixops": "nixpkgs-nixops" @@ -849,6 +1075,22 @@ "type": "github" } }, + "hpc-coveralls_3": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, "hs-memory": { "flake": false, "locked": { @@ -949,6 +1191,22 @@ } }, "nix-tools_2": { + "flake": false, + "locked": { + "lastModified": 1644395812, + "narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, + "nix-tools_3": { "flake": false, "locked": { "lastModified": 1636018067, @@ -1045,6 +1303,22 @@ "type": "github" } }, + "nixpkgs-2003_3": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2105": { "locked": { "lastModified": 1642244250, @@ -1062,6 +1336,22 @@ } }, "nixpkgs-2105_2": { + "locked": { + "lastModified": 1642244250, + "narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105_3": { "locked": { "lastModified": 1640283157, "narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=", @@ -1094,6 +1384,22 @@ } }, "nixpkgs-2111_2": { + "locked": { + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_3": { "locked": { "lastModified": 1647902355, "narHash": "sha256-SySJ8IRaogpc/BPOkysA+kzq9URvXthoeKIemaTKCiM=", @@ -1109,7 +1415,7 @@ "type": "github" } }, - "nixpkgs-2111_3": { + "nixpkgs-2111_4": { "locked": { "lastModified": 1640283207, "narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=", @@ -1125,7 +1431,7 @@ "type": "github" } }, - "nixpkgs-2111_4": { + "nixpkgs-2111_5": { "locked": { "lastModified": 1644510859, "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", @@ -1174,6 +1480,22 @@ } }, "nixpkgs-unstable_2": { + "locked": { + "lastModified": 1644486793, + "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable_3": { "locked": { "lastModified": 1641285291, "narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=", @@ -1270,6 +1592,23 @@ "type": "github" } }, + "old-ghc-nix_3": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, "plutarch": { "inputs": { "Shrinker": "Shrinker", @@ -1278,12 +1617,12 @@ "cardano-crypto": "cardano-crypto", "cardano-prelude": "cardano-prelude", "cryptonite": "cryptonite", - "flake-compat": "flake-compat_2", - "flake-compat-ci": "flake-compat-ci_2", + "flake-compat": "flake-compat_3", + "flake-compat-ci": "flake-compat-ci_3", "flat": "flat", "foundation": "foundation", "haskell-language-server": "haskell-language-server_2", - "haskell-nix": "haskell-nix_3", + "haskell-nix": "haskell-nix_4", "hercules-ci-effects": "hercules-ci-effects", "hs-memory": "hs-memory", "iohk-nix": "iohk-nix_2", @@ -1292,7 +1631,7 @@ "haskell-nix", "nixpkgs-unstable" ], - "nixpkgs-2111": "nixpkgs-2111_4", + "nixpkgs-2111": "nixpkgs-2111_5", "plutus": "plutus_2", "protolude": "protolude", "safe-coloured-text": "safe-coloured-text", @@ -1322,7 +1661,7 @@ "gitignore-nix": "gitignore-nix", "hackage-nix": "hackage-nix", "haskell-language-server": "haskell-language-server", - "haskell-nix": "haskell-nix_2", + "haskell-nix": "haskell-nix_3", "iohk-nix": "iohk-nix", "nixpkgs": "nixpkgs", "pre-commit-hooks-nix": "pre-commit-hooks-nix", @@ -1349,7 +1688,7 @@ "gitignore-nix": "gitignore-nix_2", "hackage-nix": "hackage-nix_2", "haskell-language-server": "haskell-language-server_3", - "haskell-nix": "haskell-nix_4", + "haskell-nix": "haskell-nix_5", "iohk-nix": "iohk-nix_3", "nixpkgs": "nixpkgs_4", "pre-commit-hooks-nix": "pre-commit-hooks-nix_3", @@ -1438,6 +1777,7 @@ }, "root": { "inputs": { + "apropos": "apropos", "apropos-tx": "apropos-tx", "haskell-nix": [ "plutarch", @@ -1447,7 +1787,7 @@ "plutarch", "nixpkgs" ], - "nixpkgs-2111": "nixpkgs-2111_2", + "nixpkgs-2111": "nixpkgs-2111_3", "plutarch": "plutarch" } }, @@ -1566,6 +1906,22 @@ } }, "stackage_2": { + "flake": false, + "locked": { + "lastModified": 1646270328, + "narHash": "sha256-WFzBTbZW9zKnZtHLBLGui9F1tBDKX7ixBtaQOG5SK/M=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "b3171527569b52b3924d8e70e0aed753d3f55cc4", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage_3": { "flake": false, "locked": { "lastModified": 1642468901, diff --git a/flake.nix b/flake.nix index e49426e..b8e728c 100644 --- a/flake.nix +++ b/flake.nix @@ -13,10 +13,13 @@ # https://github.com/mlabs-haskell/apropos-tx/pull/28 inputs.apropos-tx.url = - "github:mlabs-haskell/apropos-tx?rev=5b74ba897a6f02718c163bf588a08c5e3e9de204"; + "github:jhodgdev/apropos-tx?rev=4eca3fac23c339caee04ea6176e641a4b3857a25"; inputs.apropos-tx.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; + inputs.apropos.url = + "github:mlabs-haskell/apropos?rev=3734bb3baa297ed990725a5ef14efcbb6a1c1c23"; + outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }: let supportedSystems = with nixpkgs.lib.systems.supported; @@ -55,6 +58,10 @@ src = inputs.apropos-tx; subdirs = [ "." ]; } + { + src = inputs.apropos; + subdirs = [ "." ]; + } ]; modules = [ (plutarch.haskellModule system) ]; shell = { @@ -82,6 +89,7 @@ ps.plutarch ps.tasty-quickcheck ps.apropos-tx + ps.apropos ps.plutarch-extra ps.plutarch-numeric ps.plutarch-test From e2cfc60c08e3cb23956447f5f889992a63c3faa0 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 1 Apr 2022 10:59:52 +0100 Subject: [PATCH 20/31] Fixed problems --- flake.lock | 1976 ++++++++++++++++++++++++++++++++++++++++++++++++++++ flake.nix | 4 +- 2 files changed, 1977 insertions(+), 3 deletions(-) create mode 100644 flake.lock diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..039aca4 --- /dev/null +++ b/flake.lock @@ -0,0 +1,1976 @@ +{ + "nodes": { + "HTTP": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, + "HTTP_2": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, + "HTTP_3": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, + "Shrinker": { + "flake": false, + "locked": { + "lastModified": 1642430208, + "narHash": "sha256-tfWyB7zCLzncwRpyl7eUOzuOBbg9KLu6sxSxRaFlOug=", + "owner": "Plutonomicon", + "repo": "Shrinker", + "rev": "0e60707996b876c7bd23a348f54545217ce2e556", + "type": "github" + }, + "original": { + "owner": "Plutonomicon", + "repo": "Shrinker", + "type": "github" + } + }, + "apropos": { + "inputs": { + "flake-compat": "flake-compat", + "flake-compat-ci": "flake-compat-ci", + "haskell-nix": "haskell-nix", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-unstable" + ] + }, + "locked": { + "lastModified": 1648746740, + "narHash": "sha256-C2gQrd5hFvQ+BsjAJs6V0iP9PRzd9dZMKtpk7kOjhwc=", + "owner": "mlabs-haskell", + "repo": "apropos", + "rev": "3734bb3baa297ed990725a5ef14efcbb6a1c1c23", + "type": "github" + }, + "original": { + "owner": "mlabs-haskell", + "repo": "apropos", + "rev": "3734bb3baa297ed990725a5ef14efcbb6a1c1c23", + "type": "github" + } + }, + "apropos-tx": { + "inputs": { + "flake-compat": "flake-compat_2", + "flake-compat-ci": "flake-compat-ci_2", + "haskell-nix": "haskell-nix_2", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-unstable" + ], + "plutus": "plutus" + }, + "locked": { + "lastModified": 1648805998, + "narHash": "sha256-TWEiUifHkhgCHqe70aNn9j6LdFFWv2nMbSWV8hR59oE=", + "owner": "jhodgdev", + "repo": "apropos-tx", + "rev": "4eca3fac23c339caee04ea6176e641a4b3857a25", + "type": "github" + }, + "original": { + "owner": "jhodgdev", + "repo": "apropos-tx", + "rev": "4eca3fac23c339caee04ea6176e641a4b3857a25", + "type": "github" + } + }, + "autodocodec": { + "flake": false, + "locked": { + "lastModified": 1644358110, + "narHash": "sha256-X1TNZlmO2qDFk3OL4Z1v/gzvd3ouoACAiMweutsYek4=", + "owner": "srid", + "repo": "autodocodec", + "rev": "42b42a7407f33c6c74fa4e8c84906aebfed28daf", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "autodocodec", + "type": "github" + } + }, + "cabal-32": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", + "owner": "haskell", + "repo": "cabal", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-32_2": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=", + "owner": "haskell", + "repo": "cabal", + "rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-32_3": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=", + "owner": "haskell", + "repo": "cabal", + "rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34": { + "flake": false, + "locked": { + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", + "owner": "haskell", + "repo": "cabal", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34_2": { + "flake": false, + "locked": { + "lastModified": 1622475795, + "narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=", + "owner": "haskell", + "repo": "cabal", + "rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34_3": { + "flake": false, + "locked": { + "lastModified": 1622475795, + "narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=", + "owner": "haskell", + "repo": "cabal", + "rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36": { + "flake": false, + "locked": { + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", + "owner": "haskell", + "repo": "cabal", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36_2": { + "flake": false, + "locked": { + "lastModified": 1640163203, + "narHash": "sha256-TwDWP2CffT0j40W6zr0J1Qbu+oh3nsF1lUx9446qxZM=", + "owner": "haskell", + "repo": "cabal", + "rev": "ecf418050c1821f25e2e218f1be94c31e0465df1", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cardano-base": { + "flake": false, + "locked": { + "lastModified": 1638456794, + "narHash": "sha256-0KAO6dWqupJzRyjWjAFLZrt0hA6pozeKsDv1Fnysib8=", + "owner": "input-output-hk", + "repo": "cardano-base", + "rev": "4fae3f0149fd8925be94707d3ae0e36c0d67bd58", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-base", + "type": "github" + } + }, + "cardano-crypto": { + "flake": false, + "locked": { + "lastModified": 1621376239, + "narHash": "sha256-oxIOVlgm07FAEmgGRF1C2me9TXqVxQulEOcJ22zpTRs=", + "owner": "input-output-hk", + "repo": "cardano-crypto", + "rev": "07397f0e50da97eaa0575d93bee7ac4b2b2576ec", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-crypto", + "rev": "07397f0e50da97eaa0575d93bee7ac4b2b2576ec", + "type": "github" + } + }, + "cardano-prelude": { + "flake": false, + "locked": { + "lastModified": 1641566029, + "narHash": "sha256-CylaHhO4zbZ1dEAv8yWp1swP1xys/s2Sbxg3a2pdnCI=", + "owner": "locallycompact", + "repo": "cardano-prelude", + "rev": "93f95047bb36a055bdd56fb0cafd887c072cdce2", + "type": "github" + }, + "original": { + "owner": "locallycompact", + "repo": "cardano-prelude", + "rev": "93f95047bb36a055bdd56fb0cafd887c072cdce2", + "type": "github" + } + }, + "cardano-repo-tool": { + "flake": false, + "locked": { + "lastModified": 1624584417, + "narHash": "sha256-YSepT97PagR/1jTYV/Yer8a2GjFe9+tTwaTCHxuK50M=", + "owner": "input-output-hk", + "repo": "cardano-repo-tool", + "rev": "30e826ed8f00e3e154453b122a6f3d779b2f73ec", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-repo-tool", + "type": "github" + } + }, + "cardano-repo-tool_2": { + "flake": false, + "locked": { + "lastModified": 1624584417, + "narHash": "sha256-YSepT97PagR/1jTYV/Yer8a2GjFe9+tTwaTCHxuK50M=", + "owner": "input-output-hk", + "repo": "cardano-repo-tool", + "rev": "30e826ed8f00e3e154453b122a6f3d779b2f73ec", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-repo-tool", + "type": "github" + } + }, + "cardano-shell": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, + "cardano-shell_2": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, + "cardano-shell_3": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, + "cryptonite": { + "flake": false, + "locked": { + "lastModified": 1639749289, + "narHash": "sha256-/KS2S0f9r4c/q+IUGwkFOY9jbZkyK3dl0xMpDbULeqc=", + "owner": "haskell-crypto", + "repo": "cryptonite", + "rev": "cec291d988f0f17828384f3358214ab9bf724a13", + "type": "github" + }, + "original": { + "owner": "haskell-crypto", + "repo": "cryptonite", + "rev": "cec291d988f0f17828384f3358214ab9bf724a13", + "type": "github" + } + }, + "flake-compat": { + "flake": false, + "locked": { + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat-ci": { + "locked": { + "lastModified": 1641672839, + "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "type": "github" + } + }, + "flake-compat-ci_2": { + "locked": { + "lastModified": 1641672839, + "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "type": "github" + } + }, + "flake-compat-ci_3": { + "locked": { + "lastModified": 1641672839, + "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "type": "github" + } + }, + "flake-compat_2": { + "flake": false, + "locked": { + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_3": { + "flake": false, + "locked": { + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_4": { + "flake": false, + "locked": { + "lastModified": 1606424373, + "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf", + "type": "github" + }, + "original": { + "owner": "edolstra", + "ref": "master", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_5": { + "flake": false, + "locked": { + "lastModified": 1606424373, + "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-utils": { + "locked": { + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_2": { + "locked": { + "lastModified": 1623875721, + "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_3": { + "locked": { + "lastModified": 1623875721, + "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flat": { + "flake": false, + "locked": { + "lastModified": 1641898475, + "narHash": "sha256-D7jJ4t0T1ZvXbO61r3HQj77hZ5hWF/P1L8X9+MnfD6c=", + "owner": "Quid2", + "repo": "flat", + "rev": "41a040c413351e021982bb78bd00f750628f8060", + "type": "github" + }, + "original": { + "owner": "Quid2", + "repo": "flat", + "rev": "41a040c413351e021982bb78bd00f750628f8060", + "type": "github" + } + }, + "foundation": { + "flake": false, + "locked": { + "lastModified": 1635711016, + "narHash": "sha256-5TRuljpwt50DLjyFjiFj6quFncu8RT0d8/0jlzsenuc=", + "owner": "haskell-foundation", + "repo": "foundation", + "rev": "0bb195e1fea06d144dafc5af9a0ff79af0a5f4a0", + "type": "github" + }, + "original": { + "owner": "haskell-foundation", + "repo": "foundation", + "rev": "0bb195e1fea06d144dafc5af9a0ff79af0a5f4a0", + "type": "github" + } + }, + "ghc-8.6.5-iohk": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, + "ghc-8.6.5-iohk_2": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, + "ghc-8.6.5-iohk_3": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, + "gitignore-nix": { + "flake": false, + "locked": { + "lastModified": 1611672876, + "narHash": "sha256-qHu3uZ/o9jBHiA3MEKHJ06k7w4heOhA+4HCSIvflRxo=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "211907489e9f198594c0eb0ca9256a1949c9d412", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "gitignore.nix", + "type": "github" + } + }, + "gitignore-nix_2": { + "flake": false, + "locked": { + "lastModified": 1611672876, + "narHash": "sha256-qHu3uZ/o9jBHiA3MEKHJ06k7w4heOhA+4HCSIvflRxo=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "211907489e9f198594c0eb0ca9256a1949c9d412", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "gitignore.nix", + "type": "github" + } + }, + "hackage": { + "flake": false, + "locked": { + "lastModified": 1646270198, + "narHash": "sha256-SakG546Zr9RuNPs5mhtT7CYPpvEDMGrWisWK/VpCvr0=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "4cf90b36955597d0151940eabfb1b61a8ec42256", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage-nix": { + "flake": false, + "locked": { + "lastModified": 1637291070, + "narHash": "sha256-hTX2Xo36i9MR6PNwA/89C8daKjxmx5ZS5lwR2Cbp8Yo=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "6ea4ad5f4a5e2303cd64974329ba90ccc410a012", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage-nix_2": { + "flake": false, + "locked": { + "lastModified": 1637291070, + "narHash": "sha256-hTX2Xo36i9MR6PNwA/89C8daKjxmx5ZS5lwR2Cbp8Yo=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "6ea4ad5f4a5e2303cd64974329ba90ccc410a012", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage_2": { + "flake": false, + "locked": { + "lastModified": 1639357972, + "narHash": "sha256-NvVn00YOYZMqDUSiBbghJk/rm/nJItBEUJulWRGTgvk=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "54adf6e47e20831d9c49a2b62e12f7f218fd7752", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage_3": { + "flake": false, + "locked": { + "lastModified": 1642554756, + "narHash": "sha256-1+SN+z80HgKYshlCf8dRxwRojQzuwwsQ5uq14N/JP1Y=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "f9d5e67ca90926b244c0ad68815371d37582a149", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "haskell-language-server": { + "flake": false, + "locked": { + "lastModified": 1638136578, + "narHash": "sha256-Reo9BQ12O+OX7tuRfaDPZPBpJW4jnxZetm63BxYncoM=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "745ef26f406dbdd5e4a538585f8519af9f1ccb09", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "1.5.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "haskell-language-server_2": { + "flake": false, + "locked": { + "lastModified": 1642772345, + "narHash": "sha256-fjdNOcd0S35OAvMZu81/im32B7hSIimjs08VKQA58Mw=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "f0bbc390b995953885506b755f4e4b5c6af618fb", + "type": "github" + }, + "original": { + "owner": "haskell", + "repo": "haskell-language-server", + "type": "github" + } + }, + "haskell-language-server_3": { + "flake": false, + "locked": { + "lastModified": 1643835246, + "narHash": "sha256-5LQHcQmi3mUGRgJu+X/m3jeM3kdkYjLD+KwgnxBlbeU=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "024ddc8b3904f8b8e8fe67ba6b9ebd8a4bd7ce76", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "1.6.1.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "haskell-nix": { + "inputs": { + "HTTP": "HTTP", + "cabal-32": "cabal-32", + "cabal-34": "cabal-34", + "cabal-36": "cabal-36", + "cardano-shell": "cardano-shell", + "flake-utils": "flake-utils", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", + "hackage": "hackage", + "hpc-coveralls": "hpc-coveralls", + "nix-tools": "nix-tools", + "nixpkgs": [ + "apropos", + "haskell-nix", + "nixpkgs-2105" + ], + "nixpkgs-2003": "nixpkgs-2003", + "nixpkgs-2105": "nixpkgs-2105", + "nixpkgs-2111": "nixpkgs-2111", + "nixpkgs-unstable": "nixpkgs-unstable", + "old-ghc-nix": "old-ghc-nix", + "stackage": "stackage" + }, + "locked": { + "lastModified": 1646278384, + "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_2": { + "inputs": { + "HTTP": "HTTP_2", + "cabal-32": "cabal-32_2", + "cabal-34": "cabal-34_2", + "cardano-shell": "cardano-shell_2", + "flake-utils": "flake-utils_2", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", + "hackage": "hackage_2", + "hpc-coveralls": "hpc-coveralls_2", + "nix-tools": "nix-tools_2", + "nixpkgs": [ + "apropos-tx", + "haskell-nix", + "nixpkgs-2105" + ], + "nixpkgs-2003": "nixpkgs-2003_2", + "nixpkgs-2105": "nixpkgs-2105_2", + "nixpkgs-2111": "nixpkgs-2111_2", + "nixpkgs-unstable": "nixpkgs-unstable_2", + "old-ghc-nix": "old-ghc-nix_2", + "stackage": "stackage_2" + }, + "locked": { + "lastModified": 1639371915, + "narHash": "sha256-i5kW3hPptzXwzkpI2FAkfdDA/9QEDl/9mrwwoeBxDJg=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "e95a1f0dacbc64603c31d11e36e4ba1af8f0eb43", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_3": { + "flake": false, + "locked": { + "lastModified": 1629380841, + "narHash": "sha256-gWOWCfX7IgVSvMMYN6rBGK6EA0pk6pmYguXzMvGte+Q=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "7215f083b37741446aa325b20c8ba9f9f76015eb", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_4": { + "inputs": { + "HTTP": "HTTP_3", + "cabal-32": "cabal-32_3", + "cabal-34": "cabal-34_3", + "cabal-36": "cabal-36_2", + "cardano-shell": "cardano-shell_3", + "flake-utils": "flake-utils_3", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", + "hackage": "hackage_3", + "hpc-coveralls": "hpc-coveralls_3", + "nix-tools": "nix-tools_3", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-2111" + ], + "nixpkgs-2003": "nixpkgs-2003_3", + "nixpkgs-2105": "nixpkgs-2105_3", + "nixpkgs-2111": "nixpkgs-2111_4", + "nixpkgs-unstable": "nixpkgs-unstable_3", + "old-ghc-nix": "old-ghc-nix_3", + "stackage": "stackage_3" + }, + "locked": { + "lastModified": 1642811877, + "narHash": "sha256-7YbbFF4ISWMcs5hHDfH7GkCSccvwEwhvKZ5D74Cuajo=", + "owner": "L-as", + "repo": "haskell.nix", + "rev": "ac825b91c202947ec59b1a477003564cc018fcec", + "type": "github" + }, + "original": { + "owner": "L-as", + "ref": "master", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_5": { + "flake": false, + "locked": { + "lastModified": 1629380841, + "narHash": "sha256-gWOWCfX7IgVSvMMYN6rBGK6EA0pk6pmYguXzMvGte+Q=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "7215f083b37741446aa325b20c8ba9f9f76015eb", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "hercules-ci-agent": { + "inputs": { + "flake-compat": "flake-compat_5", + "nix-darwin": "nix-darwin", + "nixos-20_09": "nixos-20_09", + "nixos-unstable": "nixos-unstable", + "pre-commit-hooks-nix": "pre-commit-hooks-nix_2" + }, + "locked": { + "lastModified": 1642766877, + "narHash": "sha256-EXvI+1cKZHWfAaRV1PrSrQe0knc4rg5vMF4qz6/5bkI=", + "owner": "hercules-ci", + "repo": "hercules-ci-agent", + "rev": "0aa916f487be7da03bc2a6dec2ac7149b05499c5", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "ref": "master", + "repo": "hercules-ci-agent", + "type": "github" + } + }, + "hercules-ci-effects": { + "inputs": { + "flake-compat": "flake-compat_4", + "hercules-ci-agent": "hercules-ci-agent", + "nixpkgs": "nixpkgs_3", + "nixpkgs-nixops": "nixpkgs-nixops" + }, + "locked": { + "lastModified": 1641914281, + "narHash": "sha256-3qJ6tDPkrsFqm4E74JROZlQbnKKLNTHV7QOD1LdcVqs=", + "owner": "hercules-ci", + "repo": "hercules-ci-effects", + "rev": "2e165352d92782e7ae149f4f1a9b3174f718a3af", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "hercules-ci-effects", + "type": "github" + } + }, + "hpc-coveralls": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, + "hpc-coveralls_2": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, + "hpc-coveralls_3": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, + "hs-memory": { + "flake": false, + "locked": { + "lastModified": 1636757734, + "narHash": "sha256-DIlt0NpFUx8IUeTcgZNBJWWfyNaKv5ZKYw1K9aLvxBs=", + "owner": "vincenthz", + "repo": "hs-memory", + "rev": "3cf661a8a9a8ac028df77daa88e8d65c55a3347a", + "type": "github" + }, + "original": { + "owner": "vincenthz", + "repo": "hs-memory", + "rev": "3cf661a8a9a8ac028df77daa88e8d65c55a3347a", + "type": "github" + } + }, + "iohk-nix": { + "flake": false, + "locked": { + "lastModified": 1626953580, + "narHash": "sha256-iEI9aTOaZMGsjWzcrctrC0usmiagwKT2v1LSDe9/tMU=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "cbd497f5844249ef8fe617166337d59f2a6ebe90", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "iohk-nix", + "type": "github" + } + }, + "iohk-nix_2": { + "flake": false, + "locked": { + "lastModified": 1648032999, + "narHash": "sha256-3uCz+gJppvM7z6CUCkBbFSu60WgIE+e3oXwXiAiGWSY=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "5e667b374153327c7bdfdbfab8ef19b1f27d4aac", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "iohk-nix", + "type": "github" + } + }, + "iohk-nix_3": { + "flake": false, + "locked": { + "lastModified": 1626953580, + "narHash": "sha256-iEI9aTOaZMGsjWzcrctrC0usmiagwKT2v1LSDe9/tMU=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "cbd497f5844249ef8fe617166337d59f2a6ebe90", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "iohk-nix", + "type": "github" + } + }, + "nix-darwin": { + "inputs": { + "nixpkgs": "nixpkgs_2" + }, + "locked": { + "lastModified": 1622060422, + "narHash": "sha256-hPVlvrAyf6zL7tTx0lpK+tMxEfZeMiIZ/A2xaJ41WOY=", + "owner": "LnL7", + "repo": "nix-darwin", + "rev": "007d700e644ac588ad6668e6439950a5b6e2ff64", + "type": "github" + }, + "original": { + "owner": "LnL7", + "repo": "nix-darwin", + "type": "github" + } + }, + "nix-tools": { + "flake": false, + "locked": { + "lastModified": 1644395812, + "narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, + "nix-tools_2": { + "flake": false, + "locked": { + "lastModified": 1636018067, + "narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, + "nix-tools_3": { + "flake": false, + "locked": { + "lastModified": 1636018067, + "narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, + "nixos-20_09": { + "locked": { + "lastModified": 1623585158, + "narHash": "sha256-AjK7M1/six8IBPOI28nm7yC2k8mZIR2F9QrOwFYHAS0=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "115dbbe82eb4ec8aabf959068286468a68e0b244", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-20.09", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixos-unstable": { + "locked": { + "lastModified": 1630248577, + "narHash": "sha256-9d/yq96TTrnF7qjA6wPYk+rYjWAXwfUmwk3qewezSeg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "8d8a28b47b7c41aeb4ad01a2bd8b7d26986c3512", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs": { + "flake": false, + "locked": { + "lastModified": 1628785280, + "narHash": "sha256-2B5eMrEr6O8ff2aQNeVxTB+9WrGE80OB4+oM6T7fOcc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6525bbc06a39f26750ad8ee0d40000ddfdc24acb", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2003": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2003_2": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2003_3": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105": { + "locked": { + "lastModified": 1642244250, + "narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105_2": { + "locked": { + "lastModified": 1639202042, + "narHash": "sha256-xEMgCsIcDUQ0kw9xvqU0wObns580kpdcr1ACz83+gHs=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "499ca2a9f6463ce119e40361f4329afa921a1d13", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105_3": { + "locked": { + "lastModified": 1640283157, + "narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "dde1557825c5644c869c5efc7448dc03722a8f09", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111": { + "locked": { + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_2": { + "locked": { + "lastModified": 1639213685, + "narHash": "sha256-Evuobw7o9uVjAZuwz06Al0fOWZ5JMKOktgXR0XgWBtg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "453bcb8380fd1777348245b3c44ce2a2b93b2e2d", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_3": { + "locked": { + "lastModified": 1648744337, + "narHash": "sha256-bYe1dFJAXovjqiaPKrmAbSBEK5KUkgwVaZcTbSoJ7hg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0a58eebd8ec65ffdef2ce9562784123a73922052", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_4": { + "locked": { + "lastModified": 1640283207, + "narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "64c7e3388bbd9206e437713351e814366e0c3284", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_5": { + "locked": { + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-nixops": { + "locked": { + "lastModified": 1630248577, + "narHash": "sha256-9d/yq96TTrnF7qjA6wPYk+rYjWAXwfUmwk3qewezSeg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "8d8a28b47b7c41aeb4ad01a2bd8b7d26986c3512", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "8d8a28b47b7c41aeb4ad01a2bd8b7d26986c3512", + "type": "github" + } + }, + "nixpkgs-unstable": { + "locked": { + "lastModified": 1644486793, + "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable_2": { + "locked": { + "lastModified": 1639239143, + "narHash": "sha256-9fFMUs6m3/4ZMflSqRgO4iEkBtFBnDyLWa3AB2tOvfs=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "e6df26a654b7fdd59a068c57001eab5736b1363c", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable_3": { + "locked": { + "lastModified": 1641285291, + "narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "0432195a4b8d68faaa7d3d4b355260a3120aeeae", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1602411953, + "narHash": "sha256-gbupmxRpoQZqL5NBQCJN2GI5G7XDEHHHYKhVwEj5+Ps=", + "owner": "LnL7", + "repo": "nixpkgs", + "rev": "f780534ea2d0c12e62607ff254b6b45f46653f7a", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1633463774, + "narHash": "sha256-y3GjapcRzd42NgebQ4sx5GFJ53dYqNdF3UQu7/t6mUg=", + "owner": "hercules-ci", + "repo": "nixpkgs", + "rev": "c70f908fd1f129aede2744d4385fae57d2e252b1", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "ref": "init-nixops-hercules-ci", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_4": { + "flake": false, + "locked": { + "lastModified": 1628785280, + "narHash": "sha256-2B5eMrEr6O8ff2aQNeVxTB+9WrGE80OB4+oM6T7fOcc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6525bbc06a39f26750ad8ee0d40000ddfdc24acb", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "old-ghc-nix": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, + "old-ghc-nix_2": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, + "old-ghc-nix_3": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, + "plutarch": { + "inputs": { + "Shrinker": "Shrinker", + "autodocodec": "autodocodec", + "cardano-base": "cardano-base", + "cardano-crypto": "cardano-crypto", + "cardano-prelude": "cardano-prelude", + "cryptonite": "cryptonite", + "flake-compat": "flake-compat_3", + "flake-compat-ci": "flake-compat-ci_3", + "flat": "flat", + "foundation": "foundation", + "haskell-language-server": "haskell-language-server_2", + "haskell-nix": "haskell-nix_4", + "hercules-ci-effects": "hercules-ci-effects", + "hs-memory": "hs-memory", + "iohk-nix": "iohk-nix_2", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-unstable" + ], + "nixpkgs-2111": "nixpkgs-2111_5", + "plutus": "plutus_2", + "protolude": "protolude", + "safe-coloured-text": "safe-coloured-text", + "sized-functors": "sized-functors", + "sydtest": "sydtest", + "th-extras": "th-extras", + "validity": "validity" + }, + "locked": { + "lastModified": 1648578429, + "narHash": "sha256-nEB6ujvX5aSpSk1EJ7/tAxW2lxB/eWXzJmyj7qyInpQ=", + "owner": "peter-mlabs", + "repo": "plutarch", + "rev": "b4e71dc0f685d0d0c325eabbaac8c5b3352bfcf8", + "type": "github" + }, + "original": { + "owner": "peter-mlabs", + "ref": "liqwid/extra", + "repo": "plutarch", + "type": "github" + } + }, + "plutus": { + "inputs": { + "cardano-repo-tool": "cardano-repo-tool", + "gitignore-nix": "gitignore-nix", + "hackage-nix": "hackage-nix", + "haskell-language-server": "haskell-language-server", + "haskell-nix": "haskell-nix_3", + "iohk-nix": "iohk-nix", + "nixpkgs": "nixpkgs", + "pre-commit-hooks-nix": "pre-commit-hooks-nix", + "sphinxcontrib-haddock": "sphinxcontrib-haddock", + "stackage-nix": "stackage-nix" + }, + "locked": { + "lastModified": 1639153959, + "narHash": "sha256-tz8wEV5oO2yu2WFl3+wAPHedJJUP/NMFYgfcsbcyji4=", + "owner": "input-output-hk", + "repo": "plutus", + "rev": "da4f85cdd2a3a261ce540e8dc51d2a3c5fa89ed2", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "plutus", + "type": "github" + } + }, + "plutus_2": { + "inputs": { + "cardano-repo-tool": "cardano-repo-tool_2", + "gitignore-nix": "gitignore-nix_2", + "hackage-nix": "hackage-nix_2", + "haskell-language-server": "haskell-language-server_3", + "haskell-nix": "haskell-nix_5", + "iohk-nix": "iohk-nix_3", + "nixpkgs": "nixpkgs_4", + "pre-commit-hooks-nix": "pre-commit-hooks-nix_3", + "sphinxcontrib-haddock": "sphinxcontrib-haddock_2", + "stackage-nix": "stackage-nix_2" + }, + "locked": { + "lastModified": 1645203653, + "narHash": "sha256-HAi60mSkyMXzu1Wg3h6KdYZg+ufNMvX6obfcLo0ArL0=", + "owner": "L-as", + "repo": "plutus", + "rev": "5ec17953aae3ac9546f6d923201eb1dbb4e058bb", + "type": "github" + }, + "original": { + "owner": "L-as", + "ref": "ghc9", + "repo": "plutus", + "type": "github" + } + }, + "pre-commit-hooks-nix": { + "flake": false, + "locked": { + "lastModified": 1624971177, + "narHash": "sha256-Amf/nBj1E77RmbSSmV+hg6YOpR+rddCbbVgo5C7BS0I=", + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "rev": "397f0713d007250a2c7a745e555fa16c5dc8cadb", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "type": "github" + } + }, + "pre-commit-hooks-nix_2": { + "flake": false, + "locked": { + "lastModified": 1622650193, + "narHash": "sha256-qSzUpJDv04ajS9FXoCq6NjVF3qOt9IiGIiGh0P8amyw=", + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "rev": "0398f0649e0a741660ac5e8216760bae5cc78579", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "type": "github" + } + }, + "pre-commit-hooks-nix_3": { + "flake": false, + "locked": { + "lastModified": 1624971177, + "narHash": "sha256-Amf/nBj1E77RmbSSmV+hg6YOpR+rddCbbVgo5C7BS0I=", + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "rev": "397f0713d007250a2c7a745e555fa16c5dc8cadb", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "type": "github" + } + }, + "protolude": { + "flake": false, + "locked": { + "lastModified": 1637276813, + "narHash": "sha256-/mgR1Vyp1WYBjdkbwQycrf6lcmOgUFcYUZIMhVgYhdo=", + "owner": "protolude", + "repo": "protolude", + "rev": "d821ef0ac7552cfa2c3e7a7bdf29539f57e3fae6", + "type": "github" + }, + "original": { + "owner": "protolude", + "repo": "protolude", + "rev": "d821ef0ac7552cfa2c3e7a7bdf29539f57e3fae6", + "type": "github" + } + }, + "root": { + "inputs": { + "apropos": "apropos", + "apropos-tx": "apropos-tx", + "haskell-nix": [ + "plutarch", + "haskell-nix" + ], + "nixpkgs": [ + "plutarch", + "nixpkgs" + ], + "nixpkgs-2111": "nixpkgs-2111_3", + "plutarch": "plutarch" + } + }, + "safe-coloured-text": { + "flake": false, + "locked": { + "lastModified": 1644357337, + "narHash": "sha256-sXSKw8m6O9K/H2BBiYqO5e4sJIo+9UP+UvEukRn28d8=", + "owner": "srid", + "repo": "safe-coloured-text", + "rev": "034f3612525568b422e0c62b52417d77b7cf31c2", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "safe-coloured-text", + "type": "github" + } + }, + "sized-functors": { + "flake": false, + "locked": { + "lastModified": 1620614934, + "narHash": "sha256-pVJbEGF4/lvXmWIypwkMQBYygOx3TQwLJbMpfdYovdY=", + "owner": "JonasDuregard", + "repo": "sized-functors", + "rev": "fe6bf78a1b97ff7429630d0e8974c9bc40945dcf", + "type": "github" + }, + "original": { + "owner": "JonasDuregard", + "repo": "sized-functors", + "rev": "fe6bf78a1b97ff7429630d0e8974c9bc40945dcf", + "type": "github" + } + }, + "sphinxcontrib-haddock": { + "flake": false, + "locked": { + "lastModified": 1594136664, + "narHash": "sha256-O9YT3iCUBHP3CEF88VDLLCO2HSP3HqkNA2q2939RnVY=", + "owner": "michaelpj", + "repo": "sphinxcontrib-haddock", + "rev": "f3956b3256962b2d27d5a4e96edb7951acf5de34", + "type": "github" + }, + "original": { + "owner": "michaelpj", + "repo": "sphinxcontrib-haddock", + "type": "github" + } + }, + "sphinxcontrib-haddock_2": { + "flake": false, + "locked": { + "lastModified": 1594136664, + "narHash": "sha256-O9YT3iCUBHP3CEF88VDLLCO2HSP3HqkNA2q2939RnVY=", + "owner": "michaelpj", + "repo": "sphinxcontrib-haddock", + "rev": "f3956b3256962b2d27d5a4e96edb7951acf5de34", + "type": "github" + }, + "original": { + "owner": "michaelpj", + "repo": "sphinxcontrib-haddock", + "type": "github" + } + }, + "stackage": { + "flake": false, + "locked": { + "lastModified": 1646270328, + "narHash": "sha256-WFzBTbZW9zKnZtHLBLGui9F1tBDKX7ixBtaQOG5SK/M=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "b3171527569b52b3924d8e70e0aed753d3f55cc4", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage-nix": { + "flake": false, + "locked": { + "lastModified": 1597712578, + "narHash": "sha256-c/pcfZ6w5Yp//7oC0hErOGVVphBLc5vc4IZlWKZ/t6E=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "e32c8b06d56954865725514ce0d98d5d1867e43a", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage-nix_2": { + "flake": false, + "locked": { + "lastModified": 1597712578, + "narHash": "sha256-c/pcfZ6w5Yp//7oC0hErOGVVphBLc5vc4IZlWKZ/t6E=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "e32c8b06d56954865725514ce0d98d5d1867e43a", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage_2": { + "flake": false, + "locked": { + "lastModified": 1639185224, + "narHash": "sha256-ZBL0Lvqq8/Iwl8F5sT2N9J8+HTh0OY+09LkkUVtuUtY=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "14819f5c85a92e5fb6e322cc809c803fa6419bd4", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage_3": { + "flake": false, + "locked": { + "lastModified": 1642468901, + "narHash": "sha256-+Hu4m9i8v8Moey/C8fy8juyxB729JdsXz02cK8nJXLk=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "7544f8fd16bb92b7cf90cb51cb4ddc43173526de", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "sydtest": { + "flake": false, + "locked": { + "lastModified": 1645114028, + "narHash": "sha256-P6ZwwfFeN8fpi3fziz9yERTn7BfxdE/j/OofUu+4GdA=", + "owner": "srid", + "repo": "sydtest", + "rev": "9c6c7678f7aabe22e075aab810a6a2e304591d24", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "sydtest", + "type": "github" + } + }, + "th-extras": { + "flake": false, + "locked": { + "lastModified": 1641329261, + "narHash": "sha256-+K91xH/zew66ry0EAV5FaEIAHUZdJ3ngD9GzCJiUq7k=", + "owner": "mokus0", + "repo": "th-extras", + "rev": "787ed752c1e5d41b5903b74e171ed087de38bffa", + "type": "github" + }, + "original": { + "owner": "mokus0", + "repo": "th-extras", + "rev": "787ed752c1e5d41b5903b74e171ed087de38bffa", + "type": "github" + } + }, + "validity": { + "flake": false, + "locked": { + "lastModified": 1644358698, + "narHash": "sha256-dpMIu08qXMzy8Kilk/2VWpuwIsfqFtpg/3mkwt5pdjA=", + "owner": "srid", + "repo": "validity", + "rev": "f7982549b95d0ab727950dc876ca06b1862135ba", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "validity", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix index 0583055..73a36e2 100644 --- a/flake.nix +++ b/flake.nix @@ -21,12 +21,10 @@ inputs.apropos-tx.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; inputs.apropos.url = - "github:jhodgdev/apropos?rev=c6c580aeab8b5c2a6512a49823dd17936e87b70a"; + "github:mlabs-haskell/apropos?rev=3734bb3baa297ed990725a5ef14efcbb6a1c1c23"; inputs.apropos.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; - inputs.apropos.url = - "github:mlabs-haskell/apropos?rev=3734bb3baa297ed990725a5ef14efcbb6a1c1c23"; outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }: let From 4ef7c7866cae496ab3106c15bdaf9670e572669e Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 4 Apr 2022 13:11:01 +0200 Subject: [PATCH 21/31] add locks in datums, add documentation, ClosedTerm on scripts Also added more lifting instances --- agora/Agora/Effect.hs | 8 +-- agora/Agora/Proposal.hs | 55 +++++++++++++++++++- agora/Agora/Stake.hs | 109 ++++++++++++++++++++++++++++++---------- agora/Agora/Treasury.hs | 6 +-- agora/Agora/Utils.hs | 5 ++ 5 files changed, 147 insertions(+), 36 deletions(-) diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index 69ddc1c..a4e3782 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -23,11 +23,11 @@ import Plutus.V1.Ledger.Value (CurrencySymbol) helper. -} makeEffect :: - forall (datum :: PType) (s :: S). + forall (datum :: PType). PIsData datum => CurrencySymbol -> - (Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) -> - Term s PValidator + (forall (s :: S). Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) -> + ClosedTerm PValidator makeEffect gatCs' f = plam $ \datum _redeemer ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' @@ -40,7 +40,7 @@ makeEffect gatCs' f = txOutRef' <- plet (pfield @"_0" # txOutRef) txInfo <- pletFields @'["mint"] txInfo' - let mint :: Term s PValue + let mint :: Term _ PValue mint = txInfo.mint gatCs <- plet $ pconstant gatCs' diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index f063b6d..f8a9357 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -24,6 +24,10 @@ module Agora.Proposal ( PProposalVotes (..), PProposalTag (..), PResultTag (..), + + -- * Scripts + proposalValidator, + proposalPolicy, ) where import GHC.Generics qualified as GHC @@ -31,19 +35,25 @@ import Generics.SOP (Generic, I (I)) import Plutarch.Api.V1 ( PDatumHash, PMap, + PMintingPolicy, PPubKeyHash, + PValidator, PValidatorHash, ) import Plutarch.DataRepr ( + DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash) import PlutusTx qualified +import PlutusTx.AssocMap qualified as AssocMap -------------------------------------------------------------------------------- import Agora.SafeMoney (GTTag) +import Plutarch (popaque) +import Plutarch.Lift (DerivePConstantViaNewtype (..), PUnsafeLiftDecl (..)) import Plutarch.SafeMoney (PDiscrete, Tagged) -------------------------------------------------------------------------------- @@ -57,7 +67,7 @@ import Plutarch.SafeMoney (PDiscrete, Tagged) @ -} newtype ResultTag = ResultTag {getResultTag :: Integer} - deriving stock (Eq, Show) + deriving stock (Eq, Show, Ord) deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) {- | The "status" of the proposal. This is only useful for state transitions, @@ -123,7 +133,7 @@ PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)] @[('ResultTag' 0, n), ('ResultTag' 1, m)]@ -} newtype ProposalVotes = ProposalVotes - { getProposalVotes :: [(ResultTag, Integer)] + { getProposalVotes :: AssocMap.Map ResultTag Integer } deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) deriving stock (Eq, Show, GHC.Generic) @@ -163,10 +173,22 @@ data Proposal = Proposal newtype PResultTag (s :: S) = PResultTag (Term s PInteger) deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PResultTag PInteger) +instance PUnsafeLiftDecl PResultTag where type PLifted PResultTag = ResultTag +deriving via + (DerivePConstantViaNewtype ResultTag PResultTag PInteger) + instance + (PConstant ResultTag) + -- | Plutarch-level version of 'PProposalTag'. newtype PProposalTag (s :: S) = PProposalTag (Term s PInteger) deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalTag PInteger) +instance PUnsafeLiftDecl PProposalTag where type PLifted PProposalTag = ProposalTag +deriving via + (DerivePConstantViaNewtype ProposalTag PProposalTag PInteger) + instance + (PConstant ProposalTag) + -- | Plutarch-level version of 'ProposalStatus'. data PProposalStatus (s :: S) = -- TODO: 'PProposalStatus' ought te be encoded as 'PInteger'. @@ -181,6 +203,9 @@ data PProposalStatus (s :: S) (PlutusType, PIsData) via PIsDataReprInstances PProposalStatus +instance PUnsafeLiftDecl PProposalStatus where type PLifted PProposalStatus = ProposalStatus +deriving via (DerivePConstantViaData ProposalStatus PProposalStatus) instance (PConstant ProposalStatus) + -- | Plutarch-level version of 'ProposalThresholds'. newtype PProposalThresholds (s :: S) = PProposalThresholds { getProposalThresholds :: @@ -200,11 +225,20 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds (PlutusType, PIsData, PDataFields) via (PIsDataReprInstances PProposalThresholds) +instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds +deriving via (DerivePConstantViaData ProposalThresholds PProposalThresholds) instance (PConstant ProposalThresholds) + -- | Plutarch-level version of 'ProposalVotes'. newtype PProposalVotes (s :: S) = PProposalVotes (Term s (PMap PResultTag PInteger)) deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap PResultTag PInteger)) +instance PUnsafeLiftDecl PProposalVotes where type PLifted PProposalVotes = ProposalVotes +deriving via + (DerivePConstantViaNewtype ProposalVotes PProposalVotes (PMap PResultTag PInteger)) + instance + (PConstant ProposalVotes) + -- | Plutarch-level version of 'ProposalDatum'. newtype PProposalDatum (s :: S) = PProposalDatum { getProposalDatum :: @@ -225,3 +259,20 @@ newtype PProposalDatum (s :: S) = PProposalDatum deriving (PlutusType, PIsData, PDataFields) via (PIsDataReprInstances PProposalDatum) + +instance PUnsafeLiftDecl PProposalDatum where type PLifted PProposalDatum = ProposalDatum +deriving via (DerivePConstantViaData ProposalDatum PProposalDatum) instance (PConstant ProposalDatum) + +-------------------------------------------------------------------------------- + +-- | Policy for Proposals. +proposalPolicy :: Proposal -> ClosedTerm PMintingPolicy +proposalPolicy _ = + plam $ \_redeemer _ctx' -> P.do + popaque (pconstant ()) + +-- | Validator for Proposals. +proposalValidator :: Proposal -> ClosedTerm PValidator +proposalValidator _ = + plam $ \_datum _redeemer _ctx' -> P.do + popaque (pconstant ()) diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 814b2f2..7a90877 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -63,11 +63,11 @@ import Agora.Utils ( anyOutput, paddValue, passert, - passetClassValueOf', pfindTxInByTxOutRef, pgeqByClass, pgeqByClass', pgeqBySymbol, + pnotNull, psingletonValue, psymbolValueOf, ptxSignedBy, @@ -89,27 +89,72 @@ newtype Stake = Stake -- ^ Used when inlining the AssetClass of a 'PDiscrete' in the script code. } --- | Haskell-level redeemer for Stake scripts. -data StakeRedeemer - = -- | Deposit or withdraw a discrete amount of the staked governance token. - DepositWithdraw (Tagged GTTag Integer) - | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. - Destroy - deriving stock (Show, GHC.Generic) +{- | A lock placed on a Stake datum in order to prevent + depositing and withdrawing when votes are in place. -PlutusTx.makeIsDataIndexed ''StakeRedeemer [('DepositWithdraw, 0), ('Destroy, 1)] + NOTE: Due to retracting votes always being possible, + this lock will only lock with contention on the proposal. + FIXME: Contention on Proposals could create contention + on voting which in turn creates contention on stakers. + + Vaguely this is the dependency graph for this locking + interaction. Both the stake vaalidator and the proposal + validator are only able to check for eachother through + the datum belonging to the ST: + + @ + ┌─────────────────┐ ┌────────────────────┐ + │ Stake Validator ├─┐ │ Proposal Validator │ + └────────┬────────┘ │ └──────┬─────┬───────┘ + │ │ │ │ + │ ┌─┼────────┘ │ + ▼ │ │ ▼ + ┌──────────────┐ │ │ ┌─────────────────┐ + │ Stake Policy │◄─┘ └►│ Proposal Policy │ + └──────────────┘ └─────────────────┘ + @ +-} data ProposalLock = ProposalLock { vote :: ResultTag -- ^ What was voted on. This allows retracting votes to -- undo their vote. , proposalTag :: ProposalTag - -- ^ Identifies the proposal. + -- ^ Identifies the proposal. See 'ProposalTag' for further + -- comments on its significance. } deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''ProposalLock [('ProposalLock, 0)] +-- | Haskell-level redeemer for Stake scripts. +data StakeRedeemer + = -- | Deposit or withdraw a discrete amount of the staked governance token. + -- Stake must be unlocked. + DepositWithdraw (Tagged GTTag Integer) + | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. + -- Stake must be unlocked. + Destroy + | -- | Permit a Vote to be added onto a 'Proposal'. + -- This also adds a lock to the 'lockedBy' field. See 'ProposalLock'. + -- This needs to be done in sync with casting a vote, otherwise + -- it's possible for a lock to be permanently placed on the stake, + -- and then the funds are lost. + PermitVote ProposalLock + | -- | Retract a vote, removing it from the 'lockedBy' field. See 'ProposalLock'. + -- This action checks for permission of the 'Proposal'. Finished proposals are + -- always allowed to be retracted with. + RetractVotes [ProposalLock] + deriving stock (Show, GHC.Generic) + +PlutusTx.makeIsDataIndexed + ''StakeRedeemer + [ ('DepositWithdraw, 0) + , ('Destroy, 1) + , ('PermitVote, 2) + , ('RetractVotes, 3) + ] + -- | Haskell-level datum for Stake scripts. data StakeDatum = StakeDatum { stakedAmount :: Tagged GTTag Integer @@ -158,6 +203,8 @@ data PStakeRedeemer (s :: S) PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag])) | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets. PDestroy (Term s (PDataRecord '[])) + | PPermitVote (Term s (PDataRecord '["lock" ':= PProposalLock])) + | PRetractVotes (Term s (PDataRecord '["locks" ':= PBuiltinList PProposalLock])) deriving stock (GHC.Generic) deriving anyclass (Generic) deriving anyclass (PIsDataRepr) @@ -204,10 +251,7 @@ deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (PCons -------------------------------------------------------------------------------- -- | Policy for Stake state threads. -stakePolicy :: - forall (s :: S). - Stake -> - Term s PMintingPolicy +stakePolicy :: Stake -> ClosedTerm PMintingPolicy stakePolicy stake = plam $ \_redeemer ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' @@ -300,10 +344,7 @@ stakePolicy stake = -------------------------------------------------------------------------------- -- | Validator intended for Stake UTXOs to live in. -stakeValidator :: - forall (s :: S). - Stake -> - Term s PValidator +stakeValidator :: Stake -> ClosedTerm PValidator stakeValidator stake = plam $ \datum redeemer ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' @@ -322,28 +363,48 @@ stakeValidator stake = PJust txInInfo <- pmatch $ pfindTxInByTxOutRef # (pfield @"_0" # txOutRef) # txInfo' ownAddress <- plet $ pfield @"address" #$ pfield @"resolved" # txInInfo let continuingValue = pfield @"value" #$ pfield @"resolved" # txInInfo + + -- Whether the owner signs this transaction or not. ownerSignsTransaction <- plet $ ptxSignedBy # ctx.txInfo # stakeDatum.owner + stCurrencySymbol <- plet $ pconstant $ mintingPolicySymbol $ mkMintingPolicy (stakePolicy stake) mintedST <- plet $ psymbolValueOf # stCurrencySymbol # txInfo.mint spentST <- plet $ psymbolValueOf # stCurrencySymbol #$ pvalueSpent # txInfo' + -- Is the stake currently locked? + stakeIsLocked <- plet $ stakeLocked # stakeDatum' + pmatch stakeRedeemer $ \case PDestroy _ -> P.do passert "ST at inputs must be 1" $ spentST #== 1 passert "Should burn ST" $ mintedST #== -1 - passert "Stake unlocked" $ - pnot #$ stakeLocked # stakeDatum' + passert "Stake unlocked" $ pnot # stakeIsLocked passert "Owner signs this transaction" ownerSignsTransaction popaque (pconstant ()) + -------------------------------------------------------------------------- + PRetractVotes _ -> P.do + passert + "Owner signs this transaction" + ownerSignsTransaction + -- TODO: check proposal constraints + popaque (pconstant ()) + -------------------------------------------------------------------------- + PPermitVote _ -> P.do + passert + "Owner signs this transaction" + ownerSignsTransaction + -- TODO: check proposal constraints + popaque (pconstant ()) + -------------------------------------------------------------------------- PDepositWithdraw r -> P.do passert "ST at inputs must be 1" $ spentST #== 1 passert "Stake unlocked" $ - pnot #$ stakeLocked # stakeDatum' + pnot #$ stakeIsLocked passert "Owner signs this transaction" ownerSignsTransaction @@ -365,9 +426,6 @@ stakeValidator stake = ] let expectedValue = paddValue # continuingValue # (pdiscreteValue stake.gtClassRef # delta) - ptrace (pshow $ passetClassValueOf' (untag stake.gtClassRef) # value) - ptrace (pshow $ passetClassValueOf' (untag stake.gtClassRef) # expectedValue) - -- TODO: Same as above. This is quite inefficient now, as it does two lookups -- instead of a more efficient single pass, -- but it doesn't really matter for this. At least it's correct. @@ -401,5 +459,4 @@ stakeLocked = phoistAcyclic $ plam $ \stakeDatum -> let locks :: Term _ (PBuiltinList (PAsData PProposalLock)) locks = pfield @"lockedBy" # stakeDatum - in -- 'pnotNull' ? - pelimList (\_ _ -> pcon PTrue) (pcon PFalse) locks + in pnotNull # locks diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index df11f65..9cbf6da 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -28,10 +28,8 @@ import Agora.Utils (passert) do so in a valid manner. -} treasuryV :: - forall {s :: S}. CurrencySymbol -> - Term - s + ClosedTerm ( PAsData PTreasuryDatum :--> PAsData PTreasuryRedeemer :--> PAsData PScriptContext @@ -50,7 +48,7 @@ treasuryV gatCs' = plam $ \_d r ctx' -> P.do -- Get the minted value from txInfo. txInfo' <- plet ctx.txInfo txInfo <- pletFields @'["mint"] txInfo' - let mint :: Term s PValue + let mint :: Term _ PValue mint = txInfo.mint gatCs <- plet $ pconstant gatCs' diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 2f875b0..5ac101c 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -25,6 +25,7 @@ module Agora.Utils ( pfindTxInByTxOutRef, psingletonValue, pfindMap, + pnotNull, -- * Functions which should (probably) not be upstreamed anyOutput, @@ -281,6 +282,10 @@ pfindTxInByTxOutRef = phoistAcyclic $ ) #$ (pfield @"inputs" # txInfo) +-- | True if a list is not empty. +pnotNull :: forall list a. PIsListLike list a => Term _ (list a :--> PBool) +pnotNull = phoistAcyclic $ plam $ pelimList (\_ _ -> pcon PTrue) (pcon PFalse) + -------------------------------------------------------------------------------- {- Functions which should (probably) not be upstreamed All of these functions are quite inefficient. From 51b1e726fc5cf790454bc46ce70f9d8ea4955a56 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 4 Apr 2022 13:37:06 +0200 Subject: [PATCH 22/31] fix typo, add stubs on Governor --- agora/Agora/Governor.hs | 29 ++++++++++++++++++++++++++++- agora/Agora/Stake.hs | 2 +- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 33584e1..34777ad 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -5,9 +5,22 @@ Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. -} -module Agora.Governor (GovernorDatum (..), GovernorRedeemer (..), Governor (..)) where +module Agora.Governor ( + -- * Haskell-land + GovernorDatum (..), + GovernorRedeemer (..), + Governor (..), + + -- * Plutarch-land + + -- * Scripts + governorPolicy, + governorValidator, +) where import Agora.Proposal (ProposalThresholds) +import Plutarch (popaque) +import Plutarch.Api.V1 (PMintingPolicy, PValidator) -- | Datum for the Governor script. newtype GovernorDatum = GovernorDatum @@ -31,3 +44,17 @@ data GovernorRedeemer -- | Parameters for creating Governor scripts. data Governor = Governor + +-------------------------------------------------------------------------------- + +-- | Policy for Governors. +governorPolicy :: Governor -> ClosedTerm PMintingPolicy +governorPolicy _ = + plam $ \_redeemer _ctx' -> P.do + popaque (pconstant ()) + +-- | Validator for Governors. +governorValidator :: Governor -> ClosedTerm PValidator +governorValidator _ = + plam $ \_datum _redeemer _ctx' -> P.do + popaque (pconstant ()) diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 7a90877..bb7f471 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -99,7 +99,7 @@ newtype Stake = Stake on voting which in turn creates contention on stakers. Vaguely this is the dependency graph for this locking - interaction. Both the stake vaalidator and the proposal + interaction. Both the stake validator and the proposal validator are only able to check for eachother through the datum belonging to the ST: From 809480b351a402672b4afdba17636973d203a6a2 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Mon, 4 Apr 2022 16:03:25 +0200 Subject: [PATCH 23/31] `PTryFrom` comment, README badge --- README.md | 3 ++- agora/Agora/Stake.hs | 2 +- agora/Agora/Treasury.hs | 26 +++++++++++++++----------- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index a0f2905..77cf520 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,5 @@ -# Agora +# Agora :classical_building: +![integrate.yaml badge](https://github.com/Liqwid-Labs/agora/actions/workflows/integrate.yaml/badge.svg?branch=master) Agora is a set of Plutus scripts that compose together to form a governance system. diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index bb7f471..9ee7c3c 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -351,7 +351,7 @@ stakeValidator stake = txInfo' <- plet ctx.txInfo txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' - -- Coercion is safe in that if coercion fails we crash hard. + -- TODO: Use PTryFrom let stakeRedeemer :: Term _ PStakeRedeemer stakeRedeemer = pfromData $ punsafeCoerce redeemer stakeDatum' :: Term _ PStakeDatum diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index 9cbf6da..71eee81 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -10,7 +10,7 @@ module Agora.Treasury (module Agora.Treasury) where import GHC.Generics qualified as GHC import Generics.SOP -import Plutarch.Api.V1.Contexts (PScriptContext, PScriptPurpose (PMinting)) +import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting)) import Plutarch.Api.V1.Value (PCurrencySymbol, PValue) import Plutarch.DataRepr ( PDataFields, @@ -23,19 +23,23 @@ import Plutus.V1.Ledger.Value (CurrencySymbol) import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.Utils (passert) +import Plutarch (popaque) +import Plutarch.Api.V1 (PValidator) +import Plutarch.Unsafe (punsafeCoerce) {- | Validator ensuring that transactions consuming the treasury do so in a valid manner. -} -treasuryV :: +treasuryValidator :: CurrencySymbol -> - ClosedTerm - ( PAsData PTreasuryDatum - :--> PAsData PTreasuryRedeemer - :--> PAsData PScriptContext - :--> PUnit - ) -treasuryV gatCs' = plam $ \_d r ctx' -> P.do + ClosedTerm PValidator +treasuryValidator gatCs' = plam $ \datum redeemer ctx' -> P.do + -- TODO: Use PTryFrom + let treasuryRedeemer :: Term _ (PAsData PTreasuryRedeemer) + treasuryRedeemer = punsafeCoerce redeemer + _treasuryDatum' :: Term _ (PAsData PTreasuryDatum) + _treasuryDatum' = punsafeCoerce datum + -- plet required fields from script context. ctx <- pletFields @["txInfo", "purpose"] ctx' @@ -43,7 +47,7 @@ treasuryV gatCs' = plam $ \_d r ctx' -> P.do PMinting _ <- pmatch ctx.purpose -- Ensure redeemer type is valid. - PAlterTreasuryParams _ <- pmatch $ pfromData r + PAlterTreasuryParams _ <- pmatch $ pfromData treasuryRedeemer -- Get the minted value from txInfo. txInfo' <- plet ctx.txInfo @@ -55,7 +59,7 @@ treasuryV gatCs' = plam $ \_d r ctx' -> P.do passert "singleAuthorityTokenBurned" $ singleAuthorityTokenBurned gatCs txInfo' mint - pconstant () + popaque $ pconstant () {- | Plutarch level type representing datum of the treasury. Contains: From b86bcc91deaadeb664d12c81f75c5b5976f6078a Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Tue, 5 Apr 2022 11:16:22 +0100 Subject: [PATCH 24/31] inited contributing md --- CONTRIBUTING.md | 1 + 1 file changed, 1 insertion(+) create mode 100644 CONTRIBUTING.md diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..854139a --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1 @@ +# Contributing From ae7191e0ac8d73e0fb420bb2a98441c75640ceef Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Tue, 5 Apr 2022 12:03:30 +0200 Subject: [PATCH 25/31] apply Jack's PR suggestions --- agora/Agora/Effect.hs | 23 ++++++++++++++++++----- agora/Agora/Governor.hs | 6 ++++-- agora/Agora/Proposal.hs | 6 +++++- agora/Agora/SafeMoney.hs | 2 +- agora/Agora/Stake.hs | 7 ++++--- agora/Agora/Treasury.hs | 2 +- 6 files changed, 33 insertions(+), 13 deletions(-) diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index a4e3782..e8c3794 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -5,11 +5,15 @@ Description: Helpers for constructing effects Helpers for constructing effects. -} -module Agora.Effect (makeEffect) where +module Agora.Effect ( + makeEffect, + noopEffect, +) where import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.Utils (passert) -import Plutarch.Api.V1 (PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue) +import Plutarch (popaque) +import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue) import Plutarch.Internal (punsafeCoerce) import Plutarch.Monadic qualified as P import Plutus.V1.Ledger.Value (CurrencySymbol) @@ -26,13 +30,14 @@ makeEffect :: forall (datum :: PType). PIsData datum => CurrencySymbol -> - (forall (s :: S). Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) -> + (forall (s :: S). Term s PCurrencySymbol -> Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) -> ClosedTerm PValidator makeEffect gatCs' f = plam $ \datum _redeemer ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet ctx.txInfo + -- TODO: Use PTryFrom let datum' :: Term _ datum datum' = pfromData $ punsafeCoerce datum @@ -45,8 +50,16 @@ makeEffect gatCs' f = gatCs <- plet $ pconstant gatCs' - passert "singleAuthorityTokenBurned" $ singleAuthorityTokenBurned gatCs txInfo' mint + passert "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint - f datum' txOutRef' txInfo' + f gatCs datum' txOutRef' txInfo' -------------------------------------------------------------------------------- + +-- | Dummy effect which can only burn its GAT. +noopEffect :: CurrencySymbol -> ClosedTerm PValidator +noopEffect = + ( `makeEffect` + \_gatCs (_datum :: Term _ PUnit) _txOutRef _txInfo -> P.do + popaque (pconstant ()) + ) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 34777ad..db24681 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -18,14 +18,16 @@ module Agora.Governor ( governorValidator, ) where -import Agora.Proposal (ProposalThresholds) +import Agora.Proposal (ProposalTag, ProposalThresholds) import Plutarch (popaque) import Plutarch.Api.V1 (PMintingPolicy, PValidator) -- | Datum for the Governor script. -newtype GovernorDatum = GovernorDatum +data GovernorDatum = GovernorDatum { proposalThresholds :: ProposalThresholds -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. + , nextProposalTag :: ProposalTag + -- ^ What tag the next proposal will get upon creating. } {- | Redeemer for Governor script. The governor has two primary diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index f8a9357..a7df633 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -158,7 +158,11 @@ data ProposalDatum = ProposalDatum PlutusTx.makeIsDataIndexed ''ProposalDatum [('ProposalDatum, 0)] --- | Identifies a Proposal, issued upon creation of a proposal. +{- | Identifies a Proposal, issued upon creation of a proposal. + In practice, this number starts at zero, and increments by one + for each proposal. The 100th proposal will be @'ProposalTag' 99@. + This counter lives in the 'Governor', see 'nextProposalTag'. +-} newtype ProposalTag = ProposalTag {proposalTag :: Integer} deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) deriving stock (Eq, Show, GHC.Generic) diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index 8791ff9..f94ae8d 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -3,7 +3,7 @@ Module : Agora.SafeMoney Maintainer : emi@haskell.fyi Description: Tags and bonuses for Plutarch.SafeMoney. -Tags and bonuses for "Plutarch.SafeMoney". +Tags and extras for "Plutarch.SafeMoney". -} module Agora.SafeMoney ( ADATag, diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 9ee7c3c..234510c 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -100,7 +100,7 @@ newtype Stake = Stake Vaguely this is the dependency graph for this locking interaction. Both the stake validator and the proposal - validator are only able to check for eachother through + validator are only able to check for one another through the datum belonging to the ST: @ @@ -143,7 +143,8 @@ data StakeRedeemer PermitVote ProposalLock | -- | Retract a vote, removing it from the 'lockedBy' field. See 'ProposalLock'. -- This action checks for permission of the 'Proposal'. Finished proposals are - -- always allowed to be retracted with. + -- always allowed to have votes retracted and won't affect the Proposal datum, + -- allowing 'Stake's to be unlocked. RetractVotes [ProposalLock] deriving stock (Show, GHC.Generic) @@ -166,7 +167,7 @@ data StakeDatum = StakeDatum -- TODO Support for MultiSig/Scripts is tracked here: -- https://github.com/Liqwid-Labs/agora/issues/45 , lockedBy :: [ProposalLock] - -- ^ The proposal locks in place. This field must be empty + -- ^ The current proposals locking this stake. This field must be empty -- for the stake to be usable for deposits and withdrawals. } deriving stock (Show, GHC.Generic) diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index 71eee81..3f48a1f 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -57,7 +57,7 @@ treasuryValidator gatCs' = plam $ \datum redeemer ctx' -> P.do gatCs <- plet $ pconstant gatCs' - passert "singleAuthorityTokenBurned" $ singleAuthorityTokenBurned gatCs txInfo' mint + passert "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint popaque $ pconstant () From 72f7a7aa715f6ec9aeebe3f13f7631f5cb9dfaf1 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Tue, 5 Apr 2022 14:02:25 +0100 Subject: [PATCH 26/31] First stab --- CONTRIBUTING.md | 61 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 854139a..766f91b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1 +1,62 @@ # Contributing + +This document is intended for those whom wish to contribute to Agora, in the form of submitting issues or writing pull requests (PR). Thank you! The Agora core team is delighted to have community members contribute to our project. + +Before making any form of contribution, it is advised that one familiarises themselves with the [existing documentation](./docs). This will enable the contributor to submit better, more informed issues and will potentially aid a developer in writing PRs. + +## Agora core team + +This document will make reference to the _Agora core team_. These are the people who work on Agora professionally and will be responsible for maintaining the project in its open source life. They include: + + - [Emily Martins](https://github.com/emiflake) + - [Jack Hodgkinson](https://github.com/jhodgdev) + +## Issues + +An _issue_ is a post on the Agora [Issues page](https://github.com/Liqwid-Labs/agora/issues). An issue may pertain to: + +- A bug. +- A desired feature. +- A question one has that is not covered within documentation. + +Before submitting an issue, please check that the same issue has not already been provided by another contributor. Such an issue could be _open_ (unresolved) or _closed_ (considered resolved). If it is open, please comment with your perspective on the issue. If it is closed, please read-through what has been posted on the issue page. If you believe the issue is still unresolved, feel free to re-open it along with a post explaining your reasons for doing so. + +If your issue has _not_ been submitted hitherto, please submit a new issue. To assist the Agora community please provide _as much_ detail as you feel is relevant. For bugs, _please_ include instructions on how to reproduce the issue and provide any terminal outputs. Please remember to tag your issue with GitHub's labelling system. + +Top-tier issues include a _minimal reproducible example_. This should take the form of a public GitHub repository containing _only the code required to reproduce the issue_. Alongside a link to such a repository, please detail steps on how a maintainer may recreate the issue on their system. + +If you wish to work to resolve the issue, the Agora team would invite you to submit a PR. + +## Pull requests + +Only those within the core Agora team may contribute work to the project directly. If you wish to work on the project, you must [fork](https://docs.github.com/en/get-started/quickstart/fork-a-repo) the repository and submit your changes to your fork. Instructions for getting started with the project may be found in the [README](./README.md). Once the work on your fork is completed, you may submit a PR [here](https://github.com/Liqwid-Labs/agora/pulls). + +Before submitting a PR, please write an issue pertaining to the problem that your PR would solve e.g. a bug in the codebase or a missing feature. Read this document's section on _Issues_ and pay particular heed to the paragraph asking contributors to _look for pre-existing issues_. The prior experiences of existing contributors could save you a significant amount of time and effort. It is possible that a number of issues could be solved by your PR. Please reference any issues that would be ameliorated by your PR - including your own issue, if you have written one - clearly. Please label your PR using GitHub's tagging feature. Please state plainly: + +- What your PR achieves. +- How your PR works. +- What your PR changes. +- Any aspects of your work that you believe merit especially careful review. + +Contributors should expect that if their work is insufficiently documented (either on GitHub or within the codebase) that their PR will not be reviewed by core Agora team members. Contributors should expect that an Agora maintainer may offer constructive feedback and request changes to be made, prior to the PR being incorporated into the project. + +### Continuous integration + +For your PR to be merged it must pass three automated checks: + 1. A [`fourmolu`](https://github.com/fourmolu/fourmolu) formatting check. + 2. A [`hlint`](https://github.com/ndmitchell/hlint) linting check. + 3. A Cabal build check. + +Our custom `fourmolu` rules may be found in the [base of the repository](./fourmolu.yaml). You can ensure that your work will pass CI by: + + 1. Running `make format` from the included `Makefile`. + 2. Running `make lint` from the included `Makefile` and applying any recommendations. + 3. Ensuring that `cabal build` terminates successfully on your machine in the provided Nix environment. + +## Documentation + +It is worth noting that the codebase is not the only aspect of the project that it is worth contributing to. In the event that one finds the docs unsatisfactory, the Agora team would welcome receiving any issues describing your reservations or PRs pertaining to documentation. + +## Conclusion + +Many thanks for reading. The Agora core team is delighted to be able to share the project with the Cardano community and we are thrilled by the prospect of collaborating with you all on improving our work. From 7d25ac48f23059b991910ff10201d91cf969c71e Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Wed, 6 Apr 2022 10:39:59 +0100 Subject: [PATCH 27/31] Pointed contributing towards plutarch and mlabs style guide --- CONTRIBUTING.md | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 766f91b..fee2cdf 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -8,8 +8,8 @@ Before making any form of contribution, it is advised that one familiarises them This document will make reference to the _Agora core team_. These are the people who work on Agora professionally and will be responsible for maintaining the project in its open source life. They include: - - [Emily Martins](https://github.com/emiflake) - - [Jack Hodgkinson](https://github.com/jhodgdev) +- [Emily Martins](https://github.com/emiflake) +- [Jack Hodgkinson](https://github.com/jhodgdev) ## Issues @@ -40,18 +40,27 @@ Before submitting a PR, please write an issue pertaining to the problem that you Contributors should expect that if their work is insufficiently documented (either on GitHub or within the codebase) that their PR will not be reviewed by core Agora team members. Contributors should expect that an Agora maintainer may offer constructive feedback and request changes to be made, prior to the PR being incorporated into the project. +### Technical requirements + +Agora utilises [Plutarch](https://github.com/plutonomicon/plutarch) and your work must be written with Plutarch, when appropriate. Plutarch can prove _complicated_ but the documentation is extensive. We would encourage you to dive deeply into the documentation, whilst stating that Plutarch's [Tricks.md](https://github.com/Plutonomicon/plutarch/blob/master/docs/Tricks.md) could prove particularly helpful. + +### Stylistic guidelines + +All work must comply with the [MLabs style guide](https://github.com/mlabs-haskell/styleguide/). + ### Continuous integration -For your PR to be merged it must pass three automated checks: - 1. A [`fourmolu`](https://github.com/fourmolu/fourmolu) formatting check. - 2. A [`hlint`](https://github.com/ndmitchell/hlint) linting check. - 3. A Cabal build check. +For your PR to be merged it must pass three automated checks: + +1. A [`fourmolu`](https://github.com/fourmolu/fourmolu) formatting check. +2. A [`hlint`](https://github.com/ndmitchell/hlint) linting check. +3. A Cabal build check. Our custom `fourmolu` rules may be found in the [base of the repository](./fourmolu.yaml). You can ensure that your work will pass CI by: - 1. Running `make format` from the included `Makefile`. - 2. Running `make lint` from the included `Makefile` and applying any recommendations. - 3. Ensuring that `cabal build` terminates successfully on your machine in the provided Nix environment. +1. Running `make format` from the included `Makefile`. +2. Running `make lint` from the included `Makefile` and applying any recommendations. +3. Ensuring that `cabal build` terminates successfully on your machine in the provided Nix environment. ## Documentation From ba48fe33fd1997dbd2ef2c88054f02e894e20fde Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 6 Apr 2022 16:02:04 +0200 Subject: [PATCH 28/31] add Using Agora document --- README.md | 4 ++++ docs/using-agora.md | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+) create mode 100644 docs/using-agora.md diff --git a/README.md b/README.md index 77cf520..11acb27 100644 --- a/README.md +++ b/README.md @@ -25,6 +25,10 @@ Open a development shell with `nix develop` and build the project with `cabal bu Documentation for Agora may be found in [docs](./docs). +### Using Agora for your protocol + +If you are a protocol wanting to use Agora, read [Using Agora](./docs/using-agora.md). + ## Road-map ### v1 diff --git a/docs/using-agora.md b/docs/using-agora.md new file mode 100644 index 0000000..a33a749 --- /dev/null +++ b/docs/using-agora.md @@ -0,0 +1,37 @@ +# Using Agora + +### Motivation + +If you are building a project on Cardano that involves decentralized interaction between users you may want to create a DAO (Decentralized Autonomous Organization). A DAO will allow users to come to consensus on various matters relevant to your project. For instance managing of treasury assets, changing of protocol parameters, replacing of scripts, deprecation of the protocol in favour of a new version, emergency actions protecting the users, etc. In order to do this on-chain, users will have to be able to voice their opinion contractually, and only those with skin in the game ought to be able to interact, so they interact in favour of the protocol at large. Furthermore, a balance must be struck when it comes to the various features of governance and your particular protocol. Various flavours of governance exist, each with their own trade-offs. + +Building such a system is quite a complex process and requires a lot of care; ensuring fairness (with regard to user interactions), efficiency (with regard to contention and throughput) and simplicity (with regard to script size, tx costs). Agora is a curated set of scripts, types and design patterns that are designed from the ground up to solve this problem in a way that is flexible enough to suit essentially any protocol while also ensuring a balance is struck in trade-offs by default. Hopefully this will save time. + +### Agora and your protocol + +Agora’s staking model relies on the existence of a governance token. The entire system essentially is “parameterized” by your governance token. The Agora staking pools will lock user’s governance tokens in order to allow them to vote. However, the majority of Agora components can live on their own after that fact. One could for instance technically create a DAO that works with ADA as its governance token. + +In order to wire up your protocol’s DAO actions: + +- All relevant and affected parts of your protocol will need to enable authority token burns to act as full authority: + +In the case of, say, a datum that stores parameters of your protocol, there ought to be a redeemer that delegates the validation of the entire transaction to a single check for the burning of the authority token. This allows flexibility of proposal outcomes, and is the core building block for Agora’s effects. + +- Write effects that perform desired actions within your protocol. + +Writing an effect is as simple as writing any other script, but this script has only a single transaction in mind. Let’s say you’re building an NFT project, and you want to leave all mints up to the community to decide on. In this scenario you could make a `MintNFTs` effect which will mint the NFTs after a proposal passes. This is where the authority token burn “master key” comes into play: The policy of the NFTs can check for an authority token burn, proving it was “authorized” by the DAO. + + +These two are the only required chores of using Agora in practice. The former is the only one that involves adapting your own scripts. Effect scripts can be written after your protocol and its governance has deployed, provided the authority tokens are respected by the components. + + +### What Agora leaves up to you + +Agora’s bread and butter is the on-chain components and scripts. So, the frontend is a concern of the consumer of the library. Hopefully the documentation and design will be enough for you to figure out the best way to design your frontends. In the future, an off-chain library may exist for Agora, which would contain various functions for creating transactions. + +It’s worth noting that, while the actual functionality of the *frontends* isn’t a concern, documentation on standardization of off-chain metadata *is*. For example, off-chain metadata tagging of proposal descriptions, tags, dates, etc. These are all important features that Agora aims to standardize, in hopes of helping the interoperability between various protocols, and DAOs for DAOs. + +Writing new effects that are protocol specific is up to you too. Although, if your protocol is general in nature, and you believe that an effect can be beneficial to other users of Agora, then you can contribute it. Agora ships with a number of meta-effects out of the box, and intends to add more as time goes on. + +### What to do if something is missing + +If you find that one of your use cases isn’t covered by Agora, or there is a hole in the spec with regards to potentially critical importance to your project. Then feel free to create an issue for it and we will open discussion on that matter. See [CONTRIBUTING.md](../CONTRIBUTING.md) before doing so. From 9a8a87b4fb8276122c366c1415f517289a623808 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 8 Apr 2022 09:07:56 +0100 Subject: [PATCH 29/31] initial review --- docs/diagrams/UsingAgora.dot | 6 ++++ docs/diagrams/UsingAgora.svg | 57 ++++++++++++++++++++++++++++++++++++ docs/using-agora.md | 53 +++++++++++++++++++++++---------- 3 files changed, 100 insertions(+), 16 deletions(-) create mode 100644 docs/diagrams/UsingAgora.dot create mode 100644 docs/diagrams/UsingAgora.svg diff --git a/docs/diagrams/UsingAgora.dot b/docs/diagrams/UsingAgora.dot new file mode 100644 index 0000000..29bc58b --- /dev/null +++ b/docs/diagrams/UsingAgora.dot @@ -0,0 +1,6 @@ +digraph { + rankdir=LR + Users -> Proposals [label="vote on"] + Proposals -> Effects [label="have one or many"] + Effects -> Components [label="alter"] +} diff --git a/docs/diagrams/UsingAgora.svg b/docs/diagrams/UsingAgora.svg new file mode 100644 index 0000000..7ed833d --- /dev/null +++ b/docs/diagrams/UsingAgora.svg @@ -0,0 +1,57 @@ + + + + + + + + + +Users + +Users + + + +Proposals + +Proposals + + + +Users->Proposals + + +vote on + + + +Effects + +Effects + + + +Proposals->Effects + + +have one or many + + + +Components + +Components + + + +Effects->Components + + +alter + + + diff --git a/docs/using-agora.md b/docs/using-agora.md index a33a749..d651e0f 100644 --- a/docs/using-agora.md +++ b/docs/using-agora.md @@ -1,37 +1,58 @@ # Using Agora -### Motivation +## Motivation -If you are building a project on Cardano that involves decentralized interaction between users you may want to create a DAO (Decentralized Autonomous Organization). A DAO will allow users to come to consensus on various matters relevant to your project. For instance managing of treasury assets, changing of protocol parameters, replacing of scripts, deprecation of the protocol in favour of a new version, emergency actions protecting the users, etc. In order to do this on-chain, users will have to be able to voice their opinion contractually, and only those with skin in the game ought to be able to interact, so they interact in favour of the protocol at large. Furthermore, a balance must be struck when it comes to the various features of governance and your particular protocol. Various flavours of governance exist, each with their own trade-offs. +If you are building a project on Cardano that involves decentralized interaction between users you may want to create a DAO (Decentralized Autonomous Organization). -Building such a system is quite a complex process and requires a lot of care; ensuring fairness (with regard to user interactions), efficiency (with regard to contention and throughput) and simplicity (with regard to script size, tx costs). Agora is a curated set of scripts, types and design patterns that are designed from the ground up to solve this problem in a way that is flexible enough to suit essentially any protocol while also ensuring a balance is struck in trade-offs by default. Hopefully this will save time. +> Consider linking an article here? Maybe the [Wikipedia one](https://www.wikiwand.com/en/Decentralized_autonomous_organization) or a better one you know of? -### Agora and your protocol +A DAO will allow users to come to a consensus on a variety of matters relevant to your project. These could include: managing of treasury assets, changing of protocol parameters, replacing of scripts, deprecation of the protocol in favour of a new version, emergency actions to protect users, and so forth. In order to do this on-chain, users will have to be able to express their opinion contractually, and only those with a vested interest ought to be able to interact with relevant proposals. This should ensure that voters have the best interests of the protocol at-heart. Governance systems can take varied forms, and not all of them will be suitable for your project. -Agora’s staking model relies on the existence of a governance token. The entire system essentially is “parameterized” by your governance token. The Agora staking pools will lock user’s governance tokens in order to allow them to vote. However, the majority of Agora components can live on their own after that fact. One could for instance technically create a DAO that works with ADA as its governance token. +Building such a system is a complex process and requires a lot of care; ensuring fairness (with regard to user interactions), efficiency (with regard to contention and throughput) and simplicity (with regard to script size and transaction costs). Agora is a curated set of scripts, types and design patterns that are designed from the ground-up to solve this problem in a way that is flexible enough to suit essentially any protocol. -In order to wire up your protocol’s DAO actions: +### A quick note on terms -- All relevant and affected parts of your protocol will need to enable authority token burns to act as full authority: +This article will include common English words that have specific meanings in Agora. To help you disambiguate, here are some definitions: -In the case of, say, a datum that stores parameters of your protocol, there ought to be a redeemer that delegates the validation of the entire transaction to a single check for the burning of the authority token. This allows flexibility of proposal outcomes, and is the core building block for Agora’s effects. +- proposal: A collection of changes to the protocol, which are voted on as a block. +- effect: An on-chain representation of a proposed change to the protocol. A 'proposal' will hold references to one or many 'effects'. If an effect's proposal is passed by the community, effects are granted special 'authority tokens' which permit them to enact their encoded changes to the relevant protocol components. -- Write effects that perform desired actions within your protocol. +![Proposals have effects, which alter components.](/docs/diagrams/UsingAgora.svg) -Writing an effect is as simple as writing any other script, but this script has only a single transaction in mind. Let’s say you’re building an NFT project, and you want to leave all mints up to the community to decide on. In this scenario you could make a `MintNFTs` effect which will mint the NFTs after a proposal passes. This is where the authority token burn “master key” comes into play: The policy of the NFTs can check for an authority token burn, proving it was “authorized” by the DAO. +## Agora and your protocol +Agora’s staking model relies on the existence of a governance token. In a sense, this governance token _parameterizes_ the entire system. Agora staking pools will lock users' governance tokens in order to permit them to vote. + +> However, the majority of Agora components can live on their own after that fact. +> +> Jack: I am unsure what you mean here. Please rewrite for clarity. + +One could for instance technically create a DAO that works with ADA as its governance token. + +In order to set-up your protocol’s DAO actions, all affected components of your protocol will need to interpret the burning of an _authority token_ as a licence to alter _any_ aspect of that component. + +To put this in slightly more concrete terms: for any datum which holds a subset of your protocol's parameters, there _should_ exist a redeemer for that datum and validation for this datum/redeemer pair should do _no more_ than verify that one of these authority tokens has been burned. Without this flexibility, the effects of Agora's proposals would be markedly less powerful. + +### Writing effects + +One writes a proposal effect, as one would write any Plutus script with the caveat that the effect script will only be permitted to run _once_. + +Consider an example NFT project, wherein the minting of each NFT is a community action. For this scenario, one would require a template `MintNFT` effect, which mints its corresponding NFT upon the passing of the relevant proposal. The proposal being passed will issue an authority token to the effect. Each NFT's policy will verify that such an authority token was burned upon minting, which demonstrates that the minting of the NFT was indeed authorized by the DAO. These two are the only required chores of using Agora in practice. The former is the only one that involves adapting your own scripts. Effect scripts can be written after your protocol and its governance has deployed, provided the authority tokens are respected by the components. +> Which two, sorry? -### What Agora leaves up to you +## What Agora leaves up to you -Agora’s bread and butter is the on-chain components and scripts. So, the frontend is a concern of the consumer of the library. Hopefully the documentation and design will be enough for you to figure out the best way to design your frontends. In the future, an off-chain library may exist for Agora, which would contain various functions for creating transactions. +Agora’s concern is the on-chain components and scripts. Any front-ends are the concern of the protocol's developers. In the best case, our documentation and program design will inspire you in developing a front-end solution. There is scope for Agora containing some off-chain functionality in-future. This would allow the user to create and experiment with transactions. -It’s worth noting that, while the actual functionality of the *frontends* isn’t a concern, documentation on standardization of off-chain metadata *is*. For example, off-chain metadata tagging of proposal descriptions, tags, dates, etc. These are all important features that Agora aims to standardize, in hopes of helping the interoperability between various protocols, and DAOs for DAOs. +> It’s worth noting that, while the actual functionality of the _frontends_ isn’t a concern, documentation on standardization of off-chain metadata _is_. For example, off-chain metadata tagging of proposal descriptions, tags, dates, etc. These are all important features that Agora aims to standardize, in hopes of helping the interoperability between various protocols, and DAOs for DAOs. +> +> Jack: 'documentation on standardization of off-chain metadata'? -Writing new effects that are protocol specific is up to you too. Although, if your protocol is general in nature, and you believe that an effect can be beneficial to other users of Agora, then you can contribute it. Agora ships with a number of meta-effects out of the box, and intends to add more as time goes on. +You're welcome to write any new effects you require for your protocol. If you believe any effects you write are sufficiently general and could serve as a benefit to our community, we would encourage you to up-stream them. Guidelines for doing so may be found in our [contribution guide](/CONTRIBUTING.md). Agora provides a number of effects out-of-the-box and intends to add more with time. -### What to do if something is missing +## What to do if something is missing -If you find that one of your use cases isn’t covered by Agora, or there is a hole in the spec with regards to potentially critical importance to your project. Then feel free to create an issue for it and we will open discussion on that matter. See [CONTRIBUTING.md](../CONTRIBUTING.md) before doing so. +In the event Agora does not provide for one of your use cases, feel free to raise an issue and we can begin a discussion on implementing the desired functionality. Our [contribution guide](/CONTRIBUTING.md) has guidelines for registering issues. From a0357d2a26201e318ba91d180aa8a06f837e4671 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Fri, 8 Apr 2022 13:28:15 +0200 Subject: [PATCH 30/31] apply / fix comments --- docs/using-agora.md | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/docs/using-agora.md b/docs/using-agora.md index d651e0f..daff81c 100644 --- a/docs/using-agora.md +++ b/docs/using-agora.md @@ -2,9 +2,7 @@ ## Motivation -If you are building a project on Cardano that involves decentralized interaction between users you may want to create a DAO (Decentralized Autonomous Organization). - -> Consider linking an article here? Maybe the [Wikipedia one](https://www.wikiwand.com/en/Decentralized_autonomous_organization) or a better one you know of? +If you are building a project on Cardano that involves decentralized interaction between users you may want to create a DAO ([Decentralized Autonomous Organization](https://www.wikiwand.com/en/Decentralized_autonomous_organization)). A DAO will allow users to come to a consensus on a variety of matters relevant to your project. These could include: managing of treasury assets, changing of protocol parameters, replacing of scripts, deprecation of the protocol in favour of a new version, emergency actions to protect users, and so forth. In order to do this on-chain, users will have to be able to express their opinion contractually, and only those with a vested interest ought to be able to interact with relevant proposals. This should ensure that voters have the best interests of the protocol at-heart. Governance systems can take varied forms, and not all of them will be suitable for your project. @@ -21,13 +19,7 @@ This article will include common English words that have specific meanings in Ag ## Agora and your protocol -Agora’s staking model relies on the existence of a governance token. In a sense, this governance token _parameterizes_ the entire system. Agora staking pools will lock users' governance tokens in order to permit them to vote. - -> However, the majority of Agora components can live on their own after that fact. -> -> Jack: I am unsure what you mean here. Please rewrite for clarity. - -One could for instance technically create a DAO that works with ADA as its governance token. +Agora’s staking model relies on the existence of a governance token. In a sense, this governance token _parameterizes_ the entire system. Agora staking pools will lock users' governance tokens in order to permit them to vote. Agora's components are free-standing and don't _require_ a protocol acting in a particular way in order to function. One could for instance technically create a DAO that works with ADA as its governance token. The tokenomics of your governance token will of course influence the way voting power is distributed, due to the nature of token-based voting. In order to set-up your protocol’s DAO actions, all affected components of your protocol will need to interpret the burning of an _authority token_ as a licence to alter _any_ aspect of that component. @@ -39,17 +31,13 @@ One writes a proposal effect, as one would write any Plutus script with the cave Consider an example NFT project, wherein the minting of each NFT is a community action. For this scenario, one would require a template `MintNFT` effect, which mints its corresponding NFT upon the passing of the relevant proposal. The proposal being passed will issue an authority token to the effect. Each NFT's policy will verify that such an authority token was burned upon minting, which demonstrates that the minting of the NFT was indeed authorized by the DAO. -These two are the only required chores of using Agora in practice. The former is the only one that involves adapting your own scripts. Effect scripts can be written after your protocol and its governance has deployed, provided the authority tokens are respected by the components. - -> Which two, sorry? +Making your protocol's components aware of authority tokens, and implementing relevant effects are the only two chores of using Agora in practice. The former is the only one that involves adapting your own scripts. Effect scripts can be written after your protocol and its governance has deployed, provided the authority tokens are respected by the components. ## What Agora leaves up to you Agora’s concern is the on-chain components and scripts. Any front-ends are the concern of the protocol's developers. In the best case, our documentation and program design will inspire you in developing a front-end solution. There is scope for Agora containing some off-chain functionality in-future. This would allow the user to create and experiment with transactions. -> It’s worth noting that, while the actual functionality of the _frontends_ isn’t a concern, documentation on standardization of off-chain metadata _is_. For example, off-chain metadata tagging of proposal descriptions, tags, dates, etc. These are all important features that Agora aims to standardize, in hopes of helping the interoperability between various protocols, and DAOs for DAOs. -> -> Jack: 'documentation on standardization of off-chain metadata'? +It’s worth noting that, while the actual functionality of the _frontends_ isn’t a concern, creating standards for off-chain metadata _is_. For example, metadata tagging proposal descriptions, tags, dates, etc. These are all important features that Agora aims to standardize, in hopes of helping the interoperability between various instances of Agora. This effort is similar to [CIP-25](https://cips.cardano.org/cips/cip25/), which aims to standardize metadata for NFTs. You're welcome to write any new effects you require for your protocol. If you believe any effects you write are sufficiently general and could serve as a benefit to our community, we would encourage you to up-stream them. Guidelines for doing so may be found in our [contribution guide](/CONTRIBUTING.md). Agora provides a number of effects out-of-the-box and intends to add more with time. From e1d4198044bc6b6a802acfb9dee167be2f3de7c8 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 8 Apr 2022 13:20:30 +0100 Subject: [PATCH 31/31] couple of fixes to changes --- docs/using-agora.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/using-agora.md b/docs/using-agora.md index daff81c..27eda60 100644 --- a/docs/using-agora.md +++ b/docs/using-agora.md @@ -31,13 +31,13 @@ One writes a proposal effect, as one would write any Plutus script with the cave Consider an example NFT project, wherein the minting of each NFT is a community action. For this scenario, one would require a template `MintNFT` effect, which mints its corresponding NFT upon the passing of the relevant proposal. The proposal being passed will issue an authority token to the effect. Each NFT's policy will verify that such an authority token was burned upon minting, which demonstrates that the minting of the NFT was indeed authorized by the DAO. -Making your protocol's components aware of authority tokens, and implementing relevant effects are the only two chores of using Agora in practice. The former is the only one that involves adapting your own scripts. Effect scripts can be written after your protocol and its governance has deployed, provided the authority tokens are respected by the components. +Making your protocol's components aware of authority tokens, and implementing relevant effects are the only two chores of using Agora in practice. The former is the only one that involves adapting your own scripts. Effect scripts can be written after your protocol and its governance have deployed, provided that the authority tokens are respected by the components. ## What Agora leaves up to you Agora’s concern is the on-chain components and scripts. Any front-ends are the concern of the protocol's developers. In the best case, our documentation and program design will inspire you in developing a front-end solution. There is scope for Agora containing some off-chain functionality in-future. This would allow the user to create and experiment with transactions. -It’s worth noting that, while the actual functionality of the _frontends_ isn’t a concern, creating standards for off-chain metadata _is_. For example, metadata tagging proposal descriptions, tags, dates, etc. These are all important features that Agora aims to standardize, in hopes of helping the interoperability between various instances of Agora. This effort is similar to [CIP-25](https://cips.cardano.org/cips/cip25/), which aims to standardize metadata for NFTs. +It’s worth noting that, while the actual functionality of the _front-ends_ is not a concern, creating standards for off-chain metadata _is_. For example, metadata tagging proposal descriptions, tags, dates. These are all important features that Agora aims to standardize, in hopes of facilitating interoperability between various instances of Agora. This effort is similar to [CIP-25](https://cips.cardano.org/cips/cip25/), which aims to standardize metadata for NFTs. You're welcome to write any new effects you require for your protocol. If you believe any effects you write are sufficiently general and could serve as a benefit to our community, we would encourage you to up-stream them. Guidelines for doing so may be found in our [contribution guide](/CONTRIBUTING.md). Agora provides a number of effects out-of-the-box and intends to add more with time.