Works with GHC 9; need to re-add plutus-extra

agora.cabal

@@ -9,72 +9,98 @@ license:            Apache-2.0
 -- Common Stanza Declarations
 
 -- Language options, warnings, some options for plutus
+
 common lang
-  default-language:   Haskell2010
+  ghc-options:
+    -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind
+    -Wno-partial-type-signatures -Wmissing-export-lists
+    -Wincomplete-record-updates -Wmissing-deriving-strategies
+    -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls
+    -fprint-explicit-kinds -Werror
+
+  mixins:
+    base hiding (Prelude),
+    pprelude (PPrelude as Prelude)
+
   default-extensions:
-    NoImplicitPrelude
+    NoStarIsType
     BangPatterns
     BinaryLiterals
+    ConstrainedClassMethods
     ConstraintKinds
     DataKinds
     DeriveAnyClass
+    DeriveDataTypeable
+    DeriveFoldable
     DeriveFunctor
     DeriveGeneric
+    DeriveLift
     DeriveTraversable
     DerivingStrategies
     DerivingVia
-    DuplicateRecordFields
+    DoAndIfThenElse
     EmptyCase
+    EmptyDataDecls
+    EmptyDataDeriving
+    ExistentialQuantification
+    ExplicitForAll
     FlexibleContexts
     FlexibleInstances
-    GADTs
+    ForeignFunctionInterface
-    GeneralizedNewtypeDeriving
+    GADTSyntax
+    GeneralisedNewtypeDeriving
     HexFloatLiterals
+    ImplicitPrelude
     ImportQualifiedPost
     InstanceSigs
     KindSignatures
     LambdaCase
+    MonomorphismRestriction
     MultiParamTypeClasses
+    NamedFieldPuns
+    NamedWildCards
     NumericUnderscores
     OverloadedStrings
-    QuasiQuotes
+    PartialTypeSignatures
+    PatternGuards
+    PolyKinds
+    PostfixOperators
+    RankNTypes
+    RelaxedPolyRec
     ScopedTypeVariables
     StandaloneDeriving
+    StandaloneKindSignatures
+    TraditionalRecordSyntax
     TupleSections
     TypeApplications
     TypeFamilies
     TypeOperators
     TypeSynonymInstances
-    UndecidableInstances
+    ViewPatterns
+    OverloadedRecordDot
+    QualifiedDo
 
-  ghc-options:
+  default-language:   Haskell2010
-    -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints
-    -Wmissing-export-lists -Werror -Wincomplete-record-updates
-    -fno-ignore-interface-pragmas -fno-omit-interface-pragmas
-    -fobject-code -fno-strictness -fplugin=RecordDotPreprocessor
-    -fplugin-opt PlutusTx.Plugin:dump-uplc
 
 common deps
   build-depends:
     , aeson
     , ansi-terminal
-    , base                     >=4.9 && <5
+    , base                     >=4.14 && <5
     , base-compat
     , bytestring
-    , cardano-api
     , cardano-prelude
     , containers
     , data-default
     , data-default-class
     , plutarch
     , plutus-core
-    , plutus-extra
+    -- , plutus-extra
-    , plutus-ledger
+    -- , plutus-ledger
     , plutus-ledger-api
     , plutus-tx
+    , pprelude
     , prettyprinter
-    , record-dot-preprocessor
-    , record-hasfield
     , recursion-schemes
     , serialise
     , template-haskell
@@ -84,12 +110,8 @@ common test-deps
   build-depends:
     , QuickCheck
     , quickcheck-instances
-    , tagged
     , tasty
-    , tasty-hunit
+    , tasty-quickcheck
-    , utf8-string
-
---------------------------------------------------------------------------------
 
 library
   import:          lang, deps
@@ -97,6 +119,15 @@ library
   other-modules:
   hs-source-dirs:  src
 
+library pprelude
+  build-depends:
+    , base
+    , plutarch
+
+  exposed-modules:  PPrelude
+  hs-source-dirs:   src
+  default-language: Haskell2010
+
 test-suite agora-test
   import:         lang, deps, test-deps
   type:           exitcode-stdio-1.0

cabal.project

@@ -1,42 +1,3 @@
-index-state: 2021-10-20T00:00:00Z
-
 packages: ./.
 
--- Always build tests and benchmarks.
 tests: true
