Merge pull request #104 from Liqwid-Labs/seungheonoh/newPlutarchCleanTree
Liqwid-Labs/Plutarch
This commit is contained in:
commit
45095ffc8a
26 changed files with 6538 additions and 468 deletions
77
.github/workflows/integrate.yaml
vendored
77
.github/workflows/integrate.yaml
vendored
|
|
@ -15,11 +15,21 @@ on:
|
|||
- "flake.lock"
|
||||
- "agora.cabal"
|
||||
jobs:
|
||||
check-formatting:
|
||||
flake:
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
matrix:
|
||||
tasks: ["agora", "formatCheck", "benchCheck"]
|
||||
steps:
|
||||
- uses: actions/checkout@v2.4.0
|
||||
|
||||
- uses: webfactory/ssh-agent@v0.5.4
|
||||
with:
|
||||
ssh-private-key: |
|
||||
${{ secrets.LIQWID_PLUTARCH_EXTRA_PRIVATE }}
|
||||
${{ secrets.PLUTARCH_NUMERIC_PRIVATE }}
|
||||
${{ secrets.PLUTARCH_SAFE_MONEY_PRIVATE }}
|
||||
|
||||
- uses: cachix/install-nix-action@v16
|
||||
name: Set up Nix and IOHK caches
|
||||
with:
|
||||
|
|
@ -34,67 +44,20 @@ jobs:
|
|||
name: mlabs
|
||||
authToken: ${{ secrets.CACHIX_KEY }}
|
||||
|
||||
- run: nix build .#checks.x86_64-linux.formatCheck
|
||||
name: Run 'formatCheck' from flake.nix
|
||||
|
||||
check-bench:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2.4.0
|
||||
|
||||
- uses: cachix/install-nix-action@v16
|
||||
name: Set up Nix and IOHK caches
|
||||
with:
|
||||
nix_path: nixpkgs=channel:nixos-unstable
|
||||
extra_nix_config: |
|
||||
trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
|
||||
substituters = https://hydra.iohk.io https://iohk.cachix.org https://cache.nixos.org/
|
||||
experimental-features = nix-command flakes
|
||||
|
||||
- uses: cachix/cachix-action@v10
|
||||
with:
|
||||
name: mlabs
|
||||
authToken: ${{ secrets.CACHIX_KEY }}
|
||||
|
||||
- run: nix build .#checks.x86_64-linux.benchCheck
|
||||
name: Run 'benchCheck' from flake.nix
|
||||
|
||||
check-build:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2.4.0
|
||||
|
||||
- uses: cachix/install-nix-action@v16
|
||||
name: Set up Nix and IOHK caches
|
||||
with:
|
||||
nix_path: nixpkgs=channel:nixos-unstable
|
||||
extra_nix_config: |
|
||||
trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
|
||||
substituters = https://hydra.iohk.io https://iohk.cachix.org https://cache.nixos.org/
|
||||
experimental-features = nix-command flakes
|
||||
|
||||
- uses: cachix/cachix-action@v10
|
||||
with:
|
||||
name: mlabs
|
||||
authToken: ${{ secrets.CACHIX_KEY }}
|
||||
|
||||
- name: Add cabal folder to cache
|
||||
id: cabal
|
||||
uses: actions/cache@v2.1.4
|
||||
with:
|
||||
path: |
|
||||
~/.cabal/packages
|
||||
~/.cabal/store
|
||||
dist-newstyle
|
||||
key: ${{ runner.os }}-cabal
|
||||
|
||||
- name: Build the project
|
||||
run: nix build .#check.x86_64-linux
|
||||
- run: nix build .#checks.x86_64-linux.${{ matrix.tasks }}
|
||||
name: Run '${{ matrix.tasks }}' from flake.nix
|
||||
|
||||
haddock:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2.4.0
|
||||
|
||||
- uses: webfactory/ssh-agent@v0.5.4
|
||||
with:
|
||||
ssh-private-key: |
|
||||
${{ secrets.LIQWID_PLUTARCH_EXTRA_PRIVATE }}
|
||||
${{ secrets.PLUTARCH_NUMERIC_PRIVATE }}
|
||||
${{ secrets.PLUTARCH_SAFE_MONEY_PRIVATE }}
|
||||
|
||||
- uses: cachix/install-nix-action@v16
|
||||
name: Set up Nix and IOHK caches
|
||||
|
|
|
|||
|
|
@ -22,11 +22,8 @@ import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Tagged (Tagged (..))
|
||||
import Plutarch.Api.V1 (mkValidator, validatorHash)
|
||||
import Plutarch.SafeMoney (Tagged (Tagged))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutus.V1.Ledger.Address (scriptHashAddress)
|
||||
import Plutus.V1.Ledger.Api (
|
||||
Address,
|
||||
|
|
|
|||
|
|
@ -14,8 +14,8 @@ module Sample.Governor (
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Api.V1 (mkValidator, validatorHash)
|
||||
import Plutarch.SafeMoney.Tagged
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -20,7 +20,6 @@ module Sample.Proposal (
|
|||
import Plutarch.Api.V1 (
|
||||
validatorHash,
|
||||
)
|
||||
import Plutarch.SafeMoney (Tagged (Tagged), untag)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -57,9 +56,7 @@ import Agora.Proposal (
|
|||
)
|
||||
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
|
||||
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Sample.Shared
|
||||
import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap)
|
||||
|
||||
|
|
|
|||
|
|
@ -86,13 +86,13 @@ import Agora.Stake (Stake (..))
|
|||
import Agora.Treasury (treasuryValidator)
|
||||
import Agora.Utils (validatorHashToTokenName)
|
||||
import Data.Default.Class (Default (..))
|
||||
import Data.Tagged (Tagged (..))
|
||||
import Plutarch.Api.V1 (
|
||||
mintingPolicySymbol,
|
||||
mkMintingPolicy,
|
||||
mkValidator,
|
||||
validatorHash,
|
||||
)
|
||||
import Plutarch.SafeMoney
|
||||
import Plutus.V1.Ledger.Address (scriptHashAddress)
|
||||
import Plutus.V1.Ledger.Api (
|
||||
Address (Address),
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ import Plutus.V1.Ledger.Value qualified as Value
|
|||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Plutarch.SafeMoney
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Sample.Shared
|
||||
import Test.Util (datumPair, toDatumHash)
|
||||
|
||||
|
|
|
|||
|
|
@ -27,10 +27,10 @@ import Agora.Stake.Scripts (stakePolicy, stakeValidator)
|
|||
import Agora.Treasury (treasuryValidator)
|
||||
import Control.Monad ((>=>))
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.Tagged (Tagged)
|
||||
import GHC.Generics qualified as GHC
|
||||
import Options (Options (..), parseOptions)
|
||||
import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy)
|
||||
import Plutarch.SafeMoney (Tagged)
|
||||
import Plutus.V1.Ledger.Api (TxOutRef)
|
||||
import Plutus.V1.Ledger.Value (AssetClass, CurrencySymbol)
|
||||
import Plutus.V1.Ledger.Value qualified as Value
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ import Agora.Stake (
|
|||
)
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Plutarch.SafeMoney (Tagged (Tagged))
|
||||
import Data.Tagged (Tagged (Tagged))
|
||||
import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..))
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Proposal qualified as Proposal
|
||||
|
|
|
|||
10
agora.cabal
10
agora.cabal
|
|
@ -62,6 +62,7 @@ common lang
|
|||
NumericUnderscores
|
||||
OverloadedLabels
|
||||
OverloadedStrings
|
||||
PackageImports
|
||||
PartialTypeSignatures
|
||||
PatternGuards
|
||||
PolyKinds
|
||||
|
|
@ -87,7 +88,7 @@ common deps
|
|||
build-depends:
|
||||
, aeson
|
||||
, ansi-terminal
|
||||
, base >=4.14 && <5
|
||||
, base >=4.14 && <5
|
||||
, base-compat
|
||||
, bytestring
|
||||
, cardano-prelude
|
||||
|
|
@ -95,10 +96,11 @@ common deps
|
|||
, data-default
|
||||
, data-default-class
|
||||
, generics-sop
|
||||
, liqwid-plutarch-extra
|
||||
, plutarch
|
||||
, plutarch-extra
|
||||
, plutarch-numeric
|
||||
, plutarch-safemoney
|
||||
, plutarch-safe-money
|
||||
, plutus-core
|
||||
, plutus-ledger-api
|
||||
, plutus-tx
|
||||
|
|
@ -106,9 +108,12 @@ common deps
|
|||
, prettyprinter
|
||||
, recursion-schemes
|
||||
, serialise
|
||||
, tagged
|
||||
, template-haskell
|
||||
, text
|
||||
|
||||
mixins:
|
||||
|
||||
common test-deps
|
||||
build-depends:
|
||||
, agora
|
||||
|
|
@ -147,7 +152,6 @@ library
|
|||
Agora.Stake.Scripts
|
||||
Agora.Treasury
|
||||
Agora.Utils
|
||||
Agora.Utils.Value
|
||||
|
||||
other-modules: Agora.Aeson.Orphans
|
||||
hs-source-dirs: agora
|
||||
|
|
|
|||
|
|
@ -24,9 +24,9 @@ import Plutarch.Api.V1 (
|
|||
PTxInfo (..),
|
||||
PTxOut (..),
|
||||
)
|
||||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf)
|
||||
import Plutarch.Api.V1.AssocMap (PMap (PMap))
|
||||
import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf)
|
||||
import Plutarch.Api.V1.Value (PValue (PValue))
|
||||
import "plutarch" Plutarch.Api.V1.Value (PValue (PValue))
|
||||
import Plutarch.Builtin (pforgetData)
|
||||
import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ module Agora.Effect (makeEffect) where
|
|||
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
||||
import Agora.Utils (tcassert, tclet, tcmatch, tctryFrom)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue)
|
||||
import Plutarch.TryFrom (PTryFrom)
|
||||
import Plutarch.TryFrom ()
|
||||
import Plutus.V1.Ledger.Value (CurrencySymbol)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ import Plutarch.Api.V1 (
|
|||
PValidator,
|
||||
PValue,
|
||||
)
|
||||
import Plutarch.Api.V1.Extra (pvalueOf)
|
||||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pvalueOf)
|
||||
import Plutarch.DataRepr (
|
||||
DerivePConstantViaData (..),
|
||||
PDataFields,
|
||||
|
|
|
|||
|
|
@ -48,13 +48,16 @@ import Agora.Utils (tclet)
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Tagged (Tagged (..))
|
||||
import Plutarch.DataRepr (
|
||||
DerivePConstantViaData (..),
|
||||
PDataFields,
|
||||
PIsDataReprInstances (PIsDataReprInstances),
|
||||
)
|
||||
import Plutarch.Extra.Comonad (pextract)
|
||||
import Plutarch.Extra.TermCont (pmatchC)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||
import Plutarch.SafeMoney (Tagged (..), puntag)
|
||||
import Plutarch.SafeMoney (PDiscrete (..))
|
||||
import Plutarch.TryFrom (PTryFrom (..))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
|
||||
|
|
@ -188,9 +191,13 @@ governorDatumValid = phoistAcyclic $
|
|||
pletFields @'["execute", "draft", "vote"] $
|
||||
pfield @"proposalThresholds" # datum
|
||||
|
||||
execute <- tclet $ puntag thresholds.execute
|
||||
draft <- tclet $ puntag thresholds.draft
|
||||
vote <- tclet $ puntag thresholds.vote
|
||||
PDiscrete execute' <- pmatchC thresholds.execute
|
||||
PDiscrete draft' <- pmatchC thresholds.draft
|
||||
PDiscrete vote' <- pmatchC thresholds.vote
|
||||
|
||||
execute <- tclet $ pextract # execute'
|
||||
draft <- tclet $ pextract # draft'
|
||||
vote <- tclet $ pextract # vote'
|
||||
|
||||
pure $
|
||||
foldr1
|
||||
|
|
|
|||
|
|
@ -110,21 +110,19 @@ import Plutarch.Api.V1 (
|
|||
mkValidator,
|
||||
validatorHash,
|
||||
)
|
||||
import Plutarch.Api.V1.Extra (
|
||||
import Plutarch.Api.V1.AssetClass (
|
||||
passetClass,
|
||||
passetClassValueOf,
|
||||
)
|
||||
import Plutarch.Map.Extra (
|
||||
import Plutarch.Extra.Comonad (pextract)
|
||||
import Plutarch.Extra.Map (
|
||||
pkeys,
|
||||
plookup,
|
||||
plookup',
|
||||
)
|
||||
import Plutarch.SafeMoney (
|
||||
PDiscrete,
|
||||
puntag,
|
||||
pvalueDiscrete',
|
||||
)
|
||||
import Plutarch.TryFrom (ptryFrom)
|
||||
import Plutarch.Extra.TermCont (pmatchC)
|
||||
import Plutarch.SafeMoney (PDiscrete (..), pvalueDiscrete')
|
||||
import Plutarch.TryFrom ()
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -629,8 +627,9 @@ governorValidator gov =
|
|||
|
||||
winner <- tclet $ mustBePJust # "No winning outcome" # maybeWinner
|
||||
|
||||
PDiscrete minimumVotes' <- pmatchC $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds
|
||||
let highestVote = pfromData $ psndBuiltin # winner
|
||||
minimumVotes = puntag $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds
|
||||
minimumVotes = pextract # minimumVotes'
|
||||
|
||||
tcassert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote
|
||||
|
||||
|
|
|
|||
|
|
@ -51,13 +51,14 @@ import Agora.SafeMoney (GTTag)
|
|||
import Agora.Utils (pkeysEqual, pmapMap, pnotNull)
|
||||
import Control.Applicative (Const)
|
||||
import Control.Arrow (first)
|
||||
import Data.Tagged (Tagged)
|
||||
import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
|
||||
import Plutarch.Lift (
|
||||
DerivePConstantViaNewtype (..),
|
||||
PConstantDecl,
|
||||
PUnsafeLiftDecl (..),
|
||||
)
|
||||
import Plutarch.SafeMoney (PDiscrete, Tagged)
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash)
|
||||
|
|
|
|||
|
|
@ -44,9 +44,11 @@ import Plutarch.Api.V1 (
|
|||
PTxInfo (PTxInfo),
|
||||
PValidator,
|
||||
)
|
||||
import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf)
|
||||
import Plutarch.Map.Extra (plookup)
|
||||
import Plutarch.SafeMoney (puntag)
|
||||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf)
|
||||
import Plutarch.Extra.Comonad (pextract)
|
||||
import Plutarch.Extra.Map (plookup)
|
||||
import Plutarch.Extra.TermCont (pmatchC)
|
||||
import Plutarch.SafeMoney (PDiscrete (..))
|
||||
import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
|
||||
|
||||
{- | Policy for Proposals.
|
||||
|
|
@ -253,8 +255,9 @@ proposalValidator proposal =
|
|||
PProposalVotes $
|
||||
pupdate
|
||||
# plam
|
||||
( \votes ->
|
||||
pcon $ PJust $ votes + (puntag stakeInF.stakedAmount)
|
||||
( \votes -> unTermCont $ do
|
||||
PDiscrete v <- pmatchC stakeInF.stakedAmount
|
||||
pure $ pcon $ PJust $ votes + (pextract # v)
|
||||
)
|
||||
# voteFor
|
||||
# m
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ import Plutarch.Lift (
|
|||
PConstantDecl,
|
||||
PUnsafeLiftDecl (..),
|
||||
)
|
||||
import Plutarch.Numeric (AdditiveSemigroup ((+)))
|
||||
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import Plutus.V1.Ledger.Time (POSIXTime)
|
||||
import PlutusTx qualified
|
||||
|
|
@ -259,7 +259,7 @@ isDraftPeriod ::
|
|||
)
|
||||
isDraftPeriod = phoistAcyclic $
|
||||
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
|
||||
proposalTimeWithin # s # (s + pfield @"draftTime" # config)
|
||||
proposalTimeWithin # s # (s + (pfield @"draftTime" # config))
|
||||
|
||||
-- | True if the 'PProposalTime' is in the voting period.
|
||||
isVotingPeriod ::
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ module Agora.SafeMoney (
|
|||
|
||||
import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
|
||||
|
||||
import Plutarch.SafeMoney
|
||||
import Data.Tagged (Tagged (Tagged))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Tags
|
||||
|
|
|
|||
|
|
@ -66,12 +66,9 @@ import Agora.Utils (
|
|||
tcmatch,
|
||||
)
|
||||
import Control.Applicative (Const)
|
||||
import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf)
|
||||
import Plutarch.Numeric ()
|
||||
import Plutarch.SafeMoney (
|
||||
PDiscrete,
|
||||
Tagged (..),
|
||||
)
|
||||
import Data.Tagged (Tagged (..))
|
||||
import Plutarch.Api.V1.AssetClass (PAssetClass, passetClassValueOf)
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ import Agora.Utils (
|
|||
tcmatch,
|
||||
tctryFrom,
|
||||
)
|
||||
import Data.Tagged (Tagged (..), untag)
|
||||
import Plutarch.Api.V1 (
|
||||
PCredential (PPubKeyCredential, PScriptCredential),
|
||||
PMintingPolicy,
|
||||
|
|
@ -37,14 +38,12 @@ import Plutarch.Api.V1 (
|
|||
mintingPolicySymbol,
|
||||
mkMintingPolicy,
|
||||
)
|
||||
import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf, pvalueOf)
|
||||
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
|
||||
import Plutarch.Internal (punsafeCoerce)
|
||||
import Plutarch.Numeric
|
||||
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
||||
import Plutarch.SafeMoney (
|
||||
Tagged (..),
|
||||
pdiscreteValue',
|
||||
pvalueDiscrete',
|
||||
untag,
|
||||
)
|
||||
import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
|
||||
import Prelude hiding (Num (..))
|
||||
|
|
|
|||
|
|
@ -16,13 +16,13 @@ import GHC.Generics qualified as GHC
|
|||
import Generics.SOP
|
||||
import Plutarch.Api.V1 (PValidator)
|
||||
import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting))
|
||||
import Plutarch.Api.V1.Value (PValue)
|
||||
import "plutarch" Plutarch.Api.V1.Value (PValue)
|
||||
import Plutarch.DataRepr (
|
||||
DerivePConstantViaData (..),
|
||||
PIsDataReprInstances (PIsDataReprInstances),
|
||||
)
|
||||
import Plutarch.Lift (PConstantDecl (..), PLifted (..), PUnsafeLiftDecl)
|
||||
import Plutarch.TryFrom (PTryFrom)
|
||||
import Plutarch.TryFrom ()
|
||||
import Plutus.V1.Ledger.Value (CurrencySymbol)
|
||||
import PlutusTx qualified
|
||||
|
||||
|
|
|
|||
|
|
@ -96,13 +96,13 @@ import Plutarch.Api.V1 (
|
|||
mintingPolicySymbol,
|
||||
mkMintingPolicy,
|
||||
)
|
||||
import Plutarch.Api.V1.AssetClass (PAssetClass, passetClassValueOf, pvalueOf)
|
||||
import Plutarch.Api.V1.AssocMap (PMap (PMap))
|
||||
import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf)
|
||||
import Plutarch.Api.V1.Value (PValue (PValue))
|
||||
import "plutarch" Plutarch.Api.V1.Value (PValue (PValue))
|
||||
import Plutarch.Builtin (pforgetData, ppairDataBuiltin)
|
||||
import Plutarch.Map.Extra (pkeys)
|
||||
import Plutarch.Extra.Map (pkeys)
|
||||
import Plutarch.Reducible (Reducible (Reduce))
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess), ptryFrom)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- TermCont-based combinators. Some of these will live in plutarch eventually.
|
||||
|
|
|
|||
|
|
@ -1,93 +0,0 @@
|
|||
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
||||
|
||||
module Agora.Utils.Value (pgeq, pleq, pgt, plt) where
|
||||
|
||||
import Agora.Utils (tcmatch)
|
||||
import Plutarch.Api.V1.AssocMap (PMap (PMap))
|
||||
import Plutarch.Api.V1.These (PTheseData (..))
|
||||
import Plutarch.Api.V1.Tuple (ptupleFromBuiltin)
|
||||
import Plutarch.Api.V1.Value (PCurrencySymbol, PTokenName, PValue)
|
||||
import Plutarch.Lift (PUnsafeLiftDecl)
|
||||
import Plutarch.List (pconvertLists)
|
||||
import Plutarch.Monadic qualified as P
|
||||
|
||||
punionVal ::
|
||||
Term
|
||||
s
|
||||
( PValue
|
||||
:--> PValue
|
||||
:--> PMap
|
||||
PCurrencySymbol
|
||||
(PMap PTokenName (PTheseData PInteger PInteger))
|
||||
)
|
||||
punionVal = undefined
|
||||
|
||||
-- | Determines if a condition is true for all values in a map.
|
||||
pmapAll ::
|
||||
(PUnsafeLiftDecl v, PIsData v) =>
|
||||
Term s ((v :--> PBool) :--> PMap k v :--> PBool)
|
||||
pmapAll = plam $ \f m -> unTermCont $ do
|
||||
PMap builtinMap <- tcmatch m
|
||||
|
||||
let getV = plam $ \bip ->
|
||||
let tuple = pfromData $ ptupleFromBuiltin (pdata bip)
|
||||
in pfromData $ pfield @"_1" # tuple
|
||||
|
||||
let vs = pmap # getV # builtinMap
|
||||
pure $ pall # f # vs
|
||||
|
||||
pcheckPred ::
|
||||
forall {s :: S}.
|
||||
Term
|
||||
s
|
||||
( (PTheseData PInteger PInteger :--> PBool)
|
||||
:--> PValue
|
||||
:--> PValue
|
||||
:--> PBool
|
||||
)
|
||||
pcheckPred = plam $ \_f _l _r -> undefined
|
||||
|
||||
-- let inner :: Term s (PMap PTokenName (PTheseData PInteger PInteger) :--> PBool)
|
||||
-- inner = pmapAll # f
|
||||
-- pmapAll # inner # (punionVal # l # r)
|
||||
|
||||
pcheckBinRel ::
|
||||
forall {s :: S}.
|
||||
Term
|
||||
s
|
||||
( (PInteger :--> PInteger :--> PBool)
|
||||
:--> PValue
|
||||
:--> PValue
|
||||
:--> PBool
|
||||
)
|
||||
pcheckBinRel = plam $ \f l r ->
|
||||
let unThese :: Term s (PTheseData PInteger PInteger :--> PBool)
|
||||
unThese = plam $ \k' ->
|
||||
pmatch k' $ \case
|
||||
PDThis r -> f # (pfield @"_0" # r) # 0
|
||||
PDThat r -> f # 0 # (pfield @"_0" # r)
|
||||
PDThese r -> f # (pfield @"_0" # r) # (pfield @"_1" # r)
|
||||
in pcheckPred # unThese # l # r
|
||||
|
||||
-- | Establishes if a value is less than or equal to another.
|
||||
pleq :: Term s (PValue :--> PValue :--> PBool)
|
||||
pleq = plam $ \v0 v1 -> (pcheckBinRel # pleq') # v0 # v1
|
||||
|
||||
pleq' :: Term s (PInteger :--> PInteger :--> PBool)
|
||||
pleq' = plam $ \m n -> m #<= n
|
||||
|
||||
-- | Establishes if a value is strictly less than another.
|
||||
plt :: Term s (PValue :--> PValue :--> PBool)
|
||||
plt = plam $ \v0 v1 -> (pcheckBinRel # plt') # v0 # v1
|
||||
|
||||
plt' :: Term s (PInteger :--> PInteger :--> PBool)
|
||||
plt' = plam $ \m n -> m #< n
|
||||
|
||||
-- | Establishes if a value is greater than or equal to another.
|
||||
pgeq :: Term s (PValue :--> PValue :--> PBool)
|
||||
pgeq = plam $ \v0 v1 -> pnot #$ plt # v0 # v1
|
||||
|
||||
-- | Establishes if a value is strictly greater than another.
|
||||
pgt :: Term s (PValue :--> PValue :--> PBool)
|
||||
pgt = plam $ \v0 v1 -> pnot #$ pleq # v0 # v1
|
||||
28
bench.csv
28
bench.csv
|
|
@ -2,22 +2,22 @@ name,cpu,mem,size
|
|||
Agora/Effects/Treasury Withdrawal Effect/effect/Simple,340268715,724428,3050
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,570029812,1211300,3377
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,502351827,1071087,3242
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,103651824,228328,7681
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,126986096,263635,3357
|
||||
Agora/Stake/policy/stakeCreation,60250773,128585,2144
|
||||
Agora/Stake/validator/stakeDepositWithdraw deposit,275919558,599033,4063
|
||||
Agora/Stake/validator/stakeDepositWithdraw withdraw,275919558,599033,4055
|
||||
Agora/Proposal/policy/proposalCreation,34571405,70066,1585
|
||||
Agora/Proposal/validator/cosignature/proposal,240007066,509127,4892
|
||||
Agora/Proposal/validator/cosignature/stake,185913543,402497,4600
|
||||
Agora/Proposal/validator/voting/proposal,238383906,489848,4900
|
||||
Agora/Proposal/validator/voting/stake,153804848,328239,4653
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,103830462,228928,7628
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,127968605,266935,3358
|
||||
Agora/Stake/policy/stakeCreation,59776675,126049,2116
|
||||
Agora/Stake/validator/stakeDepositWithdraw deposit,276249331,599197,4024
|
||||
Agora/Stake/validator/stakeDepositWithdraw withdraw,276249331,599197,4016
|
||||
Agora/Proposal/policy/proposalCreation,34784356,68894,1523
|
||||
Agora/Proposal/validator/cosignature/proposal,241204796,510319,4812
|
||||
Agora/Proposal/validator/cosignature/stake,186332635,402961,4561
|
||||
Agora/Proposal/validator/voting/proposal,239645722,489368,4820
|
||||
Agora/Proposal/validator/voting/stake,154223940,328703,4614
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,25177457,55883,806
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,40266637,88241,900
|
||||
Agora/Treasury/Validator/Positive/Allows for effect changes,37343572,79744,1841
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,25177457,55883,806
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,40266637,88241,900
|
||||
Agora/Governor/policy/GST minting,57648280,119961,1851
|
||||
Agora/Governor/validator/proposal creation,329287002,679689,8196
|
||||
Agora/Governor/validator/GATs minting,430385143,929607,8319
|
||||
Agora/Governor/validator/mutate governor state,100840784,222602,7738
|
||||
Agora/Governor/policy/GST minting,57978053,120125,1833
|
||||
Agora/Governor/validator/proposal creation,330344593,681815,8143
|
||||
Agora/Governor/validator/GATs minting,431952116,934409,8266
|
||||
Agora/Governor/validator/mutate governor state,101019422,223202,7685
|
||||
|
|
|
|||
|
6644
flake.lock
generated
6644
flake.lock
generated
File diff suppressed because it is too large
Load diff
44
flake.nix
44
flake.nix
|
|
@ -7,13 +7,21 @@
|
|||
# see https://github.com/NixOS/nix/issues/6013
|
||||
inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; };
|
||||
|
||||
# Plutarch and its friends
|
||||
inputs.plutarch.url =
|
||||
"github:peter-mlabs/plutarch?rev=6ef18aacd02050fc07398e399cff5e8734c1045e";
|
||||
"github:liqwid-labs/plutarch/staging";
|
||||
inputs.plutarch.inputs.emanote.follows =
|
||||
"plutarch/haskell-nix/nixpkgs-unstable";
|
||||
inputs.plutarch.inputs.nixpkgs.follows =
|
||||
"plutarch/haskell-nix/nixpkgs-unstable";
|
||||
|
||||
inputs.liqwid-plutarch-extra.url =
|
||||
"git+ssh://git@github.com/Liqwid-Labs/liqwid-plutarch-extra?ref=main";
|
||||
inputs.plutarch-numeric.url =
|
||||
"git+ssh://git@github.com/Liqwid-Labs/plutarch-numeric?ref=main";
|
||||
inputs.plutarch-safe-money.url =
|
||||
"git+ssh://git@github.com/Liqwid-Labs/plutarch-safe-money?ref=main";
|
||||
|
||||
# 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
|
||||
|
|
@ -66,12 +74,21 @@
|
|||
src = inputs.plutarch;
|
||||
subdirs = [
|
||||
"."
|
||||
"plutarch-test"
|
||||
"plutarch-extra"
|
||||
"plutarch-numeric"
|
||||
"plutarch-safemoney"
|
||||
];
|
||||
}
|
||||
{
|
||||
src = inputs.liqwid-plutarch-extra;
|
||||
subdirs = [ "." ];
|
||||
}
|
||||
{
|
||||
src = inputs.plutarch-numeric;
|
||||
subdirs = [ "." ];
|
||||
}
|
||||
{
|
||||
src = inputs.plutarch-safe-money;
|
||||
subdirs = [ "." ];
|
||||
}
|
||||
{
|
||||
src = inputs.apropos-tx;
|
||||
subdirs = [ "." ];
|
||||
|
|
@ -82,9 +99,7 @@
|
|||
}
|
||||
{
|
||||
src = inputs.purescript-bridge;
|
||||
subdirs = [
|
||||
"."
|
||||
];
|
||||
subdirs = [ "." ];
|
||||
}
|
||||
];
|
||||
modules = [ (plutarch.haskellModule system) ];
|
||||
|
|
@ -110,16 +125,21 @@
|
|||
inherit (plutarch) tools;
|
||||
|
||||
additional = ps: [
|
||||
# plutarch
|
||||
ps.plutarch
|
||||
ps.liqwid-plutarch-extra
|
||||
ps.plutarch-numeric
|
||||
ps.plutarch-safe-money
|
||||
|
||||
# purescript
|
||||
ps.purescript-bridge
|
||||
|
||||
# testing
|
||||
ps.tasty-quickcheck
|
||||
ps.apropos-tx
|
||||
ps.apropos
|
||||
ps.plutarch-extra
|
||||
ps.plutarch-numeric
|
||||
ps.plutarch-safemoney
|
||||
ps.plutarch-test
|
||||
ps.apropos
|
||||
ps.purescript-bridge
|
||||
|
||||
];
|
||||
};
|
||||
};
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue