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

Merge pull request #125 from Liqwid-Labs/staging

Browse source 
Release 0.1.0
This commit is contained in:
Emily 2022-06-22 22:02:28 +02:00 • committed by GitHub
commit ec36891852
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
31 changed files with 1444 additions and 1160 deletions
Download patch file Download diff file Expand all files Collapse all files

6
CHANGELOG.md
View file

@ -2,4 +2,8 @@
This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
## Unreleased
## 0.1.0 -- 2022-06-22
### Added
* First release

75
README.md
View file

@ -35,78 +35,23 @@ If you are a protocol wanting to use Agora, read [Using Agora](https://liqwid.no
Please read [CONTRIBUTING.md](./CONTRIBUTING.md). Additionally, please follow the [Git policy](https://liqwid.notion.site/Git-Policy-9a7979b2fd5d4604b6d042b084e7e14f) when contributing to this project.
## Road-map
### v1
- [x] Governor
- [x] Treasury
- [ ] Staking pool
- [ ] Proposals
- [x] Effects
### v2
- [ ] Rewards distribution
- [ ] Escrow staking pool solution
### Beyond
- [ ] ...
# Governance concepts
This section seeks to introduce to the reader the concept of governance systems on Cardano and acquaint them with the core components of a generic governance system.
## Simple questions, simple answers
### Q: What's a 'governance'?
A: A _governance system_ is a component of a Cardano system, that allows for its community to issue and vote on proposals.
### Q: What can be proposed?
A: That depends on the Cardano protocol in-question. An example for a proposal could suggest that funds be released from a community treasury. Another might propose an alteration to some parameter in the wider-system.
### Q: Who can vote?
A: The right to vote is conferred by the _staking_ of some designated _governance token_ (GT). If one owns the relevant token, they may 'stake' some of it to vote in favour of, or opposition to, some proposal.
## Overview of components
<p align="center">
<img src="/docs/diagrams/gov-overview.svg"/>
</p>
More-detailed information on individual components will be included in their own, specific documentation. This section provides brief descriptions on the purpose of each component.
## Road-map
### Users
### v1
A user is a member of the DAO (decentralised autonomous organisation), who
may choose to redeem governance tokens (GT) from the treasury and stake those GT
to vote in favour of, or opposition to, proposals.
- [x] Governor
- [x] Treasury
- [x] Stakes
- [x] Proposals
- [x] Effects
### Governance tokens
### v2
Governance tokens (GTs) are a currency, which confer the right to vote on proposals.
### Treasury
The treasury of a governance system is responsible for determining which users are entitled to what GT rewards and when. If a user is eligible for a reward, it they must claim it from the treasury. A treasury can also serve as a form of 'DAO wallet', storing and saving funds that can be later spent by the community.
### Stakes
Users are required to 'lock' their GT in stakes, so that the system has some idea of their eligibility to vote on proposal.
### Proposal
A proposal suggests for some specified changes to be made to a Cardano system. It is voted upon by the community and, if passed, its effects are applied to the system.
### Effects
Proposals may have one or many 'effects', which represent the concrete, individual changes the proposal would make to the system. If their corresponding proposals have been passed, each effect is granted a _governance authority token_ (GAT) by the governor. This token permits the effect to alter the system.
### Governor
The governor is responsible for validating whether proposals have passed. If they have, it issues GATs to the proposals' effects.
- [ ] Rewards distribution
- [ ] Escrow staking pool solution

24
agora-purescript-bridge/src/Agora/AuthorityToken.purs
View file

@ -1,24 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.AuthorityToken where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import PlutusLedgerApi.V1.Value (AssetClass)
import Type.Proxy (Proxy(Proxy))
newtype AuthorityToken = AuthorityToken { authority :: AssetClass }
derive instance Generic AuthorityToken _
derive instance Newtype AuthorityToken _
--------------------------------------------------------------------------------
_AuthorityToken :: Iso' AuthorityToken {authority :: AssetClass}
_AuthorityToken = _Newtype

28
agora-purescript-bridge/src/Agora/Effect/GovernorMutation.purs
View file

@ -1,28 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.Effect.GovernorMutation where
import Prelude
import Agora.Governor (GovernorDatum)
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import PlutusLedgerApi.V1.Tx (TxOutRef)
import Type.Proxy (Proxy(Proxy))
newtype MutateGovernorDatum = MutateGovernorDatum
{ governorRef :: TxOutRef
, newDatum :: GovernorDatum
}
derive instance Generic MutateGovernorDatum _
derive instance Newtype MutateGovernorDatum _
--------------------------------------------------------------------------------
_MutateGovernorDatum :: Iso' MutateGovernorDatum {governorRef :: TxOutRef, newDatum :: GovernorDatum}
_MutateGovernorDatum = _Newtype

29
agora-purescript-bridge/src/Agora/Effect/TreasuryWithdrawal.purs
View file

@ -1,29 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.Effect.TreasuryWithdrawal where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import PlutusLedgerApi.V1.Credential (Credential)
import PlutusLedgerApi.V1.Value (Value)
import Type.Proxy (Proxy(Proxy))
newtype TreasuryWithdrawalDatum = TreasuryWithdrawalDatum
{ receivers :: Array (Tuple Credential Value)
, treasuries :: Array Credential
}
derive instance Generic TreasuryWithdrawalDatum _
derive instance Newtype TreasuryWithdrawalDatum _
--------------------------------------------------------------------------------
_TreasuryWithdrawalDatum :: Iso' TreasuryWithdrawalDatum {receivers :: Array (Tuple Credential Value), treasuries :: Array Credential}
_TreasuryWithdrawalDatum = _Newtype

89
agora-purescript-bridge/src/Agora/Governor.purs
View file

@ -1,89 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.Governor where
import Prelude
import Agora.Proposal (ProposalId, ProposalThresholds)
import Agora.Proposal.Time (MaxTimeRangeWidth, ProposalTimingConfig)
import Agora.SafeMoney (GTTag)
import Data.Bounded.Generic (genericBottom, genericTop)
import Data.Enum (class Enum)
import Data.Enum.Generic (genericPred, genericSucc)
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tagged (Tagged)
import GHC.Num.Integer (Integer)
import PlutusLedgerApi.V1.Tx (TxOutRef)
import PlutusLedgerApi.V1.Value (AssetClass)
import Type.Proxy (Proxy(Proxy))
newtype GovernorDatum = GovernorDatum
{ proposalThresholds :: ProposalThresholds
, nextProposalId :: ProposalId
, proposalTimings :: ProposalTimingConfig
, createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth
}
derive instance Generic GovernorDatum _
derive instance Newtype GovernorDatum _
--------------------------------------------------------------------------------
_GovernorDatum :: Iso' GovernorDatum {proposalThresholds :: ProposalThresholds, nextProposalId :: ProposalId, proposalTimings :: ProposalTimingConfig, createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth}
_GovernorDatum = _Newtype
--------------------------------------------------------------------------------
data GovernorRedeemer
= CreateProposal
| MintGATs
| MutateGovernor
derive instance Generic GovernorRedeemer _
instance Enum GovernorRedeemer where
succ = genericSucc
pred = genericPred
instance Bounded GovernorRedeemer where
bottom = genericBottom
top = genericTop
--------------------------------------------------------------------------------
_CreateProposal :: Prism' GovernorRedeemer Unit
_CreateProposal = prism' (const CreateProposal) case _ of
CreateProposal -> Just unit
_ -> Nothing
_MintGATs :: Prism' GovernorRedeemer Unit
_MintGATs = prism' (const MintGATs) case _ of
MintGATs -> Just unit
_ -> Nothing
_MutateGovernor :: Prism' GovernorRedeemer Unit
_MutateGovernor = prism' (const MutateGovernor) case _ of
MutateGovernor -> Just unit
_ -> Nothing
--------------------------------------------------------------------------------
newtype Governor = Governor
{ gstOutRef :: TxOutRef
, gtClassRef :: Tagged GTTag AssetClass
, maximumCosigners :: Integer
}
derive instance Generic Governor _
derive instance Newtype Governor _
--------------------------------------------------------------------------------
_Governor :: Iso' Governor {gstOutRef :: TxOutRef, gtClassRef :: Tagged GTTag AssetClass, maximumCosigners :: Integer}
_Governor = _Newtype

28
agora-purescript-bridge/src/Agora/MultiSig.purs
View file

@ -1,28 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.MultiSig where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import GHC.Num.Integer (Integer)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import Type.Proxy (Proxy(Proxy))
newtype MultiSig = MultiSig
{ keys :: Array PubKeyHash
, minSigs :: Integer
}
derive instance Generic MultiSig _
derive instance Newtype MultiSig _
--------------------------------------------------------------------------------
_MultiSig :: Iso' MultiSig {keys :: Array PubKeyHash, minSigs :: Integer}
_MultiSig = _Newtype

188
agora-purescript-bridge/src/Agora/Proposal.purs
View file

@ -1,188 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.Proposal where
import Prelude
import Agora.Proposal.Time (ProposalStartingTime, ProposalTimingConfig)
import Agora.SafeMoney (GTTag)
import Data.Bounded.Generic (genericBottom, genericTop)
import Data.Enum (class Enum)
import Data.Enum.Generic (genericPred, genericSucc)
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tagged (Tagged)
import GHC.Num.Integer (Integer)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Scripts (DatumHash, ValidatorHash)
import PlutusLedgerApi.V1.Value (AssetClass)
import PlutusTx.AssocMap (Map)
import Type.Proxy (Proxy(Proxy))
newtype ProposalId = ProposalId { proposalTag :: Integer }
derive instance Generic ProposalId _
derive instance Newtype ProposalId _
--------------------------------------------------------------------------------
_ProposalId :: Iso' ProposalId {proposalTag :: Integer}
_ProposalId = _Newtype
--------------------------------------------------------------------------------
newtype ResultTag = ResultTag { getResultTag :: Integer }
derive instance Generic ResultTag _
derive instance Newtype ResultTag _
--------------------------------------------------------------------------------
_ResultTag :: Iso' ResultTag {getResultTag :: Integer}
_ResultTag = _Newtype
--------------------------------------------------------------------------------
data ProposalStatus
= Draft
| VotingReady
| Locked
| Finished
derive instance Generic ProposalStatus _
instance Enum ProposalStatus where
succ = genericSucc
pred = genericPred
instance Bounded ProposalStatus where
bottom = genericBottom
top = genericTop
--------------------------------------------------------------------------------
_Draft :: Prism' ProposalStatus Unit
_Draft = prism' (const Draft) case _ of
Draft -> Just unit
_ -> Nothing
_VotingReady :: Prism' ProposalStatus Unit
_VotingReady = prism' (const VotingReady) case _ of
VotingReady -> Just unit
_ -> Nothing
_Locked :: Prism' ProposalStatus Unit
_Locked = prism' (const Locked) case _ of
Locked -> Just unit
_ -> Nothing
_Finished :: Prism' ProposalStatus Unit
_Finished = prism' (const Finished) case _ of
Finished -> Just unit
_ -> Nothing
--------------------------------------------------------------------------------
newtype ProposalThresholds = ProposalThresholds
{ countVoting :: Tagged GTTag Integer
, create :: Tagged GTTag Integer
, startVoting :: Tagged GTTag Integer
}
derive instance Generic ProposalThresholds _
derive instance Newtype ProposalThresholds _
--------------------------------------------------------------------------------
_ProposalThresholds :: Iso' ProposalThresholds {countVoting :: Tagged GTTag Integer, create :: Tagged GTTag Integer, startVoting :: Tagged GTTag Integer}
_ProposalThresholds = _Newtype
--------------------------------------------------------------------------------
newtype ProposalVotes = ProposalVotes { getProposalVotes :: Map ResultTag Integer }
derive instance Generic ProposalVotes _
derive instance Newtype ProposalVotes _
--------------------------------------------------------------------------------
_ProposalVotes :: Iso' ProposalVotes {getProposalVotes :: Map ResultTag Integer}
_ProposalVotes = _Newtype
--------------------------------------------------------------------------------
newtype ProposalDatum = ProposalDatum
{ proposalId :: ProposalId
, effects :: Map ResultTag (Map ValidatorHash DatumHash)
, status :: ProposalStatus
, cosigners :: Array PubKeyHash
, thresholds :: ProposalThresholds
, votes :: ProposalVotes
, timingConfig :: ProposalTimingConfig
, startingTime :: ProposalStartingTime
}
derive instance Generic ProposalDatum _
derive instance Newtype ProposalDatum _
--------------------------------------------------------------------------------
_ProposalDatum :: Iso' ProposalDatum {proposalId :: ProposalId, effects :: Map ResultTag (Map ValidatorHash DatumHash), status :: ProposalStatus, cosigners :: Array PubKeyHash, thresholds :: ProposalThresholds, votes :: ProposalVotes, timingConfig :: ProposalTimingConfig, startingTime :: ProposalStartingTime}
_ProposalDatum = _Newtype
--------------------------------------------------------------------------------
data ProposalRedeemer
= Vote ResultTag
| Cosign (Array PubKeyHash)
| Unlock ResultTag
| AdvanceProposal
derive instance Generic ProposalRedeemer _
--------------------------------------------------------------------------------
_Vote :: Prism' ProposalRedeemer ResultTag
_Vote = prism' Vote case _ of
(Vote a) -> Just a
_ -> Nothing
_Cosign :: Prism' ProposalRedeemer (Array PubKeyHash)
_Cosign = prism' Cosign case _ of
(Cosign a) -> Just a
_ -> Nothing
_Unlock :: Prism' ProposalRedeemer ResultTag
_Unlock = prism' Unlock case _ of
(Unlock a) -> Just a
_ -> Nothing
_AdvanceProposal :: Prism' ProposalRedeemer Unit
_AdvanceProposal = prism' (const AdvanceProposal) case _ of
AdvanceProposal -> Just unit
_ -> Nothing
--------------------------------------------------------------------------------
newtype Proposal = Proposal
{ governorSTAssetClass :: AssetClass
, stakeSTAssetClass :: AssetClass
, maximumCosigners :: Integer
}
derive instance Generic Proposal _
derive instance Newtype Proposal _
--------------------------------------------------------------------------------
_Proposal :: Iso' Proposal {governorSTAssetClass :: AssetClass, stakeSTAssetClass :: AssetClass, maximumCosigners :: Integer}
_Proposal = _Newtype

103
agora-purescript-bridge/src/Agora/Stake.purs
View file

@ -1,103 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.Stake where
import Prelude
import Agora.Proposal (ProposalId, ResultTag)
import Agora.SafeMoney (GTTag)
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tagged (Tagged)
import GHC.Num.Integer (Integer)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusLedgerApi.V1.Value (AssetClass)
import Type.Proxy (Proxy(Proxy))
newtype Stake = Stake
{ gtClassRef :: Tagged GTTag AssetClass
, proposalSTClass :: AssetClass
}
derive instance Generic Stake _
derive instance Newtype Stake _
--------------------------------------------------------------------------------
_Stake :: Iso' Stake {gtClassRef :: Tagged GTTag AssetClass, proposalSTClass :: AssetClass}
_Stake = _Newtype
--------------------------------------------------------------------------------
newtype ProposalLock = ProposalLock
{ vote :: ResultTag
, proposalId :: ProposalId
}
derive instance Generic ProposalLock _
derive instance Newtype ProposalLock _
--------------------------------------------------------------------------------
_ProposalLock :: Iso' ProposalLock {vote :: ResultTag, proposalId :: ProposalId}
_ProposalLock = _Newtype
--------------------------------------------------------------------------------
data StakeRedeemer
= DepositWithdraw (Tagged GTTag Integer)
| Destroy
| PermitVote ProposalLock
| RetractVotes (Array ProposalLock)
| WitnessStake
derive instance Generic StakeRedeemer _
--------------------------------------------------------------------------------
_DepositWithdraw :: Prism' StakeRedeemer (Tagged GTTag Integer)
_DepositWithdraw = prism' DepositWithdraw case _ of
(DepositWithdraw a) -> Just a
_ -> Nothing
_Destroy :: Prism' StakeRedeemer Unit
_Destroy = prism' (const Destroy) case _ of
Destroy -> Just unit
_ -> Nothing
_PermitVote :: Prism' StakeRedeemer ProposalLock
_PermitVote = prism' PermitVote case _ of
(PermitVote a) -> Just a
_ -> Nothing
_RetractVotes :: Prism' StakeRedeemer (Array ProposalLock)
_RetractVotes = prism' RetractVotes case _ of
(RetractVotes a) -> Just a
_ -> Nothing
_WitnessStake :: Prism' StakeRedeemer Unit
_WitnessStake = prism' (const WitnessStake) case _ of
WitnessStake -> Just unit
_ -> Nothing
--------------------------------------------------------------------------------
newtype StakeDatum = StakeDatum
{ stakedAmount :: Tagged GTTag Integer
, owner :: PubKeyHash
, lockedBy :: Array ProposalLock
}
derive instance Generic StakeDatum _
derive instance Newtype StakeDatum _
--------------------------------------------------------------------------------
_StakeDatum :: Iso' StakeDatum {stakedAmount :: Tagged GTTag Integer, owner :: PubKeyHash, lockedBy :: Array ProposalLock}
_StakeDatum = _Newtype

31
agora-purescript-bridge/src/Agora/Treasury.purs
View file

@ -1,31 +0,0 @@
-- File auto generated by purescript-bridge! --
module Agora.Treasury where
import Prelude
import Data.Bounded.Generic (genericBottom, genericTop)
import Data.Enum (class Enum)
import Data.Enum.Generic (genericPred, genericSucc)
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', Prism', iso, prism')
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..))
import Type.Proxy (Proxy(Proxy))
data TreasuryRedeemer = SpendTreasuryGAT
derive instance Generic TreasuryRedeemer _
instance Enum TreasuryRedeemer where
succ = genericSucc
pred = genericPred
instance Bounded TreasuryRedeemer where
bottom = genericBottom
top = genericTop
--------------------------------------------------------------------------------
_SpendTreasuryGAT :: Iso' TreasuryRedeemer Unit
_SpendTreasuryGAT = iso (const unit) (const SpendTreasuryGAT)

1
agora-scripts/agora-scripts.json
View file

File diff suppressed because one or more lines are too long

7
agora.cabal
View file

@ -1,6 +1,6 @@
cabal-version: 3.0
name: agora
version: 0.1
version: 0.1.0
extra-source-files: CHANGELOG.md
author: Emily Martins <emi@haskell.fyi>
license: Apache-2.0
@ -153,7 +153,10 @@ library
Agora.Treasury
Agora.Utils
other-modules: Agora.Aeson.Orphans
other-modules:
Agora.Aeson.Orphans
Agora.Plutarch.Orphans
hs-source-dirs: agora
library pprelude

36
agora/Agora/AuthorityToken.hs
View file

@ -2,6 +2,7 @@
Module : Agora.AuthorityToken
Maintainer : emi@haskell.fyi
Description: Tokens acting as redeemable proofs of DAO authority.
Tokens acting as redeemable proofs of DAO authority.
-}
module Agora.AuthorityToken (
@ -11,8 +12,7 @@ module Agora.AuthorityToken (
AuthorityToken (..),
) where
--------------------------------------------------------------------------------
import GHC.Generics qualified as GHC
import Plutarch.Api.V1 (
AmountGuarantees,
KeyGuarantees,
@ -38,21 +38,23 @@ import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
--------------------------------------------------------------------------------
import GHC.Generics qualified as GHC
--------------------------------------------------------------------------------
{- | An AuthorityToken represents a proof that a particular token
moved while this token was minted. In effect, this means that
the validator that locked such a token must have approved
said transaction. Said validator should be made aware of
*this* token's existence in order to prevent incorrect minting.
spent in the same transaction the AuthorityToken was minted.
In effect, this means that the validator that locked such a token
must have approved the transaction in which an AuthorityToken is minted.
Said validator should be made aware of an AuthorityToken token's existence
in order to prevent incorrect minting.
@since 0.1.0
-}
newtype AuthorityToken = AuthorityToken
{ authority :: AssetClass
-- ^ Token that must move in order for minting this to be valid.
}
deriving stock (GHC.Generic)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
--------------------------------------------------------------------------------
@ -64,6 +66,8 @@ newtype AuthorityToken = AuthorityToken
it was sent to, this is enough to prove validity.
In other words, check that all assets of a particular currency symbol
are tagged with a TokenName that matches where they live.
@since 0.1.0
-}
authorityTokensValidIn :: Term s (PCurrencySymbol :--> PTxOut :--> PBool)
authorityTokensValidIn = phoistAcyclic $
@ -94,7 +98,10 @@ authorityTokensValidIn = phoistAcyclic $
-- No GATs exist at this output!
pconstant True
-- | Assert that a single authority token has been burned.
{- | Assert that a single authority token has been burned.
@since 0.1.0
-}
singleAuthorityTokenBurned ::
forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
Term s PCurrencySymbol ->
@ -122,7 +129,10 @@ singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
# txInfoF.inputs
]
-- | Policy given 'AuthorityToken' params.
{- | Policy given 'AuthorityToken' params.
@since 0.1.0
-}
authorityTokenPolicy :: AuthorityToken -> ClosedTerm PMintingPolicy
authorityTokenPolicy params =
plam $ \_redeemer ctx' ->

4
agora/Agora/Effect.hs
View file

@ -13,13 +13,13 @@ import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC, ptryFromC)
import Plutarch.TryFrom ()
import PlutusLedgerApi.V1.Value (CurrencySymbol)
--------------------------------------------------------------------------------
{- | 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.
@since 0.1.0
-}
makeEffect ::
forall (datum :: PType).

92
agora/Agora/Effect/GovernorMutation.hs
View file

@ -18,14 +18,25 @@ module Agora.Effect.GovernorMutation (
mutateGovernorValidator,
) where
--------------------------------------------------------------------------------
import Control.Applicative (Const)
import Agora.Effect (makeEffect)
import Agora.Governor (
Governor,
GovernorDatum,
PGovernorDatum,
governorDatumValid,
)
import Agora.Governor.Scripts (
authorityTokenSymbolFromGovernor,
governorSTAssetClassFromGovernor,
)
import Agora.Plutarch.Orphans ()
import Agora.Utils (
isScriptAddress,
mustBePDJust,
mustBePJust,
)
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
PTxOutRef,
PValidator,
@ -40,37 +51,16 @@ import Plutarch.DataRepr (
)
import Plutarch.Extra.TermCont (pguardC)
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import Plutarch.TryFrom (PTryFrom (..))
import Plutarch.Unsafe (punsafeCoerce)
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (TxOutRef)
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusTx qualified
--------------------------------------------------------------------------------
import Agora.Effect (makeEffect)
import Agora.Governor (
Governor,
GovernorDatum,
PGovernorDatum,
governorDatumValid,
)
import Agora.Governor.Scripts (
authorityTokenSymbolFromGovernor,
governorSTAssetClassFromGovernor,
)
import Agora.Utils (
isScriptAddress,
mustBePDJust,
mustBePJust,
)
{- | Haskell-level datum for the governor mutation effect script.
--------------------------------------------------------------------------------
-- | Haskell-level datum for the governor mutation effect script.
@since 0.1.0
-}
data MutateGovernorDatum = MutateGovernorDatum
{ governorRef :: TxOutRef
-- ^ Referenced governor state UTXO should be updated by the effect.
@ -84,7 +74,10 @@ PlutusTx.makeIsDataIndexed ''MutateGovernorDatum [('MutateGovernorDatum, 0)]
--------------------------------------------------------------------------------
-- | Plutarch-level version of 'MutateGovernorDatum'.
{- | Plutarch-level version of 'MutateGovernorDatum'.
@since 0.1.0
-}
newtype PMutateGovernorDatum (s :: S)
= PMutateGovernorDatum
( Term
@ -95,21 +88,38 @@ newtype PMutateGovernorDatum (s :: S)
]
)
)
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields, PEq)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
, -- | @since 0.1.0
PEq
)
via (PIsDataReprInstances PMutateGovernorDatum)
-- | @since 0.1.0
instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum
-- | @since 0.1.0
deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) instance (PConstantDecl MutateGovernorDatum)
-- TODO: Derive this.
instance PTryFrom PData (PAsData PMutateGovernorDatum) where
type PTryFromExcess PData (PAsData PMutateGovernorDatum) = Const ()
ptryFrom' d k =
k (punsafeCoerce d, ())
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PMutateGovernorDatum) instance PTryFrom PData (PAsData PMutateGovernorDatum)
--------------------------------------------------------------------------------
@ -135,6 +145,8 @@ instance PTryFrom PData (PAsData PMutateGovernorDatum) where
* It contains the GST.
* It has valid governor state datum.
* The datum is exactly the same as the 'newDatum'.
@since 0.1.0
-}
mutateGovernorValidator :: Governor -> ClosedTerm PValidator
mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $

21
agora/Agora/Effect/NoOp.hs
View file

@ -14,10 +14,20 @@ import Plutarch.Api.V1 (PValidator)
import Plutarch.TryFrom (PTryFrom (..))
import PlutusLedgerApi.V1.Value (CurrencySymbol)
-- | Dummy datum for NoOp effect.
newtype PNoOp (s :: S) = PNoOp (Term s PUnit)
deriving (PlutusType, PIsData) via (DerivePNewtype PNoOp PUnit)
{- | Dummy datum for NoOp effect.
@since 0.1.0
-}
newtype PNoOp (s :: S) = PNoOp (Term s PUnit)
deriving
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
)
via (DerivePNewtype PNoOp PUnit)
-- | @since 0.1.0
instance PTryFrom PData (PAsData PNoOp) where
type PTryFromExcess PData (PAsData PNoOp) = Const ()
ptryFrom' _ cont =
@ -26,7 +36,10 @@ instance PTryFrom PData (PAsData PNoOp) where
-- It should always be reduced to Unit.
cont (pdata $ pcon $ PNoOp (pconstant ()), ())
-- | Dummy effect which can only burn its GAT.
{- | Dummy effect which can only burn its GAT.
@since 0.1.0
-}
noOpValidator :: CurrencySymbol -> ClosedTerm PValidator
noOpValidator curr = makeEffect curr $
\_ (_datum :: Term s PNoOp) _ _ -> popaque (pconstant ())

74
agora/Agora/Effect/TreasuryWithdrawal.hs
View file

@ -13,12 +13,11 @@ module Agora.Effect.TreasuryWithdrawal (
treasuryWithdrawalValidator,
) where
import Control.Applicative (Const)
import Agora.Effect (makeEffect)
import Agora.Plutarch.Orphans ()
import Agora.Utils (isPubKey)
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
import Agora.Effect (makeEffect)
import Agora.Utils (isPubKey)
import Plutarch.Api.V1 (
AmountGuarantees (Positive),
KeyGuarantees (Sorted),
@ -28,8 +27,6 @@ import Plutarch.Api.V1 (
PValue,
ptuple,
)
import Plutarch.Internal (punsafeCoerce)
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef)
import "plutarch" Plutarch.Api.V1.Value (pnormalize)
import Plutarch.DataRepr (
@ -39,7 +36,6 @@ import Plutarch.DataRepr (
)
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.TryFrom (PTryFrom (..))
import PlutusLedgerApi.V1.Credential (Credential)
import PlutusLedgerApi.V1.Value (CurrencySymbol, Value)
import PlutusTx qualified
@ -49,6 +45,8 @@ import PlutusTx qualified
Note: This Datum acts like a "predefined redeemer". Which is to say that
it encodes the properties a redeemer would, but is locked in-place until
spend.
@since 0.1.0
-}
data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum
{ receivers :: [(Credential, Value)]
@ -56,13 +54,27 @@ data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum
, treasuries :: [Credential]
-- ^ What Credentials is spending from legal.
}
deriving stock (Show, GHC.Generic)
deriving anyclass (Generic)
deriving stock
( -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
-- | @since 0.1.0
PlutusTx.makeLift ''TreasuryWithdrawalDatum
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed ''TreasuryWithdrawalDatum [('TreasuryWithdrawalDatum, 0)]
-- | Haskell-level version of 'TreasuryWithdrawalDatum'.
{- | Haskell-level version of 'TreasuryWithdrawalDatum'.
@since 0.1.0
-}
newtype PTreasuryWithdrawalDatum (s :: S)
= PTreasuryWithdrawalDatum
( Term
@ -73,26 +85,41 @@ newtype PTreasuryWithdrawalDatum (s :: S)
]
)
)
deriving stock (GHC.Generic)
deriving anyclass (Generic, PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
, -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
)
via PIsDataReprInstances PTreasuryWithdrawalDatum
-- | @since 0.1.0
instance PUnsafeLiftDecl PTreasuryWithdrawalDatum where
type PLifted PTreasuryWithdrawalDatum = TreasuryWithdrawalDatum
-- | @since 0.1.0
deriving via
(DerivePConstantViaData TreasuryWithdrawalDatum PTreasuryWithdrawalDatum)
instance
(PConstantDecl TreasuryWithdrawalDatum)
instance PTryFrom PData (PAsData PTreasuryWithdrawalDatum) where
type PTryFromExcess PData (PAsData PTreasuryWithdrawalDatum) = Const ()
ptryFrom' opq cont =
-- TODO: This should not use 'punsafeCoerce'.
-- Blocked by 'PCredential', and 'PTuple'.
cont (punsafeCoerce opq, ())
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PTreasuryWithdrawalDatum)
instance
PTryFrom PData (PAsData PTreasuryWithdrawalDatum)
{- | Withdraws given list of values to specific target addresses.
It can be evoked by burning GAT. The transaction should have correct
@ -101,12 +128,17 @@ instance PTryFrom PData (PAsData PTreasuryWithdrawalDatum) where
The validator does not accept any Redeemer as all "parameters" are provided
via encoded Datum.
Note:
It should check...
NOTE: It should check...
1. Transaction outputs should contain all of what Datum specified
2. Left over assets should be redirected back to Treasury
It can be more flexiable over...
- The number of outputs themselves
@since 0.1.0
-}
treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $

118
agora/Agora/Governor.hs
View file

@ -23,15 +23,6 @@ module Agora.Governor (
governorDatumValid,
) where
--------------------------------------------------------------------------------
import Control.Applicative (Const)
import Data.Tagged (Tagged (..))
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
--------------------------------------------------------------------------------
import Agora.Proposal (
PProposalId (..),
PProposalThresholds (..),
@ -45,9 +36,9 @@ import Agora.Proposal.Time (
ProposalTimingConfig,
)
import Agora.SafeMoney (GTTag)
--------------------------------------------------------------------------------
import Data.Tagged (Tagged (..))
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
import Plutarch.DataRepr (
DerivePConstantViaData (..),
PDataFields,
@ -57,18 +48,16 @@ import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.TermCont (pletC, pmatchC)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.SafeMoney (PDiscrete (..))
import Plutarch.TryFrom (PTryFrom (..))
import Plutarch.Unsafe (punsafeCoerce)
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (TxOutRef)
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusTx qualified
--------------------------------------------------------------------------------
-- | Datum for the Governor script.
{- | Datum for the Governor script.
@since 0.1.0
-}
data GovernorDatum = GovernorDatum
{ proposalThresholds :: ProposalThresholds
-- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'.
@ -82,6 +71,7 @@ data GovernorDatum = GovernorDatum
}
deriving stock (Show, GHC.Generic)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]
{- | Redeemer for Governor script. The governor has two primary
@ -91,6 +81,8 @@ PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]
2. The gating of minting authority tokens.
Parameters of the governor can also be mutated by an effect.
@since 0.1.0
-}
data GovernorRedeemer
= -- | Checks that a proposal was created lawfully, and allows it.
@ -102,6 +94,7 @@ data GovernorRedeemer
MutateGovernor
deriving stock (Show, GHC.Generic)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed
''GovernorRedeemer
[ ('CreateProposal, 0)
@ -109,7 +102,10 @@ PlutusTx.makeIsDataIndexed
, ('MutateGovernor, 2)
]
-- | Parameters for creating Governor scripts.
{- | Parameters for creating Governor scripts.
@since 0.1.0
-}
data Governor = Governor
{ gstOutRef :: TxOutRef
-- ^ Referenced utxo will be spent to mint the GST.
@ -123,7 +119,10 @@ data Governor = Governor
--------------------------------------------------------------------------------
-- | Plutarch-level datum for the Governor script.
{- | Plutarch-level datum for the Governor script.
@since 0.1.0
-}
newtype PGovernorDatum (s :: S) = PGovernorDatum
{ getGovernorDatum ::
Term
@ -136,53 +135,98 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields, PEq)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
, -- | @since 0.1.0
PEq
)
via PIsDataReprInstances PGovernorDatum
-- | @since 0.1.0
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
-- | @since 0.1.0
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum)
-- FIXME: derive this via 'PIsDataReprInstances'
-- Blocked by: PProposalThresholds
instance PTryFrom PData (PAsData PGovernorDatum) where
type PTryFromExcess PData (PAsData PGovernorDatum) = Const ()
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PGovernorDatum) instance PTryFrom PData (PAsData PGovernorDatum)
ptryFrom' d k = k (punsafeCoerce d, ())
{- | Plutarch-level version of 'GovernorRedeemer'.
-- | Plutarch-level version of 'GovernorRedeemer'.
@since 0.1.0
-}
data PGovernorRedeemer (s :: S)
= PCreateProposal (Term s (PDataRecord '[]))
| PMintGATs (Term s (PDataRecord '[]))
| PMutateGovernor (Term s (PDataRecord '[]))
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
)
via PIsDataReprInstances PGovernorRedeemer
-- | @since 0.1.0
instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer
-- | @since 0.1.0
deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstantDecl GovernorRedeemer)
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer)
--------------------------------------------------------------------------------
-- | Plutrach version of 'getNextProposalId'.
{- | Plutrach version of 'getNextProposalId'.
@since 0.1.0
-}
pgetNextProposalId :: Term s (PProposalId :--> PProposalId)
pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1
-- | Get next proposal id.
{- | Get next proposal id.
@since 0.1.0
-}
getNextProposalId :: ProposalId -> ProposalId
getNextProposalId (ProposalId pid) = ProposalId $ pid + 1
--------------------------------------------------------------------------------
-- | Check whether a particular 'PGovernorDatum' is well-formed.
{- | Check whether a particular 'PGovernorDatum' is well-formed.
@since 0.1.0
-}
governorDatumValid :: Term s (PGovernorDatum :--> PBool)
governorDatumValid = phoistAcyclic $
plam $ \datum -> unTermCont $ do

66
agora/Agora/Governor/Scripts.hs
View file

@ -154,6 +154,8 @@ import PlutusLedgerApi.V1.Value (
NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator.
We /can't/ really check this in the policy, otherwise we create a cyclic reference issue.
@since 0.1.0
-}
governorPolicy :: Governor -> ClosedTerm PMintingPolicy
governorPolicy gov =
@ -272,6 +274,8 @@ governorPolicy gov =
- Exactly one GAT is burnt in the transaction.
- Said GAT is tagged by the effect.
@since 0.1.0
-}
governorValidator :: Governor -> ClosedTerm PValidator
governorValidator gov =
@ -718,21 +722,30 @@ governorValidator gov =
--------------------------------------------------------------------------------
-- | Get the 'CurrencySymbol' of GST.
{- | Get the 'CurrencySymbol' of GST.
@since 0.1.0
-}
governorSTSymbolFromGovernor :: Governor -> CurrencySymbol
governorSTSymbolFromGovernor gov = mintingPolicySymbol policy
where
policy :: MintingPolicy
policy = mkMintingPolicy $ governorPolicy gov
-- | Get the 'AssetClass' of GST.
{- | Get the 'AssetClass' of GST.
@since 0.1.0
-}
governorSTAssetClassFromGovernor :: Governor -> AssetClass
governorSTAssetClassFromGovernor gov = AssetClass (symbol, "")
where
symbol :: CurrencySymbol
symbol = governorSTSymbolFromGovernor gov
-- | Get the 'CurrencySymbol' of the proposal state token.
{- | Get the 'CurrencySymbol' of the proposal state token.
@since 0.1.0
-}
proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol
proposalSTSymbolFromGovernor gov = symbol
where
@ -740,13 +753,19 @@ proposalSTSymbolFromGovernor gov = symbol
policy = mkMintingPolicy $ proposalPolicy gstAC
symbol = mintingPolicySymbol policy
-- | Get the 'AssetClass' of the proposal state token.
{- | Get the 'AssetClass' of the proposal state token.
@since 0.1.0
-}
proposalSTAssetClassFromGovernor :: Governor -> AssetClass
proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "")
where
symbol = proposalSTSymbolFromGovernor gov
-- | Get the 'CurrencySymbol' of the stake token/
{- | Get the 'CurrencySymbol' of the stake token/
@since 0.1.0
-}
stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol
stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy
where
@ -756,6 +775,8 @@ stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy
Note that the token is tagged with the hash of the stake validator.
See 'Agora.Stake.Script.stakePolicy'.
@since 0.1.0
-}
stakeSTAssetClassFromGovernor :: Governor -> AssetClass
stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName)
@ -765,20 +786,29 @@ stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName)
-- Tag with the address where the token is being sent to.
tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov
-- | Get the 'Stake' parameter, given the 'Governor' parameter.
{- | Get the 'Stake' parameter, given the 'Governor' parameter.
@since 0.1.0
-}
stakeFromGovernor :: Governor -> Stake
stakeFromGovernor gov =
Stake gov.gtClassRef $
proposalSTAssetClassFromGovernor gov
-- | Get the hash of 'Agora.Stake.Script.stakePolicy'.
{- | Get the hash of 'Agora.Stake.Script.stakePolicy'.
@since 0.1.0
-}
stakeValidatorHashFromGovernor :: Governor -> ValidatorHash
stakeValidatorHashFromGovernor gov = validatorHash validator
where
params = stakeFromGovernor gov
validator = mkValidator $ stakeValidator params
-- | Get the 'Proposal' parameter, given the 'Governor' parameter.
{- | Get the 'Proposal' parameter, given the 'Governor' parameter.
@since 0.1.0
-}
proposalFromGovernor :: Governor -> Proposal
proposalFromGovernor gov = Proposal gstAC sstAC mc
where
@ -786,24 +816,36 @@ proposalFromGovernor gov = Proposal gstAC sstAC mc
mc = gov.maximumCosigners
sstAC = stakeSTAssetClassFromGovernor gov
-- | Get the hash of 'Agora.Proposal.proposalPolicy'.
{- | Get the hash of 'Agora.Proposal.proposalPolicy'.
@since 0.1.0
-}
proposalValidatorHashFromGovernor :: Governor -> ValidatorHash
proposalValidatorHashFromGovernor gov = validatorHash validator
where
params = proposalFromGovernor gov
validator = mkValidator $ proposalValidator params
-- | Get the hash of 'Agora.Proposal.proposalValidator'.
{- | Get the hash of 'Agora.Proposal.proposalValidator'.
@since 0.1.0
-}
governorValidatorHash :: Governor -> ValidatorHash
governorValidatorHash gov = validatorHash validator
where
validator = mkValidator $ governorValidator gov
-- | Get the 'AuthorityToken' parameter given the 'Governor' parameter.
{- | Get the 'AuthorityToken' parameter given the 'Governor' parameter.
@since 0.1.0
-}
authorityTokenFromGovernor :: Governor -> AuthorityToken
authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov
-- | Get the 'CurrencySymbol' of the authority token.
{- | Get the 'CurrencySymbol' of the authority token.
@since 0.1.0
-}
authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol
authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy
where

65
agora/Agora/MultiSig.hs
View file

@ -14,6 +14,8 @@ module Agora.MultiSig (
MultiSig (..),
) where
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
import Plutarch.Api.V1 (
PPubKeyHash,
PTxInfo (..),
@ -28,33 +30,42 @@ import Plutarch.Lift (
PLifted,
PUnsafeLiftDecl,
)
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
import PlutusTx qualified
--------------------------------------------------------------------------------
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
import Prelude
--------------------------------------------------------------------------------
{- | A MultiSig represents a proof that a particular set of signatures
are present on a transaction.
@since 0.1.0
-}
data MultiSig = MultiSig
{ keys :: [PubKeyHash]
-- ^ List of PubKeyHashes that must be present in the list of signatories.
, minSigs :: Integer
}
deriving stock (GHC.Generic, Eq, Show)
deriving anyclass (Generic)
deriving stock
( -- | @since 0.1.0
GHC.Generic
, -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
PlutusTx.makeLift ''MultiSig
PlutusTx.unstableMakeIsData ''MultiSig
-- | Plutarch-level MultiSig
{- | Plutarch-level MultiSig
@since 0.1.0
-}
newtype PMultiSig (s :: S) = PMultiSig
{ getMultiSig ::
Term
@ -65,25 +76,49 @@ newtype PMultiSig (s :: S) = PMultiSig
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
)
via (PIsDataReprInstances PMultiSig)
-- | @since 0.1.0
instance PUnsafeLiftDecl PMultiSig where type PLifted PMultiSig = MultiSig
-- | @since 0.1.0
deriving via (DerivePConstantViaData MultiSig PMultiSig) instance (PConstantDecl MultiSig)
--------------------------------------------------------------------------------
-- | Check if a Haskell-level MultiSig signs this transaction.
{- | Check if a Haskell-level MultiSig signs this transaction.
@since 0.1.0
-}
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.
@since 0.1.0
-}
pvalidatedByMultisig :: Term s (PMultiSig :--> PTxInfo :--> PBool)
pvalidatedByMultisig =
phoistAcyclic $

134
agora/Agora/Plutarch/Orphans.hs Normal file
View file

@ -0,0 +1,134 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{- FIXME: All of the following instances and
types ought to belong in either plutarch or
plutarch-extra.
A number of these have been "stolen" from Mango's
PR: https://github.com/Plutonomicon/plutarch/pull/438/
-}
module Agora.Plutarch.Orphans () where
import Control.Arrow (first)
import Plutarch.Api.V1 (PAddress, PCredential, PCurrencySymbol, PDatumHash, PMap, PMaybeData, PPOSIXTime, PPubKeyHash, PStakingCredential, PTokenName, PTxId, PTxOutRef, PValidatorHash, PValue)
import Plutarch.Builtin (PBuiltinMap)
import Plutarch.DataRepr (PIsDataReprInstances (..))
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
import Plutarch.Reducible (Reduce, Reducible)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)
import Prelude hiding ((+))
instance Reducible (f x y) => Reducible (Flip f y x) where
type Reduce (Flip f y x) = Reduce (f x y)
newtype Flip f a b = Flip (f b a)
-- | @since 0.1.0
instance PTryFrom PData (PAsData b) => PTryFrom PData (PAsData (DerivePNewtype c b)) where
type
PTryFromExcess PData (PAsData (DerivePNewtype c b)) =
PTryFromExcess PData (PAsData b)
ptryFrom' d k =
ptryFrom' @_ @(PAsData b) d $ k . first punsafeCoerce
-- | @since 0.1.0
instance PTryFrom PData (PAsData PPubKeyHash) where
type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
ptryFrom' opq = runTermCont $ do
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
tcont $ ptryFrom @(PAsData PByteString) opq
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a PubKeyHash should be 28 bytes long")
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
-- | @since 0.1.0
instance AdditiveSemigroup (Term s PPOSIXTime) where
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype PPOSIXTime PInteger)
instance
PTryFrom PData (PAsData PPOSIXTime)
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PTxId)
instance
PTryFrom PData (PAsData PTxId)
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PTxOutRef)
instance
PTryFrom PData (PAsData PTxOutRef)
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype (PMap g k v) (PBuiltinMap k v))
instance
( PTryFrom PData (PAsData k)
, PTryFrom PData (PAsData v)
) =>
PTryFrom PData (PAsData (PMap g k v))
-- | @since 0.1.0
instance PTryFrom PData (PAsData PValidatorHash) where
type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash
ptryFrom' opq = runTermCont $ do
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
tcont $ ptryFrom @(PAsData PByteString) opq
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a ValidatorHash should be 28 bytes long")
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
-- | @since 0.1.0
instance PTryFrom PData (PAsData PDatumHash) where
type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
ptryFrom' opq = runTermCont $ do
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
tcont $ ptryFrom @(PAsData PByteString) opq
tcont $ \f -> pif (plengthBS # unwrapped #== 64) (f ()) (ptraceError "a DatumHash should be 64 bytes long")
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype PCurrencySymbol PByteString)
instance
PTryFrom PData (PAsData PCurrencySymbol)
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype PTokenName PByteString)
instance
PTryFrom PData (PAsData PTokenName)
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype (PValue k v) (PMap k PCurrencySymbol (PMap k PTokenName PInteger)))
instance
PTryFrom PData (PAsData (PValue k v))
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances (PMaybeData a))
instance
PTryFrom PData (PAsData a) => PTryFrom PData (PAsData (PMaybeData a))
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PAddress)
instance
PTryFrom PData (PAsData PAddress)
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PCredential)
instance
PTryFrom PData (PAsData PCredential)
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PStakingCredential)
instance
PTryFrom PData (PAsData PStakingCredential)

448
agora/Agora/Proposal.hs
View file

@ -36,23 +36,12 @@ module Agora.Proposal (
pretractVotes,
) where
--------------------------------------------------------------------------------
import Control.Applicative (Const)
import Control.Arrow (first)
import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
import Agora.SafeMoney (GTTag)
import Agora.Utils (mustBePJust)
import Data.Tagged (Tagged)
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
import PlutusLedgerApi.V1.Value (AssetClass)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
KeyGuarantees (Unsorted),
PDatumHash,
@ -71,14 +60,10 @@ import Plutarch.Lift (
PUnsafeLiftDecl (..),
)
import Plutarch.SafeMoney (PDiscrete)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)
--------------------------------------------------------------------------------
import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
import Agora.SafeMoney (GTTag)
import Agora.Utils (mustBePJust)
import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
import PlutusLedgerApi.V1.Value (AssetClass)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
--------------------------------------------------------------------------------
-- Haskell-land
@ -88,10 +73,26 @@ import Agora.Utils (mustBePJust)
The 100th proposal will be @'ProposalId' 99@. This counter lives
in the 'Agora.Governor.Governor'. See 'Agora.Governor.nextProposalId', and
'Agora.Governor.pgetNextProposalId'.
@since 0.1.0
-}
newtype ProposalId = ProposalId {proposalTag :: Integer}
deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
deriving stock (Eq, Show, GHC.Generic)
deriving newtype
( -- | @since 0.1.0
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
{- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this:
@ -99,10 +100,28 @@ newtype ProposalId = ProposalId {proposalTag :: Integer}
"No" ~ 'ResultTag' 0
"Yes" ~ 'ResultTag' 1
@
@since 0.1.0
-}
newtype ResultTag = ResultTag {getResultTag :: Integer}
deriving stock (Eq, Show, Ord, GHC.Generic)
deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
Ord
, -- | @since 0.1.0
GHC.Generic
)
deriving newtype
( -- | @since 0.1.0
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
{- | The "status" of the proposal. This is only useful for state transitions that
need to happen as a result of a transaction as opposed to time-based "periods".
@ -111,6 +130,8 @@ newtype ResultTag = ResultTag {getResultTag :: Integer}
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.
@since 0.1.0
-}
data ProposalStatus
= -- | A draft proposal represents a proposal that has yet to be realized.
@ -144,13 +165,23 @@ data ProposalStatus
--
-- TODO: The owner of the proposal may choose to reclaim their proposal.
Finished
deriving stock (Eq, Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed ''ProposalStatus [('Draft, 0), ('VotingReady, 1), ('Locked, 2), ('Finished, 3)]
{- | The threshold values for various state transitions to happen.
This data is stored centrally (in the 'Agora.Governor.Governor') and copied over
to 'Proposal's when they are created.
@since 0.1.0
-}
data ProposalThresholds = ProposalThresholds
{ execute :: Tagged GTTag Integer
@ -164,8 +195,16 @@ data ProposalThresholds = ProposalThresholds
-- ^ How much GT required to allow voting to happen.
-- (i.e. to move into 'VotingReady')
}
deriving stock (Eq, Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)]
{- | Map which encodes the total tally for each result.
@ -178,18 +217,40 @@ PlutusTx.makeIsDataIndexed ''ProposalThresholds [('ProposalThresholds, 0)]
Then 'ProposalVotes' needs be of the shape:
@[('ResultTag' 0, n), ('ResultTag' 1, m)]@
@since 0.1.0
-}
newtype ProposalVotes = ProposalVotes
{ getProposalVotes :: AssocMap.Map ResultTag Integer
}
deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
deriving stock (Eq, Show, GHC.Generic)
deriving newtype
( -- | @since 0.1.0
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
-- | Create a 'ProposalVotes' that has the same shape as the 'effects' field.
{- | Create a 'ProposalVotes' that has the same shape as the 'effects' field.
@since 0.1.0
-}
emptyVotesFor :: forall a. AssocMap.Map ResultTag a -> ProposalVotes
emptyVotesFor = ProposalVotes . AssocMap.mapWithKey (const . const 0)
-- | Haskell-level datum for Proposal scripts.
{- | Haskell-level datum for Proposal scripts.
@since 0.1.0
-}
data ProposalDatum = ProposalDatum
{ proposalId :: ProposalId
-- ^ Identification of the proposal.
@ -211,11 +272,21 @@ data ProposalDatum = ProposalDatum
, startingTime :: ProposalStartingTime
-- ^ The time upon the creation of the proposal.
}
deriving stock (Eq, Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
PlutusTx.makeIsDataIndexed ''ProposalDatum [('ProposalDatum, 0)]
-- | Haskell-level redeemer for Proposal scripts.
{- | Haskell-level redeemer for Proposal scripts.
@since 0.1.0
-}
data ProposalRedeemer
= -- | Cast one or more votes towards a particular 'ResultTag'.
Vote ResultTag
@ -253,8 +324,16 @@ data ProposalRedeemer
-- If the proposal has run out of time for the current 'ProposalStatus', it will always be possible
-- to transition into 'Finished' status, because it has expired (and failed).
AdvanceProposal
deriving stock (Eq, Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed
''ProposalRedeemer
[ ('Vote, 0)
@ -263,67 +342,96 @@ PlutusTx.makeIsDataIndexed
, ('AdvanceProposal, 3)
]
-- | Parameters that identify the Proposal validator script.
{- | Parameters that identify the Proposal validator script.
@since 0.1.0
-}
data Proposal = Proposal
{ governorSTAssetClass :: AssetClass
, stakeSTAssetClass :: AssetClass
, maximumCosigners :: Integer
-- ^ Arbitrary limit for maximum amount of cosigners on a proposal.
}
deriving stock (Show, Eq, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Show
, -- | @since 0.1.0
Eq
, -- | @since 0.1.0
GHC.Generic
)
--------------------------------------------------------------------------------
-- 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 'ResultTag'.
@since 0.1.0
-}
newtype PResultTag (s :: S) = PResultTag (Term s PInteger)
deriving
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PEq
, -- | @since 0.1.0
POrd
)
via (DerivePNewtype PResultTag PInteger)
-- | @since 0.1.0
instance PUnsafeLiftDecl PResultTag where type PLifted PResultTag = ResultTag
-- | @since 0.1.0
deriving via
(DerivePConstantViaNewtype ResultTag PResultTag PInteger)
instance
(PConstantDecl ResultTag)
-- FIXME: This instance and the one below, for 'PProposalId', should be derived.
-- Soon this will be possible through 'DerivePNewtype'.
instance PTryFrom PData (PAsData PResultTag) where
type PTryFromExcess PData (PAsData PResultTag) = PTryFromExcess PData (PAsData PInteger)
ptryFrom' d k =
ptryFrom' @_ @(PAsData PInteger) d $
-- JUSTIFICATION:
-- We are coercing from @PAsData PInteger@ to @PAsData PResultTag@.
-- Since 'PResultTag' is a simple newtype, their shape is the same.
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype PResultTag PInteger)
instance
PTryFrom PData (PAsData PResultTag)
-- JUSTIFICATION:
-- We are coercing from @PAsData PInteger@ to @PAsData PResultTag@.
-- Since 'PResultTag' is a simple newtype, their shape is the same.
k . first punsafeCoerce
{- | Plutarch-level version of 'PProposalId'.
-- | Plutarch-level version of 'PProposalId'.
@since 0.1.0
-}
newtype PProposalId (s :: S) = PProposalId (Term s PInteger)
deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalId PInteger)
deriving
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PEq
, -- | @since 0.1.0
POrd
)
via (DerivePNewtype PProposalId PInteger)
instance PTryFrom PData (PAsData PProposalId) where
type PTryFromExcess PData (PAsData PProposalId) = PTryFromExcess PData (PAsData PInteger)
ptryFrom' d k =
ptryFrom' @_ @(PAsData PInteger) d $
-- JUSTIFICATION:
-- We are coercing from @PAsData PInteger@ to @PAsData PProposalId@.
-- Since 'PProposalId' is a simple newtype, their shape is the same.
-- JUSTIFICATION:
-- We are coercing from @PAsData PInteger@ to @PAsData PProposalId@.
-- Since 'PProposalId' is a simple newtype, their shape is the same.
k . first punsafeCoerce
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype PProposalId PInteger)
instance
PTryFrom PData (PAsData PProposalId)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalId where type PLifted PProposalId = ProposalId
-- | @since 0.1.0
deriving via
(DerivePConstantViaNewtype ProposalId PProposalId PInteger)
instance
(PConstantDecl ProposalId)
-- | Plutarch-level version of 'ProposalStatus'.
{- | Plutarch-level version of 'ProposalStatus'.
@since 0.1.0
-}
data PProposalStatus (s :: S)
= -- TODO: 'PProposalStatus' ought te be encoded as 'PInteger'.
-- e.g. like Tilde used 'pmatchEnum'.
@ -331,17 +439,41 @@ data PProposalStatus (s :: S)
| PVotingReady (Term s (PDataRecord '[]))
| PLocked (Term s (PDataRecord '[]))
| PFinished (Term s (PDataRecord '[]))
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PEq)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PEq
)
via PIsDataReprInstances PProposalStatus
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalStatus where type PLifted PProposalStatus = ProposalStatus
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PProposalStatus) instance PTryFrom PData (PAsData PProposalStatus)
-- | @since 0.1.0
deriving via (DerivePConstantViaData ProposalStatus PProposalStatus) instance (PConstantDecl ProposalStatus)
-- | Plutarch-level version of 'ProposalThresholds'.
{- | Plutarch-level version of 'ProposalThresholds'.
@since 0.1.0
-}
newtype PProposalThresholds (s :: S) = PProposalThresholds
{ getProposalThresholds ::
Term
@ -353,22 +485,67 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
)
via (PIsDataReprInstances PProposalThresholds)
instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds
deriving via (DerivePConstantViaData ProposalThresholds PProposalThresholds) instance (PConstantDecl ProposalThresholds)
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PProposalThresholds)
instance
PTryFrom PData (PAsData PProposalThresholds)
-- | Plutarch-level version of 'ProposalVotes'.
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds
-- | @since 0.1.0
deriving via
(DerivePConstantViaData ProposalThresholds PProposalThresholds)
instance
(PConstantDecl ProposalThresholds)
{- | Plutarch-level version of 'ProposalVotes'.
@since 0.1.0
-}
newtype PProposalVotes (s :: S)
= PProposalVotes (Term s (PMap 'Unsorted PResultTag PInteger))
deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
deriving
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
)
via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
-- | Retract votes given the option and the amount of votes.
-- | @since 0.1.0
deriving via
PAsData (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
instance
PTryFrom PData (PAsData PProposalVotes)
{- | Retract votes given the option and the amount of votes.
@since 0.1.0
-}
pretractVotes :: Term s (PResultTag :--> PInteger :--> PProposalVotes :--> PProposalVotes)
pretractVotes = phoistAcyclic $
plam $ \rt count votes ->
@ -386,13 +563,19 @@ pretractVotes = phoistAcyclic $
# rt
# voteMap
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalVotes where type PLifted PProposalVotes = ProposalVotes
-- | @since 0.1.0
deriving via
(DerivePConstantViaNewtype ProposalVotes PProposalVotes (PMap 'Unsorted PResultTag PInteger))
instance
(PConstantDecl ProposalVotes)
-- | Plutarch-level version of 'emptyVotesFor'.
{- | Plutarch-level version of 'emptyVotesFor'.
@since 0.1.0
-}
pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap 'Unsorted PResultTag a :--> PProposalVotes)
pemptyVotesFor =
phoistAcyclic $
@ -402,7 +585,10 @@ pemptyVotesFor =
PProposalVotes $ PM.pmap # plam (const $ pconstant 0) # m
)
-- | Plutarch-level version of 'ProposalDatum'.
{- | Plutarch-level version of 'ProposalDatum'.
@since 0.1.0
-}
newtype PProposalDatum (s :: S) = PProposalDatum
{ getProposalDatum ::
Term
@ -419,48 +605,78 @@ newtype PProposalDatum (s :: S) = PProposalDatum
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields, PEq)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
, -- | @since 0.1.0
PEq
)
via (PIsDataReprInstances PProposalDatum)
-- TODO: Derive this.
instance PTryFrom PData (PAsData PProposalDatum) where
type PTryFromExcess PData (PAsData PProposalDatum) = Const ()
ptryFrom' d k =
k (punsafeCoerce d, ())
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PProposalDatum) instance PTryFrom PData (PAsData PProposalDatum)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalDatum where type PLifted PProposalDatum = ProposalDatum
-- | @since 0.1.0
deriving via (DerivePConstantViaData ProposalDatum PProposalDatum) instance (PConstantDecl ProposalDatum)
-- | Plutarch-level version of 'ProposalRedeemer'.
{- | Plutarch-level version of 'ProposalRedeemer'.
@since 0.1.0
-}
data PProposalRedeemer (s :: S)
= PVote (Term s (PDataRecord '["resultTag" ':= PResultTag]))
| PCosign (Term s (PDataRecord '["newCosigners" ':= PBuiltinList (PAsData PPubKeyHash)]))
| PUnlock (Term s (PDataRecord '["resultTag" ':= PResultTag]))
| PAdvanceProposal (Term s (PDataRecord '[]))
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
)
via PIsDataReprInstances PProposalRedeemer
-- See below.
instance PTryFrom PData (PAsData PProposalRedeemer) where
type PTryFromExcess PData (PAsData PProposalRedeemer) = Const ()
ptryFrom' d k =
k (punsafeCoerce d, ())
-- TODO: Waiting on PTryFrom for 'PPubKeyHash'
-- deriving via
-- PAsData (PIsDataReprInstances PProposalRedeemer)
-- instance
-- PTryFrom PData (PAsData PProposalRedeemer)
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PProposalRedeemer)
instance
PTryFrom PData (PAsData PProposalRedeemer)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalRedeemer where type PLifted PProposalRedeemer = ProposalRedeemer
-- | @since 0.1.0
deriving via (DerivePConstantViaData ProposalRedeemer PProposalRedeemer) instance (PConstantDecl ProposalRedeemer)
--------------------------------------------------------------------------------
@ -468,6 +684,8 @@ deriving via (DerivePConstantViaData ProposalRedeemer PProposalRedeemer) instanc
{- | Check for various invariants a proposal must uphold.
This can be used to check both upon creation and
upon any following state transitions in the proposal.
@since 0.1.0
-}
proposalDatumValid :: Proposal -> Term s (Agora.Proposal.PProposalDatum :--> PBool)
proposalDatumValid proposal =
@ -495,6 +713,8 @@ proposalDatumValid proposal =
The winner should be unambiguous, meaning that if two options have the same highest votes,
the "neutral" option will be the winner.
@since 0.1.0
-}
pwinner ::
Term
@ -540,7 +760,10 @@ pwinner = phoistAcyclic $
winnerResultTag
neutral
-- | Find the winning outcome (and the corresponding vote count) given the votes.
{- | Find the winning outcome (and the corresponding vote count) given the votes.
@since 0.1.0
-}
phighestVotes ::
Term
s
@ -566,7 +789,10 @@ phighestVotes = phoistAcyclic $
in pif (lastVotes #< thisVotes) this last
in pfoldr # f # (phead # l) # l
-- | Find the "neutral" option (a dummy outcome with no effect) given the effects.
{- | Find the "neutral" option (a dummy outcome with no effect) given the effects.
@since 0.1.0
-}
pneutralOption ::
Term
s

4
agora/Agora/Proposal/Scripts.hs
View file

@ -85,6 +85,8 @@ import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
=== For burning:
- This policy cannot be burned.
@since 0.1.0
-}
proposalPolicy ::
-- | The assetclass of GST, see 'Agora.Governor.Scripts.governorPolicy'.
@ -142,6 +144,8 @@ A list of all time-sensitive redeemers and their requirements:
- 'Agora.Proposal.AdvanceProposal' can only be used when the status can be advanced
(see 'Agora.Proposal.AdvanceProposal' docs).
- 'Agora.Proposal.Unlock' is always valid.
@since 0.1.0
-}
proposalValidator :: Proposal -> ClosedTerm PValidator
proposalValidator proposal =

165
agora/Agora/Proposal/Time.hs
View file

@ -1,5 +1,4 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{- |
Module : Agora.Proposal.Time
@ -29,6 +28,7 @@ module Agora.Proposal.Time (
isExecutionPeriod,
) where
import Agora.Plutarch.Orphans ()
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
import Plutarch.Api.V1 (
@ -51,14 +51,16 @@ import Plutarch.Lift (
PUnsafeLiftDecl (..),
)
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
import Plutarch.Unsafe (punsafeCoerce)
import PlutusLedgerApi.V1.Time (POSIXTime)
import PlutusTx qualified
import Prelude hiding ((+))
--------------------------------------------------------------------------------
-- | Represents the starting time of the proposal.
{- | Represents the starting time of the proposal.
@since 0.1.0
-}
newtype ProposalStartingTime = ProposalStartingTime
{ getProposalStartingTime :: POSIXTime
}
@ -67,7 +69,9 @@ newtype ProposalStartingTime = ProposalStartingTime
{- | Configuration of proposal timings.
See: https://github.com/Liqwid-Labs/agora/blob/master/docs/tech-design/proposals.md#when-may-interactions-occur
See: https://liqwid.notion.site/Proposals-589853145a994057aa77f397079f75e4#d25ea378768d4c76b52dd4c1b6bc0fcd
@since 0.1.0
-}
data ProposalTimingConfig = ProposalTimingConfig
{ draftTime :: POSIXTime
@ -79,14 +83,38 @@ data ProposalTimingConfig = ProposalTimingConfig
, executingTime :: POSIXTime
-- ^ "E": the length of the execution period.
}
deriving stock (Eq, Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed ''ProposalTimingConfig [('ProposalTimingConfig, 0)]
-- | Represents the maximum width of a 'PlutusLedgerApi.V1.Time.POSIXTimeRange'.
newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime}
deriving stock (Eq, Show, Ord, GHC.Generic)
deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
Ord
, -- | @since 0.1.0
GHC.Generic
)
deriving newtype
( -- | @since 0.1.0
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
--------------------------------------------------------------------------------
@ -114,26 +142,61 @@ newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime}
Note: 'PProposalTime' doesn't need a Haskell-level equivalent because it
is only used in scripts, and does not go in datums. It is also scott-encoded
which is more efficient in usage.
@since 0.1.0
-}
data PProposalTime (s :: S) = PProposalTime
{ lowerBound :: Term s PPOSIXTime
, upperBound :: Term s PPOSIXTime
}
deriving stock (GHC.Generic)
deriving anyclass (Generic, PlutusType, HasDatatypeInfo, PEq)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
, -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
HasDatatypeInfo
, -- | @since 0.1.0
PEq
)
-- | Plutarch-level version of 'ProposalStartingTime'.
newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTime)
deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalStartingTime PPOSIXTime)
deriving
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PEq
, -- | @since 0.1.0
POrd
)
via (DerivePNewtype PProposalStartingTime PPOSIXTime)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalStartingTime where
type PLifted PProposalStartingTime = ProposalStartingTime
deriving via
PAsData (DerivePNewtype PProposalStartingTime PPOSIXTime)
instance
PTryFrom PData (PAsData PProposalStartingTime)
-- | @since 0.1.0
deriving via
(DerivePConstantViaNewtype ProposalStartingTime PProposalStartingTime PPOSIXTime)
instance
(PConstantDecl ProposalStartingTime)
-- | Plutarch-level version of 'ProposalTimingConfig'.
{- | Plutarch-level version of 'ProposalTimingConfig'.
@since 0.1.0
-}
newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
{ getProposalTimingConfig ::
Term
@ -146,15 +209,36 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
)
via (PIsDataReprInstances PProposalTimingConfig)
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PProposalTimingConfig) instance PTryFrom PData (PAsData PProposalTimingConfig)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalTimingConfig where
type PLifted PProposalTimingConfig = ProposalTimingConfig
-- | @since 0.1.0
deriving via
(DerivePConstantViaData ProposalTimingConfig PProposalTimingConfig)
instance
@ -163,9 +247,25 @@ deriving via
-- | Plutarch-level version of 'MaxTimeRangeWidth'.
newtype PMaxTimeRangeWidth (s :: S)
= PMaxTimeRangeWidth (Term s PPOSIXTime)
deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime)
deriving
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PEq
, -- | @since 0.1.0
POrd
)
via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime)
-- | @since 0.1.0
deriving via PAsData (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime) instance PTryFrom PData (PAsData PMaxTimeRangeWidth)
-- | @since 0.1.0
instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth
-- | @since 0.1.0
deriving via
(DerivePConstantViaNewtype MaxTimeRangeWidth PMaxTimeRangeWidth PPOSIXTime)
instance
@ -173,13 +273,11 @@ deriving via
--------------------------------------------------------------------------------
-- FIXME: Orphan instance, move this to plutarch-extra.
instance AdditiveSemigroup (Term s PPOSIXTime) where
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
{- | Get the starting time of a proposal, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
For every proposal, this is only meant to run once upon creation. Given time range should be
tight enough, meaning that the width of the time range should be less than the maximum value.
@since 0.1.0
-}
createProposalStartingTime :: forall (s :: S). Term s (PMaxTimeRangeWidth :--> PPOSIXTimeRange :--> PProposalStartingTime)
createProposalStartingTime = phoistAcyclic $
@ -203,6 +301,8 @@ createProposalStartingTime = phoistAcyclic $
If it's impossible to get a fully-bounded time, (e.g. either end of the 'PPOSIXTimeRange' is
an infinity) then we error out.
@since 0.1.0
-}
currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTime)
currentProposalTime = phoistAcyclic $
@ -232,7 +332,10 @@ currentProposalTime = phoistAcyclic $
)
}
-- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
{- | Check if 'PProposalTime' is within two 'PPOSIXTime'. Inclusive.
@since 0.1.0
-}
proposalTimeWithin ::
Term
s
@ -251,7 +354,10 @@ proposalTimeWithin = phoistAcyclic $
, ut #<= h
]
-- | True if the 'PProposalTime' is in the draft period.
{- | True if the 'PProposalTime' is in the draft period.
@since 0.1.0
-}
isDraftPeriod ::
forall (s :: S).
Term
@ -265,7 +371,10 @@ isDraftPeriod = phoistAcyclic $
plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) ->
proposalTimeWithin # s # (s + (pfield @"draftTime" # config))
-- | True if the 'PProposalTime' is in the voting period.
{- | True if the 'PProposalTime' is in the voting period.
@since 0.1.0
-}
isVotingPeriod ::
forall (s :: S).
Term
@ -280,7 +389,10 @@ isVotingPeriod = phoistAcyclic $
pletFields @'["draftTime", "votingTime"] config $ \f ->
proposalTimeWithin # s # (s + f.draftTime + f.votingTime)
-- | True if the 'PProposalTime' is in the locking period.
{- | True if the 'PProposalTime' is in the locking period.
@since 0.1.0
-}
isLockingPeriod ::
forall (s :: S).
Term
@ -295,7 +407,10 @@ isLockingPeriod = phoistAcyclic $
pletFields @'["draftTime", "votingTime", "lockingTime"] config $ \f ->
proposalTimeWithin # s # (s + f.draftTime + f.votingTime + f.lockingTime)
-- | True if the 'PProposalTime' is in the execution period.
{- | True if the 'PProposalTime' is in the execution period.
@since 0.1.0
-}
isExecutionPeriod ::
forall (s :: S).
Term

38
agora/Agora/SafeMoney.hs
View file

@ -1,7 +1,7 @@
{- |
Module : Agora.SafeMoney
Maintainer : emi@haskell.fyi
Description: Tags and bonuses for Plutarch.SafeMoney.
Description: Tags and extras for "Plutarch.SafeMoney".
Tags and extras for "Plutarch.SafeMoney".
-}
@ -14,32 +14,42 @@ module Agora.SafeMoney (
adaRef,
) where
--------------------------------------------------------------------------------
import Data.Tagged (Tagged (Tagged))
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
import Data.Tagged (Tagged (Tagged))
{- | Governance token.
--------------------------------------------------------------------------------
-- Tags
-- | Governance token.
@since 0.1.0
-}
data GTTag
-- | ADA.
{- | ADA.
@since 0.1.0
-}
data ADATag
-- | Governor ST token.
{- | Governor ST token.
@since 0.1.0
-}
data GovernorSTTag
-- | Stake ST token.
{- | Stake ST token.
@since 0.1.0
-}
data StakeSTTag
-- | Proposal ST token.
{- | Proposal ST token.
@since 0.1.0
-}
data ProposalSTTag
--------------------------------------------------------------------------------
{- | Resolves ada tags.
-- | Resolves ada tags.
@since 0.1.0
-}
adaRef :: Tagged ADATag AssetClass
adaRef = Tagged (AssetClass ("", ""))

52
agora/Agora/ScriptInfo.hs
View file

@ -22,17 +22,35 @@ import Plutarch.Api.V1 (PMintingPolicy, PValidator, mintingPolicySymbol, mkMinti
import PlutusLedgerApi.V1 (MintingPolicy, Validator, ValidatorHash)
import PlutusLedgerApi.V1.Value (CurrencySymbol)
-- | Bundle containing a 'Validator' and its hash.
{- | Bundle containing a 'Validator' and its hash.
@since 0.1.0
-}
data ValidatorInfo = ValidatorInfo
{ script :: Validator
-- ^ The validator script.
, hash :: ValidatorHash
-- ^ Hash of the validator.
}
deriving stock (Show, Eq, GHC.Generic)
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
deriving stock
( -- | @since 0.1.0
Show
, -- | @since 0.1.0
Eq
, -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Aeson.ToJSON
, -- | @since 0.1.0
Aeson.FromJSON
)
-- | Create a 'ValidatorInfo' given a Plutarch term.
{- | Create a 'ValidatorInfo' given a Plutarch term.
@since 0.1.0
-}
mkValidatorInfo :: ClosedTerm PValidator -> ValidatorInfo
mkValidatorInfo term =
ValidatorInfo
@ -42,17 +60,35 @@ mkValidatorInfo term =
where
validator = mkValidator term
-- | Bundle containing a 'MintingPolicy' and its symbol.
{- | Bundle containing a 'MintingPolicy' and its symbol.
@since 0.1.0
-}
data PolicyInfo = PolicyInfo
{ policy :: MintingPolicy
-- ^ The minting policy.
, currencySymbol :: CurrencySymbol
-- ^ The symbol given by the minting policy.
}
deriving stock (Show, Eq, GHC.Generic)
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
deriving stock
( -- | @since 0.1.0
Show
, -- | @since 0.1.0
Eq
, -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Aeson.ToJSON
, -- | @since 0.1.0
Aeson.FromJSON
)
-- | Create a 'PolicyInfo' given a Plutarch term.
{- | Create a 'PolicyInfo' given a Plutarch term.
@since 0.1.0
-}
mkPolicyInfo :: ClosedTerm PMintingPolicy -> PolicyInfo
mkPolicyInfo term =
PolicyInfo

174
agora/Agora/Stake.hs
View file

@ -26,22 +26,12 @@ module Agora.Stake (
pgetStakeUsage,
) where
--------------------------------------------------------------------------------
import Control.Applicative (Const)
import Agora.Plutarch.Orphans ()
import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
import Agora.SafeMoney (GTTag)
import Data.Tagged (Tagged (..))
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
import Prelude hiding (Num (..))
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (PubKeyHash)
import PlutusLedgerApi.V1.Value (AssetClass)
import PlutusTx qualified
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
PDatum,
PDatumHash,
@ -63,22 +53,26 @@ import Plutarch.Extra.TermCont (pletC, pletFieldsC, pmatchC)
import Plutarch.Internal (punsafeCoerce)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.SafeMoney (PDiscrete)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import PlutusLedgerApi.V1 (PubKeyHash)
import PlutusLedgerApi.V1.Value (AssetClass)
import PlutusTx qualified
import Prelude hiding (Num (..))
--------------------------------------------------------------------------------
import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
import Agora.SafeMoney (GTTag)
{- | Parameters for creating Stake scripts.
--------------------------------------------------------------------------------
-- | Parameters for creating Stake scripts.
@since 0.1.0
-}
data Stake = Stake
{ gtClassRef :: Tagged GTTag AssetClass
-- ^ Used when inlining the AssetClass of a 'PDiscrete' in the script code.
, proposalSTClass :: AssetClass
}
deriving stock (GHC.Generic)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
{- | A lock placed on a Stake datum in order to prevent
depositing and withdrawing when votes are in place.
@ -105,6 +99,8 @@ data Stake = Stake
│ Stake Policy │◄─┘ └►│ Proposal Policy │
└──────────────┘ └─────────────────┘
@
@since 0.1.0
-}
data ProposalLock = ProposalLock
{ vote :: ResultTag
@ -114,11 +110,19 @@ data ProposalLock = ProposalLock
-- ^ Identifies the proposal. See 'ProposalId' for further
-- comments on its significance.
}
deriving stock (Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
PlutusTx.makeIsDataIndexed ''ProposalLock [('ProposalLock, 0)]
-- | Haskell-level redeemer for Stake scripts.
{- | Haskell-level redeemer for Stake scripts.
@since 0.1.0
-}
data StakeRedeemer
= -- | Deposit or withdraw a discrete amount of the staked governance token.
-- Stake must be unlocked.
@ -151,7 +155,10 @@ PlutusTx.makeIsDataIndexed
, ('WitnessStake, 4)
]
-- | Haskell-level datum for Stake scripts.
{- | Haskell-level datum for Stake scripts.
@since 0.1.0
-}
data StakeDatum = StakeDatum
{ stakedAmount :: Tagged GTTag Integer
-- ^ Tracks the amount of governance token staked in the datum.
@ -171,7 +178,10 @@ PlutusTx.makeIsDataIndexed ''StakeDatum [('StakeDatum, 0)]
--------------------------------------------------------------------------------
-- | Plutarch-level datum for Stake scripts.
{- | Plutarch-level datum for Stake scripts.
@since 0.1.0
-}
newtype PStakeDatum (s :: S) = PStakeDatum
{ getStakeDatum ::
Term
@ -183,22 +193,43 @@ newtype PStakeDatum (s :: S) = PStakeDatum
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData, PDataFields, PEq)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
, -- | @since 0.1.0
PDataFields
, -- | @since 0.1.0
PEq
)
via (PIsDataReprInstances PStakeDatum)
instance PTryFrom PData (PAsData PStakeDatum) where
type PTryFromExcess PData (PAsData PStakeDatum) = Const ()
ptryFrom' d k =
k (punsafeCoerce d, ())
-- | @since 0.1.0
instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum
instance PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum
deriving via (DerivePConstantViaData StakeDatum PStakeDatum) instance (PConstantDecl StakeDatum)
-- | @since 0.1.0
deriving via (DerivePConstantViaData StakeDatum PStakeDatum) instance (Plutarch.Lift.PConstantDecl StakeDatum)
-- | Plutarch-level redeemer for Stake scripts.
-- | @since 0.1.0
deriving via PAsData (PIsDataReprInstances PStakeDatum) instance PTryFrom PData (PAsData PStakeDatum)
{- | Plutarch-level redeemer for Stake scripts.
@since 0.1.0
-}
data PStakeRedeemer (s :: S)
= -- | Deposit or withdraw a discrete amount of the staked governance token.
PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag]))
@ -207,11 +238,24 @@ data PStakeRedeemer (s :: S)
| PPermitVote (Term s (PDataRecord '["lock" ':= PProposalLock]))
| PRetractVotes (Term s (PDataRecord '["locks" ':= PBuiltinList (PAsData PProposalLock)]))
| PWitnessStake (Term s (PDataRecord '[]))
deriving stock (GHC.Generic)
deriving anyclass (Generic)
deriving anyclass (PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
)
deriving anyclass
( -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
)
via PIsDataReprInstances PStakeRedeemer
deriving via
@ -219,10 +263,13 @@ deriving via
instance
PTryFrom PData (PAsData PStakeRedeemer)
instance PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer
deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (PConstantDecl StakeRedeemer)
instance Plutarch.Lift.PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer
deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (Plutarch.Lift.PConstantDecl StakeRedeemer)
-- | Plutarch-level version of 'ProposalLock'.
{- | Plutarch-level version of 'ProposalLock'.
@since 0.1.0
-}
newtype PProposalLock (s :: S) = PProposalLock
{ getProposalLock ::
Term
@ -245,12 +292,15 @@ deriving via
instance
PTryFrom PData (PAsData PProposalLock)
instance PUnsafeLiftDecl PProposalLock where type PLifted PProposalLock = ProposalLock
deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (PConstantDecl ProposalLock)
instance Plutarch.Lift.PUnsafeLiftDecl PProposalLock where type PLifted PProposalLock = ProposalLock
deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (Plutarch.Lift.PConstantDecl ProposalLock)
--------------------------------------------------------------------------------
-- | Check whether a Stake is locked. If it is locked, various actions are unavailable.
{- | Check whether a Stake is locked. If it is locked, various actions are unavailable.
@since 0.1.0
-}
stakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool)
stakeLocked = phoistAcyclic $
plam $ \stakeDatum ->
@ -258,7 +308,10 @@ stakeLocked = phoistAcyclic $
locks = pfield @"lockedBy" # stakeDatum
in pnotNull # locks
-- | Find a stake owned by a particular PK.
{- | Find a stake owned by a particular PK.
@since 0.1.0
-}
findStakeOwnedBy ::
Term
s
@ -281,6 +334,10 @@ findStakeOwnedBy = phoistAcyclic $
PDJust ((pfield @"_0" #) -> dh) ->
ptryFindDatum @(PAsData PStakeDatum) # dh # datums
{- | Check if a StakeDatum is owned by a particular public key.
@since 0.1.0
-}
stakeDatumOwnedBy :: Term _ (PPubKeyHash :--> PStakeDatum :--> PBool)
stakeDatumOwnedBy =
phoistAcyclic $
@ -288,7 +345,10 @@ stakeDatumOwnedBy =
pletFields @'["owner"] (pto stakeDatum) $ \stakeDatumF ->
stakeDatumF.owner #== pdata pk
-- | Does the input have a `Stake` owned by a particular PK?
{- | Does the input have a `Stake` owned by a particular PK?
@since 0.1.0
-}
isInputStakeOwnedBy ::
Term
_
@ -317,16 +377,32 @@ isInputStakeOwnedBy =
{- | Represent the usage of a stake on a particular proposal.
A stake can be used to either create or vote on a proposal.
@since 0.1.0
-}
data PStakeUsage (s :: S)
= PVotedFor (Term s PResultTag)
| PCreated
| PDidNothing
deriving stock (GHC.Generic)
deriving anyclass (Generic, PlutusType, HasDatatypeInfo, PEq)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
, -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
HasDatatypeInfo
, -- | @since 0.1.0
PEq
)
{- | / O(n) /.Return the usage of a stake on a particular proposal,
given the 'lockedBy' field of a stake and the target proposal.
@since 0.1.0
-}
pgetStakeUsage ::
Term

4
agora/Agora/Stake/Scripts.hs
View file

@ -57,6 +57,8 @@ import Prelude hiding (Num (..))
- Check that exactly one state thread is burned.
- Check that datum at state thread is valid and not locked.
@since 0.1.0
-}
stakePolicy ::
-- | The (governance) token that a Stake can store.
@ -200,6 +202,8 @@ this could use [CIP-31](https://cips.cardano.org/cips/cip31/) instead.
- Tx must be signed by the owner __or__ a proposal ST token must be spent
alongside the stake.
- The datum and value must remain unchanged.
@since 0.1.0
-}
stakeValidator :: Stake -> ClosedTerm PValidator
stakeValidator stake =

43
agora/Agora/Treasury.hs
View file

@ -12,7 +12,7 @@ module Agora.Treasury (module Agora.Treasury) where
import Agora.AuthorityToken (singleAuthorityTokenBurned)
import GHC.Generics qualified as GHC
import Generics.SOP
import Generics.SOP (Generic, I (I))
import Plutarch.Api.V1 (PValidator)
import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting))
import "plutarch" Plutarch.Api.V1.Value (PValue)
@ -26,14 +26,23 @@ import Plutarch.TryFrom ()
import PlutusLedgerApi.V1.Value (CurrencySymbol)
import PlutusTx qualified
--------------------------------------------------------------------------------
{- | Redeemer for Treasury actions.
-- | Redeemer for Treasury actions.
@since 0.1.0
-}
data TreasuryRedeemer
= -- | Allow transaction to pass by delegating to GAT burn.
SpendTreasuryGAT
deriving stock (Eq, Show, GHC.Generic)
deriving stock
( -- | @since 0.1.0
Eq
, -- | @since 0.1.0
Show
, -- | @since 0.1.0
GHC.Generic
)
-- | @since 0.1.0
PlutusTx.makeIsDataIndexed
''TreasuryRedeemer
[ ('SpendTreasuryGAT, 0)
@ -43,24 +52,42 @@ PlutusTx.makeIsDataIndexed
{- | Plutarch level type representing valid redeemers of the
treasury.
@since 0.1.0
-}
newtype PTreasuryRedeemer (s :: S)
= -- | Alters treasury parameters, subject to the burning of a
-- governance authority token.
PSpendTreasuryGAT (Term s (PDataRecord '[]))
deriving stock (GHC.Generic)
deriving anyclass (Generic, PIsDataRepr)
deriving stock
( -- | @since 0.1.0
GHC.Generic
)
deriving anyclass
( -- | @since 0.1.0
Generic
, -- | @since 0.1.0
PIsDataRepr
)
deriving
(PlutusType, PIsData)
( -- | @since 0.1.0
PlutusType
, -- | @since 0.1.0
PIsData
)
via PIsDataReprInstances PTreasuryRedeemer
-- | @since 0.1.0
deriving via
PAsData (PIsDataReprInstances PTreasuryRedeemer)
instance
PTryFrom PData (PAsData PTreasuryRedeemer)
-- | @since 0.1.0
instance PUnsafeLiftDecl PTreasuryRedeemer where
type PLifted PTreasuryRedeemer = TreasuryRedeemer
-- | @since 0.1.0
deriving via
(DerivePConstantViaData TreasuryRedeemer PTreasuryRedeemer)
instance
@ -70,6 +97,8 @@ deriving via
{- | Validator ensuring that transactions consuming the treasury
do so in a valid manner.
@since 0.1.0
-}
treasuryValidator ::
-- | Governance Authority Token that can unlock this validator.

75
agora/Agora/Utils.hs
View file

@ -21,18 +21,6 @@ module Agora.Utils (
isPubKey,
) where
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (
Address (..),
Credential (..),
CurrencySymbol,
TokenName (..),
ValidatorHash (..),
)
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
AmountGuarantees,
KeyGuarantees,
@ -56,12 +44,22 @@ import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
import Plutarch.Builtin (pforgetData)
import Plutarch.Extra.List (plookupTuple)
import Plutarch.Extra.TermCont (pletC, pmatchC)
import PlutusLedgerApi.V1 (
Address (..),
Credential (..),
CurrencySymbol,
TokenName (..),
ValidatorHash (..),
)
{- Functions which should (probably) not be upstreamed
All of these functions are quite inefficient.
-}
-- | Get script hash from an Address.
{- | Get script hash from an Address.
@since 0.1.0
-}
scriptHashFromAddress :: Term s (PAddress :--> PMaybe PValidatorHash)
scriptHashFromAddress = phoistAcyclic $
plam $ \addr ->
@ -69,12 +67,18 @@ scriptHashFromAddress = phoistAcyclic $
PScriptCredential ((pfield @"_0" #) -> h) -> pcon $ PJust h
_ -> pcon PNothing
-- | Return true if the given address is a script address.
{- | Return true if the given address is a script address.
@since 0.1.0
-}
isScriptAddress :: Term s (PAddress :--> PBool)
isScriptAddress = phoistAcyclic $
plam $ \addr -> pnot #$ isPubKey #$ pfromData $ pfield @"credential" # addr
-- | Return true if the given credential is a pub-key-hash.
{- | Return true if the given credential is a pub-key-hash.
@since 0.1.0
-}
isPubKey :: Term s (PCredential :--> PBool)
isPubKey = phoistAcyclic $
plam $ \cred ->
@ -82,7 +86,10 @@ isPubKey = phoistAcyclic $
PScriptCredential _ -> pconstant False
_ -> pconstant True
-- | Find all TxOuts sent to an Address
{- | Find all TxOuts sent to an Address
@since 0.1.0
-}
findOutputsToAddress :: Term s (PBuiltinList (PAsData PTxOut) :--> PAddress :--> PBuiltinList (PAsData PTxOut))
findOutputsToAddress = phoistAcyclic $
plam $ \outputs address' -> unTermCont $ do
@ -91,7 +98,10 @@ findOutputsToAddress = phoistAcyclic $
pfilter # plam (\(pfromData -> txOut) -> pfield @"address" # txOut #== address)
# outputs
-- | Find the data corresponding to a TxOut, if there is one
{- | Find the data corresponding to a TxOut, if there is one
@since 0.1.0
-}
findTxOutDatum :: Term s (PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PTxOut :--> PMaybe PDatum)
findTxOutDatum = phoistAcyclic $
plam $ \datums out -> unTermCont $ do
@ -102,19 +112,30 @@ findTxOutDatum = phoistAcyclic $
{- | Safely convert a 'PValidatorHash' into a 'PTokenName'. This can be useful for tagging
tokens for extra safety.
@since 0.1.0
-}
validatorHashToTokenName :: ValidatorHash -> TokenName
validatorHashToTokenName (ValidatorHash hash) = TokenName hash
-- | Plutarch level 'validatorHashToTokenName'.
{- | Plutarch level 'validatorHashToTokenName'.
@since 0.1.0
-}
pvalidatorHashToTokenName :: forall (s :: S). Term s PValidatorHash -> Term s PTokenName
pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh))
-- | Get the CurrencySymbol of a PMintingPolicy.
{- | Get the CurrencySymbol of a PMintingPolicy.
@since 0.1.0
-}
getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol
getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v
-- | The entire value only contains one token of the given currency symbol.
{- | The entire value only contains one token of the given currency symbol.
@since 0.1.0
-}
hasOnlyOneTokenOfCurrencySymbol ::
forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
Term s (PCurrencySymbol :--> PValue keys amounts :--> PBool)
@ -123,7 +144,10 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $
psymbolValueOf # cs # vs #== 1
#&& (plength #$ pto $ pto $ pto vs) #== 1
-- | Find datum given a maybe datum hash
{- | Find datum given a maybe datum hash
@since 0.1.0
-}
mustFindDatum' ::
forall (datum :: PType).
(PIsData datum, PTryFrom PData (PAsData datum)) =>
@ -143,6 +167,8 @@ mustFindDatum' = phoistAcyclic $
{- | Extract the value stored in a PMaybe container.
If there's no value, throw an error with the given message.
@since 0.1.0
-}
mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a)
mustBePJust = phoistAcyclic $
@ -152,6 +178,8 @@ mustBePJust = phoistAcyclic $
{- | Extract the value stored in a PMaybeData container.
If there's no value, throw an error with the given message.
@since 0.1.0
-}
mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :--> a)
mustBePDJust = phoistAcyclic $
@ -159,6 +187,9 @@ mustBePDJust = phoistAcyclic $
PDJust ((pfield @"_0" #) -> v) -> v
_ -> ptraceError emsg
-- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
{- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
@since 0.1.0
-}
validatorHashToAddress :: ValidatorHash -> Address
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing

64
bench.csv
View file

@ -1,37 +1,37 @@
name,cpu,mem,size
Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289254528,702155,3182
Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448314458,1069267,3509
Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,407878321,965148,3374
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358
Agora/Stake/policy/stakeCreation,43114795,124549,2156
Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4189
Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4177
Agora/Proposal/policy/proposalCreation,23140177,69194,1518
Agora/Proposal/validator/cosignature/proposal,204468349,563576,6644
Agora/Proposal/validator/cosignature/stake,114125937,284821,4726
Agora/Proposal/validator/voting/proposal,165922664,436410,6573
Agora/Proposal/validator/voting/stake,107127768,275725,4700
Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,161811766,432942,6471
Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,160968344,431439,6474
Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162664811,435045,6474
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160681965,430212,6473
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159273054,427507,6474
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160404032,429911,6474
"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",181038199,485408,6524
"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",155771580,420896,6528
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",154838669,421191,6528
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",154838669,421191,6528
"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",2577778520,7019619,28042
"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",2298521083,6224856,28311
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",2297588172,6225151,28211
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",2297588172,6225151,28211
Agora/Effects/Treasury Withdrawal Effect/effect/Simple,68035487,187575,3723
Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,82245885,228733,4050
Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,81358886,228858,3915
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,90397270,249528,8799
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,106082031,292993,3609
Agora/Stake/policy/stakeCreation,52241265,152127,2514
Agora/Stake/validator/stakeDepositWithdraw deposit,180880812,492023,4431
Agora/Stake/validator/stakeDepositWithdraw withdraw,180880812,492023,4419
Agora/Proposal/policy/proposalCreation,23140177,69194,1519
Agora/Proposal/validator/cosignature/proposal,338414402,960812,8364
Agora/Proposal/validator/cosignature/stake,126327509,315061,4968
Agora/Proposal/validator/voting/proposal,298791918,833990,8293
Agora/Proposal/validator/voting/stake,125076577,331847,4942
Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,292475323,820090,8191
Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,291631901,818587,8194
Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,293328368,822193,8194
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,291345522,817360,8193
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,289936611,814655,8194
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,291067589,817059,8194
"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",304637691,851452,8244
"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",275360000,776686,8248
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",270836329,766331,8248
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",270836329,766331,8248
"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",3074171496,8538583,29762
"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",2782286591,7741684,30031
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",2630541760,7294679,29931
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",2630541760,7294679,29931
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390
Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1391
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
Agora/Governor/policy/GST minting,43087287,120125,1829
Agora/Governor/validator/proposal creation,261928725,689487,8181
Agora/Governor/validator/GATs minting,352305185,937264,8302
Agora/Governor/validator/mutate governor state,84905433,234687,7766
Agora/Governor/policy/GST minting,51007235,144191,2034
Agora/Governor/validator/proposal creation,317651809,854963,9315
Agora/Governor/validator/GATs minting,122322162,331416,9436
Agora/Governor/validator/mutate governor state,91544121,254987,8900

1 name cpu mem size
2 Agora/Effects/Treasury Withdrawal Effect/effect/Simple 289254528 68035487 702155 187575 3182 3723
3 Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries 448314458 82245885 1069267 228733 3509 4050
4 Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets 407878321 81358886 965148 228858 3374 3915
5 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass 83758582 90397270 229228 249528 7665 8799
6 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass 97345575 106082031 266935 292993 3358 3609
7 Agora/Stake/policy/stakeCreation 43114795 52241265 124549 152127 2156 2514
8 Agora/Stake/validator/stakeDepositWithdraw deposit 171823342 180880812 464745 492023 4189 4431
9 Agora/Stake/validator/stakeDepositWithdraw withdraw 171823342 180880812 464745 492023 4177 4419
10 Agora/Proposal/policy/proposalCreation 23140177 69194 1518 1519
11 Agora/Proposal/validator/cosignature/proposal 204468349 338414402 563576 960812 6644 8364
12 Agora/Proposal/validator/cosignature/stake 114125937 126327509 284821 315061 4726 4968
13 Agora/Proposal/validator/voting/proposal 165922664 298791918 436410 833990 6573 8293
14 Agora/Proposal/validator/voting/stake 107127768 125076577 275725 331847 4700 4942
15 Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady 161811766 292475323 432942 820090 6471 8191
16 Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked 160968344 291631901 431439 818587 6474 8194
17 Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished 162664811 293328368 435045 822193 6474 8194
18 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished 160681965 291345522 430212 817360 6473 8193
19 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished 159273054 289936611 427507 814655 6474 8194
20 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished 160404032 291067589 429911 817059 6474 8194
21 Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady 181038199 304637691 485408 851452 6524 8244
22 Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished 155771580 275360000 420896 776686 6528 8248
23 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished 154838669 270836329 421191 766331 6528 8248
24 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked 154838669 270836329 421191 766331 6528 8248
25 Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady 2577778520 3074171496 7019619 8538583 28042 29762
26 Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished 2298521083 2782286591 6224856 7741684 28311 30031
27 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished 2297588172 2630541760 6225151 7294679 28211 29931
28 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked 2297588172 2630541760 6225151 7294679 28211 29931
29 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple 21017788 55883 806
30 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs 33204186 88241 900
31 Agora/Treasury/Validator/Positive/Allows for effect changes 29938856 79744 1390 1391
32 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple 21017788 55883 806
33 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs 33204186 88241 900
34 Agora/Governor/policy/GST minting 43087287 51007235 120125 144191 1829 2034
35 Agora/Governor/validator/proposal creation 261928725 317651809 689487 854963 8181 9315
36 Agora/Governor/validator/GATs minting 352305185 122322162 937264 331416 8302 9436
37 Agora/Governor/validator/mutate governor state 84905433 91544121 234687 254987 7766 8900