-benchmarks: true
-
--- The only sensible test display option
-test-show-details: direct
-
-allow-newer:
-           -- Pins to an old version of Template Haskell, unclear if/when it will be updated
-           size-based:template-haskell
-           , ouroboros-consensus-byron:formatting
-           , beam-core:aeson
-           , beam-sqlite:aeson
-           , beam-sqlite:dlist
-           , beam-migrate:aeson
-
-constraints:
-  -- big breaking change here, inline-r doens't have an upper bound
-  singletons < 3.0
-  -- bizarre issue: in earlier versions they define their own 'GEq', in newer
-  -- ones they reuse the one from 'some', but there isn't e.g. a proper version
-  -- constraint from dependent-sum-template (which is the library we actually use).
-  , dependent-sum > 0.6.2.0
-  -- Newer Hashable have instances for Set, which breaks beam-migrate
-  -- which declares its own instances of Hashable Set
-  , hashable < 1.3.4.0
-
-package cardano-ledger-alonzo
-  optimization: False
-package ouroboros-consensus-shelley
-  optimization: False
-package ouroboros-consensus-cardano
-  optimization: False
-package cardano-api
-  optimization: False
-
-package plutarch
-  flags: +development

flake.nix

@@ -1,89 +1,22 @@
 {
   description = "agora";
 
-  inputs.haskell-nix.url =
+  inputs.nixpkgs.follows = "plutarch/nixpkgs";
-    "github:input-output-hk/haskell.nix?rev=4aeeba8d713d0b98c92c8c717df24da17d463c1d";
+  inputs.haskell-nix.follows = "plutarch/haskell-nix";
-  inputs.nixpkgs.follows = "haskell-nix/nixpkgs-unstable";
-  inputs.haskell-nix.inputs.nixpkgs.follows = "haskell-nix/nixpkgs-unstable";
-
-  # Temp workaround for Nix issue.
-  inputs.nixpkgs-2111.url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin";
-
-  inputs.plutus.url =
-    "github:input-output-hk/plutus?rev=65bad0fd53e432974c3c203b1b1999161b6c2dce";
-
-  inputs.plutarch.url =
-    "github:Plutonomicon/plutarch?rev=1fd4db27152625184e559cfb465d225a0995a56b";
-
-  inputs.goblins.url =
-    "github:input-output-hk/goblins?rev=cde90a2b27f79187ca8310b6549331e59595e7ba";
-  inputs.goblins.flake = false;
 
   inputs.plutus-extra.url =
     "github:Liqwid-Labs/plutus-extra?rev=bfeb0d2bb1bc18f147e58c200db2022f5c75eb60";
   inputs.plutus-extra.flake = false; # Could we set this to true?
 
-  inputs.cardano-node.url =
+  # temporary fix for nix versions that have the transitive follows bug 
-    "github:input-output-hk/cardano-node?rev=b6ca519f97a0e795611a63174687e6bb70c9f752";
+  # see https://github.com/NixOS/nix/issues/6013
-  inputs.cardano-node.flake = false;
+  inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; };
 
-  inputs.cardano-wallet.url =
+  inputs.plutarch.url = "github:Plutonomicon/plutarch";
-    "github:j-mueller/cardano-wallet?rev=760140e238a5fbca61d1b286d7a80ece058dc729";
+  inputs.plutarch.inputs.nixpkgs.follows =
-  inputs.cardano-wallet.flake = false;
+    "plutarch/haskell-nix/nixpkgs-unstable";
 
