Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into emiflake/bench

Browse source
This commit is contained in:
Emily Martins 2022-02-16 15:20:32 +01:00
commit 52edf4f01b
9 changed files with 231 additions and 1172 deletions
Download patch file Download diff file Expand all files Collapse all files

4
.github/format.sh vendored
View file

@ -1,6 +1,6 @@
#!/bin/bash
# Extensions necessary to tell fourmolu about
EXTENSIONS="-o -XTypeApplications -o -XTemplateHaskell -o -XImportQualifiedPost -o -XPatternSynonyms -o -fplugin=RecordDotPreprocessor"
EXTENSIONS="-o -XTypeApplications -o -XTemplateHaskell -o -XImportQualifiedPost -o -XPatternSynonyms -o -XOverloadedRecordDot"
SOURCES=$(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs')
nix run nixpkgs#haskellPackages.fourmolu -- --mode check --check-idempotence $EXTENSIONS $SOURCES
nix run nixpkgs#haskell.packages.ghc921.fourmolu -- --mode check --check-idempotence $EXTENSIONS $SOURCES

2
Makefile
View file

@ -13,7 +13,7 @@ HOOGLE_PORT=8081
hoogle:
hoogle server --local --port $(HOOGLE_PORT) > /dev/null &
FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -fplugin=RecordDotPreprocessor
FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -XOverloadedRecordDot
format:
find -name '*.hs' -not -path './dist-*/*' | xargs fourmolu $(FORMAT_EXTENSIONS) -m inplace
git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.nix' | xargs nixfmt

76
agora.cabal
View file

@ -9,72 +9,95 @@ 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
GeneralizedNewtypeDeriving
ForeignFunctionInterface
GADTSyntax
GeneralisedNewtypeDeriving
HexFloatLiterals
ImplicitPrelude
ImportQualifiedPost
InstanceSigs
KindSignatures
LambdaCase
MonomorphismRestriction
MultiParamTypeClasses
NamedFieldPuns
NamedWildCards
NumericUnderscores
OverloadedStrings
QuasiQuotes
PartialTypeSignatures
PatternGuards
PolyKinds
PostfixOperators
RankNTypes
RelaxedPolyRec
ScopedTypeVariables
StandaloneDeriving
StandaloneKindSignatures
TupleSections
TypeApplications
TypeFamilies
TypeOperators
TypeSynonymInstances
UndecidableInstances
ViewPatterns
OverloadedRecordDot
QualifiedDo
ghc-options:
-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
default-language: Haskell2010
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-ledger
, plutus-ledger-api
, plutus-tx
, pprelude
, prettyprinter
, record-dot-preprocessor
, record-hasfield
, recursion-schemes
, serialise
, template-haskell
@ -84,12 +107,8 @@ common test-deps
build-depends:
, QuickCheck
, quickcheck-instances
, tagged
, tasty
, tasty-hunit
, utf8-string
--------------------------------------------------------------------------------
, tasty-quickcheck
library
import: lang, deps
@ -97,6 +116,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

2
bench.csv
View file

@ -1,2 +1,2 @@
name,cpu,mem,size
full scripts:authorityTokenPolicy,1399431,4800,363
full_scripts:authorityTokenPolicy,1280339,4400,284

1 name cpu mem size
2 full scripts:authorityTokenPolicy full_scripts:authorityTokenPolicy 1399431 1280339 4800 4400 363 284

40
cabal.project
View file

@ -1,42 +1,4 @@
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
tests: true

869
flake.lock generated
View file

File diff suppressed because it is too large Load diff

374
flake.nix
View file

@ -1,89 +1,18 @@
{
description = "agora";
inputs.haskell-nix.url =
"github:input-output-hk/haskell.nix?rev=4aeeba8d713d0b98c92c8c717df24da17d463c1d";
inputs.nixpkgs.follows = "haskell-nix/nixpkgs-unstable";
inputs.haskell-nix.inputs.nixpkgs.follows = "haskell-nix/nixpkgs-unstable";
inputs.nixpkgs.follows = "plutarch/nixpkgs";
inputs.haskell-nix.follows = "plutarch/haskell-nix";
# Temp workaround for Nix issue.
inputs.nixpkgs-2111.url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin";
# 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.plutus.url =
"github:input-output-hk/plutus?rev=65bad0fd53e432974c3c203b1b1999161b6c2dce";
inputs.plutarch.url = "github:Plutonomicon/plutarch";
inputs.plutarch.inputs.nixpkgs.follows =
"plutarch/haskell-nix/nixpkgs-unstable";
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 =
"github:input-output-hk/cardano-node?rev=b6ca519f97a0e795611a63174687e6bb70c9f752";
inputs.cardano-node.flake = false;
inputs.cardano-wallet.url =
"github:j-mueller/cardano-wallet?rev=760140e238a5fbca61d1b286d7a80ece058dc729";
inputs.cardano-wallet.flake = false;
inputs.purescript-bridge.url =
"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, ... }:
outputs = inputs@{ self, nixpkgs, haskell-nix, plutarch, ... }:
let
supportedSystems = with nixpkgs.lib.systems.supported;
tier1 ++ tier2 ++ tier3;
@ -96,259 +25,92 @@
overlays = [ haskell-nix.overlay ];
inherit (haskell-nix) config;
};
nixpkgsFor' = system:
import nixpkgs {
inherit system;
inherit (haskell-nix) config;
};
deferPluginErrors = true;
plutarch-development = true;
ghcVersion = "ghc921";
projectFor = system:
let pkgs = nixpkgsFor system;
in let pkgs' = nixpkgsFor' system;
in (nixpkgsFor system).haskell-nix.cabalProject' {
src = ./.;
compiler-nix-name = "ghc8107";
cabalProjectFileName = "cabal.project";
# This essentially replaces 'cabal-haskell.nix.project'
extraSources = [
{
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 = [ "." "plutarch-benchmark" ];
}
{
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 ] ];
};
compiler-nix-name = ghcVersion;
inherit (plutarch) cabalProjectLocal;
extraSources = plutarch.extraSources ++ [{
src = inputs.plutarch;
subdirs = [ "." "plutarch-benchmark" ];
}];
modules = [ (plutarch.haskellModule system) ];
shell = {
withHoogle = true;
exactDeps = true;
nativeBuildInputs = with pkgs; [
cabal-install
hlint
haskellPackages.fourmolu
nixfmt
haskellPackages.cabal-fmt
haskellPackages.apply-refact
haskellPackages.record-dot-preprocessor
entr
gnumake
graphviz
# 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'.hlint
pkgs'.haskellPackages.cabal-fmt
pkgs'.nixpkgs-fmt
];
inherit (plutarch) tools;
additional = ps: [
ps.plutarch
ps.plutarch-benchmark
ps.plutus-ledger
ps.plutus-extra
ps.tasty-quickcheck
];
tools.haskell-language-server = { };
};
};
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};
} "touch $out");
apps = perSystem (system: self.flake.${system}.apps);
devShell = perSystem (system:
self.flake.${system}.devShell.overrideAttrs (oldAttrs: {
buildInputs = (nixpkgsFor system).lib.unique oldAttrs.buildInputs;
}));
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");
};

27
src/Agora/AuthorityToken.hs
View file

@ -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.
}
--------------------------------------------------------------------------------

7
src/PPrelude.hs Normal file
View file

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