-  inputs.purescript-bridge.url =
+  outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }:
-    "github:input-output-hk/purescript-bridge?rev=366fc70b341e2633f3ad0158a577d52e1cd2b138";
-  inputs.purescript-bridge.flake = false;
-
-  inputs.servant-purescript.url =
-    "github:input-output-hk/servant-purescript?rev=ebea59c7bdfc0338d83fca772b9a57e28560bcde";
-  inputs.servant-purescript.flake = false;
-
-  inputs.plutus-apps.url =
-    "github:input-output-hk/plutus-apps?rev=34fe6eeff441166fee0cd0ceba68c1439f0e93d2";
-  inputs.plutus-apps.flake = false;
-
-  inputs.cardano-addresses.url =
-    "github:input-output-hk/cardano-addresses?rev=d2f86caa085402a953920c6714a0de6a50b655ec";
-  inputs.cardano-addresses.flake = false;
-
-  inputs.optparse-applicative.url =
-    "github:input-output-hk/optparse-applicative?rev=7497a29cb998721a9068d5725d49461f2bba0e7a";
-  inputs.optparse-applicative.flake = false;
-
-  inputs.ouroboros-network.url =
-    "github:input-output-hk/ouroboros-network?rev=d613de3d872ec8b4a5da0c98afb443f322dc4dab";
-  inputs.ouroboros-network.flake = false;
-
-  inputs.cardano-ledger-specs.url =
-    "github:input-output-hk/cardano-ledger-specs?rev=bf008ce028751cae9fb0b53c3bef20f07c06e333";
-  inputs.cardano-ledger-specs.flake = false;
-
-  inputs.iohk-monitoring-framework.url =
-    "github:input-output-hk/iohk-monitoring-framework?rev=46f994e216a1f8b36fe4669b47b2a7011b0e153c";
-  inputs.iohk-monitoring-framework.flake = false;
-
-  inputs.cardano-prelude.url =
-    "github:input-output-hk/cardano-prelude?rev=fd773f7a58412131512b9f694ab95653ac430852";
-  inputs.cardano-prelude.flake = false;
-
-  inputs.cardano-base.url =
-    "github:input-output-hk/cardano-base?rev=654f5b7c76f7cc57900b4ddc664a82fc3b925fb0";
-  inputs.cardano-base.flake = false;
-
-  inputs.cardano-crypto.url =
-    "github:input-output-hk/cardano-crypto?rev=f73079303f663e028288f9f4a9e08bcca39a923e";
-  inputs.cardano-crypto.flake = false;
-
-  inputs.flat.url =
-    "github:Quid2/flat?rev=d32c2c0c0c3c38c41177684ade9febe92d279b06";
-  inputs.flat.flake = false;
-
-  inputs.Win32-network.url =
-    "github:input-output-hk/Win32-network?rev=3825d3abf75f83f406c1f7161883c438dac7277d";
-  inputs.Win32-network.flake = false;
-
-  outputs = inputs@{ self, nixpkgs, haskell-nix, plutus, ... }:
     let
       supportedSystems = with nixpkgs.lib.systems.supported;
         tier1 ++ tier2 ++ tier3;
@@ -96,255 +29,89 @@
           overlays = [ haskell-nix.overlay ];
           inherit (haskell-nix) config;
         };
+      nixpkgsFor' = system:
+        import nixpkgs {
+          inherit system;
+          inherit (haskell-nix) config;
+        };
 
-      deferPluginErrors = true;
+      ghcVersion = "ghc921";
-      plutarch-development = true;
 
       projectFor = system:
         let pkgs = nixpkgsFor system;
+        in let pkgs' = nixpkgsFor' system;
         in (nixpkgsFor system).haskell-nix.cabalProject' {
           src = ./.;
-          compiler-nix-name = "ghc8107";
+          compiler-nix-name = ghcVersion;
-          cabalProjectFileName = "cabal.project";
+          inherit (plutarch) cabalProjectLocal;
+          extraSources = plutarch.extraSources ++ [{
+            src = inputs.plutarch;
+            subdirs = [ "." ];
+          }
 
-          # This essentially replaces 'cabal-haskell.nix.project'
+            ];
-          extraSources = [
+          modules = [ (plutarch.haskellModule system) ];
-            {
-              src = inputs.cardano-prelude;
-              subdirs = [ "cardano-prelude" "cardano-prelude-test" ];
-            }
-            {
-              src = inputs.cardano-base;
-              subdirs = [
-                "base-deriving-via"
-                "binary"
-                "binary/test"
-                "cardano-crypto-class"
-                "cardano-crypto-praos"
-                "cardano-crypto-tests"
-                "measures"
-                "orphans-deriving-via"
-                "slotting"
-                "strict-containers"
-              ];
-            }
-
-            {
-              src = inputs.iohk-monitoring-framework;
-              subdirs = [
-                "iohk-monitoring"
-                "tracer-transformers"
-                "contra-tracer"
-                "plugins/backend-aggregation"
-                "plugins/backend-ekg"
-                "plugins/backend-monitoring"
-                "plugins/backend-trace-forwarder"
-                "plugins/scribe-systemd"
-              ];
-            }
-            {
-              src = inputs.cardano-ledger-specs;
-              subdirs = [
-                "byron/ledger/impl"
-                "cardano-ledger-core"
-                "cardano-protocol-tpraos"
-                "eras/alonzo/impl"
-                "eras/byron/chain/executable-spec"
-                "eras/byron/crypto"
-                "eras/byron/crypto/test"
-                "eras/byron/ledger/executable-spec"
-                "eras/byron/ledger/impl/test"
-                "eras/shelley/impl"
-                "eras/shelley-ma/impl"
-                "eras/shelley/chain-and-ledger/executable-spec"
-                "eras/shelley/test-suite"
-                "shelley/chain-and-ledger/shelley-spec-ledger-test"
-                "libs/non-integral"
-                "libs/small-steps"
-                "libs/cardano-ledger-pretty"
-                "semantics/small-steps-test"
-              ];
-            }
-            {
-              src = inputs.ouroboros-network;
-              subdirs = [
-                "monoidal-synchronisation"
-                "typed-protocols"
-                "typed-protocols-cborg"
-                "typed-protocols-examples"
-                "ouroboros-network"
-                "ouroboros-network-testing"
-                "ouroboros-network-framework"
-                "ouroboros-consensus"
-                "ouroboros-consensus-byron"
-                "ouroboros-consensus-cardano"
-                "ouroboros-consensus-shelley"
-                "io-sim"
-                "io-classes"
-                "network-mux"
-                "ntp-client"
-              ];
-            }
-            {
-              src = inputs.servant-purescript;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.purescript-bridge;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.plutarch;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.cardano-addresses;
-              subdirs = [ "core" "command-line" ];
-            }
-            {
-              src = inputs.goblins;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.optparse-applicative;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.cardano-crypto;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.Win32-network;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.flat;
-              subdirs = [ "." ];
-            }
-            {
-              src = inputs.cardano-wallet;
-              subdirs = [
-                "lib/text-class"
-                "lib/strict-non-empty-containers"
-                "lib/core"
-                "lib/test-utils"
-                "lib/numeric"
-                "lib/launcher"
-                "lib/core-integration"
-                "lib/cli"
-                "lib/dbvar"
-                "lib/shelley"
-              ];
-            }
-
-            {
-              src = inputs.plutus-apps;
-              subdirs = [
-                "doc"
-                "freer-extras"
-                "playground-common"
-                "plutus-chain-index"
-                "plutus-chain-index-core"
-                "plutus-contract"
-                "plutus-ledger"
-                "plutus-ledger-constraints"
-                "plutus-pab"
-                "plutus-playground-server"
-                "plutus-use-cases"
-                "quickcheck-dynamic"
-                "web-ghc"
-              ];
-            }
-            {
-              src = inputs.cardano-node;
-              subdirs =
-                [ "cardano-api" "cardano-node" "cardano-cli" "cardano-config" ];
-            }
-            {
-              src = inputs.plutus-extra;
-              subdirs = [
-                "tasty-plutus"
-                "plutus-pretty"
-                "plutus-numeric"
-                "plutus-extra"
-                "plutus-golden"
-                "plutus-laws"
-                "quickcheck-plutus-instances"
-
-              ];
-            }
-            {
-              src = inputs.plutus;
-              subdirs = [
-                "plutus-benchmark"
-                "plutus-core"
-                "plutus-errors"
-                "plutus-ledger-api"
-                "plutus-metatheory"
-                "plutus-tx"
-                "plutus-tx-plugin"
-                "prettyprinter-configurable"
-                "word-array"
-                "stubs/plutus-ghc-stub"
-              ];
-            }
-          ];
-          modules = [{
-            packages = {
-
-              plutarch.flags.development = plutarch-development;
-              marlowe.flags.defer-plugin-errors = deferPluginErrors;
-              plutus-use-cases.flags.defer-plugin-errors = deferPluginErrors;
-              plutus-ledger.flags.defer-plugin-errors = deferPluginErrors;
-              plutus-contract.flags.defer-plugin-errors = deferPluginErrors;
-              cardano-crypto-praos.components.library.pkgconfig =
-                nixpkgs.lib.mkForce
-                [ [ (import plutus { inherit system; }).pkgs.libsodium-vrf ] ];
-              cardano-crypto-class.components.library.pkgconfig =
-                nixpkgs.lib.mkForce
-                [ [ (import plutus { inherit system; }).pkgs.libsodium-vrf ] ];
-            };
-          }];
           shell = {
             withHoogle = true;
 
             exactDeps = true;
 
-            nativeBuildInputs = with pkgs; [
+            # We use the ones from Nixpkgs, since they are cached reliably.
-              cabal-install
+            # Eventually we will probably want to build these with haskell.nix.
-              hlint
+            nativeBuildInputs = [
-              haskellPackages.fourmolu
+              pkgs'.git
-              nixfmt
+              pkgs'.haskellPackages.apply-refact
-              haskellPackages.cabal-fmt
+              pkgs'.fd
-              haskellPackages.apply-refact
+              pkgs'.cabal-install
-              haskellPackages.record-dot-preprocessor
+              pkgs'.hlint
-              entr
+              pkgs'.haskellPackages.cabal-fmt
-              gnumake
+              pkgs'.nixpkgs-fmt
-
-              graphviz
             ];
 
-            additional = ps: [ ps.plutarch ps.plutus-ledger ps.plutus-extra ];
+            inherit (plutarch) tools;
 
-            tools.haskell-language-server = { };
+            additional = ps: [ ps.plutarch ps.tasty-quickcheck ];
           };
         };
+
+      formatCheckFor = system:
+        let
+          pkgs = nixpkgsFor system;
+          pkgs' = nixpkgsFor' system;
+        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 {
       project = perSystem projectFor;
       flake = perSystem (system: (projectFor system).flake { });
 
       packages = perSystem (system: self.flake.${system}.packages);
-      checks = perSystem (system: self.flake.${system}.checks);
+      checks = perSystem (system:
+        self.flake.${system}.checks // {
+          formatCheck = formatCheckFor system;
+        });
       check = perSystem (system:
         (nixpkgsFor system).runCommand "combined-test" {
-          nativeBuildInputs = builtins.attrValues self.checks.${system};
+          checksss = builtins.attrValues self.checks.${system};
-        } "touch $out");
+        } ''
-      apps = perSystem (system: self.flake.${system}.apps);
+          echo $checksss
-      devShell = perSystem (system:
+          touch $out
-        self.flake.${system}.devShell.overrideAttrs (oldAttrs: {
+        '');
-          buildInputs = (nixpkgsFor system).lib.unique oldAttrs.buildInputs;
+      devShell = perSystem (system: self.flake.${system}.devShell);
-        }));
-      defaultPackage =
-        perSystem (system: self.flake.${system}.packages."agora:lib:agora");
     };
 }

src/Agora/AuthorityToken.hs

@@ -3,19 +3,22 @@ module Agora.AuthorityToken (
   AuthorityToken (..),
 ) where
 
---------------------------------------------------------------------------------
+import Plutarch.Api.V1 (
+  PCurrencySymbol,
+  PMap (..),
+  PScriptContext (..),
+  PScriptPurpose (..),
+  PTokenName,
+  PTxInInfo (..),
+  PTxInfo (..),
+  PTxOut (..),
+  PValue (..),
+ )
+import Plutarch.List (pfoldr')
+import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
 
 import Prelude
 
---------------------------------------------------------------------------------
-import Plutus.V1.Ledger.Value (AssetClass (..))
-
---------------------------------------------------------------------------------
-
-import Plutarch.Api.V1
-import Plutarch.List (pfoldr')
-import Plutarch.Prelude
-
 --------------------------------------------------------------------------------
 
 {- | An AuthorityToken represents a proof that a particular token
@@ -25,8 +28,8 @@ import Plutarch.Prelude
      _this_ token's existence in order to prevent incorrect minting.
 -}
 newtype AuthorityToken = AuthorityToken
-  { -- | Token that must move in order for minting this to be valid.
+  { authority :: AssetClass
-    authority :: AssetClass
+  -- ^ Token that must move in order for minting this to be valid.
   }
 
 --------------------------------------------------------------------------------

src/PPrelude.hs

@@ -0,0 +1,7 @@
+module PPrelude (
+  module Prelude,
+  module Plutarch.Prelude,
+) where
+
+import Plutarch.Prelude
+import Prelude