Emily
GitHub
commit
ec36891852
31 changed files with 1444 additions and 1160 deletions
|
|
@ -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
75
README.md
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
File diff suppressed because one or more lines are too long
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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' ->
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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,46 +88,65 @@ 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)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{- | Validator for the governor mutation effect.
|
||||
|
||||
This effect is implemented using the 'Agora.Effect.makeEffect' wrapper,
|
||||
meaning that the burning of GAT is checked in said wrapper.
|
||||
This effect is implemented using the 'Agora.Effect.makeEffect' wrapper,
|
||||
meaning that the burning of GAT is checked in said wrapper.
|
||||
|
||||
In order to locate the governor, the validator is parametrized with a 'Agora.Governor.Governor'.
|
||||
In order to locate the governor, the validator is parametrized with a 'Agora.Governor.Governor'.
|
||||
|
||||
All the information it needs to validate the effect is encoded in the 'MutateGovernorDatum',
|
||||
so regardless what redeemer it's given, it will check:
|
||||
All the information it needs to validate the effect is encoded in the 'MutateGovernorDatum',
|
||||
so regardless what redeemer it's given, it will check:
|
||||
|
||||
- No token is minted/burnt other than GAT.
|
||||
- Nothing is being paid to the the effect validator.
|
||||
- The governor's state UTXO must be spent:
|
||||
- No token is minted/burnt other than GAT.
|
||||
- Nothing is being paid to the the effect validator.
|
||||
- The governor's state UTXO must be spent:
|
||||
|
||||
* It carries exactly one GST.
|
||||
* It's referenced by 'governorRef' in the effect's datum.
|
||||
* It carries exactly one GST.
|
||||
* It's referenced by 'governorRef' in the effect's datum.
|
||||
|
||||
- A new state UTXO is paid to the governor:
|
||||
- A new state UTXO is paid to the governor:
|
||||
|
||||
* It contains the GST.
|
||||
* It has valid governor state datum.
|
||||
* The datum is exactly the same as the 'newDatum'.
|
||||
* 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) $
|
||||
|
|
|
|||
|
|
@ -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 ())
|
||||
|
|
|
|||
|
|
@ -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,16 +36,17 @@ 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
|
||||
|
||||
{- | Datum that encodes behavior of Treasury Withdrawal effect.
|
||||
|
||||
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.
|
||||
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...
|
||||
1. Transaction outputs should contain all of what Datum specified
|
||||
2. Left over assets should be redirected back to Treasury
|
||||
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 $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
@ -191,87 +193,89 @@ governorPolicy gov =
|
|||
|
||||
{- | Validator for Governors.
|
||||
|
||||
== Common checks
|
||||
== Common checks
|
||||
|
||||
The validator always ensures:
|
||||
The validator always ensures:
|
||||
|
||||
- The UTXO which holds the GST must be spent.
|
||||
- The GST always stays at the validator's address.
|
||||
- The new state UTXO has a valid datum of type 'Agora.Governor.GovernorDatum'.
|
||||
- The UTXO which holds the GST must be spent.
|
||||
- The GST always stays at the validator's address.
|
||||
- The new state UTXO has a valid datum of type 'Agora.Governor.GovernorDatum'.
|
||||
|
||||
== Creating a Proposal
|
||||
== Creating a Proposal
|
||||
|
||||
When the redeemer is 'Agora.Governor.CreateProposal', the script will check:
|
||||
When the redeemer is 'Agora.Governor.CreateProposal', the script will check:
|
||||
|
||||
- For governor's state datum:
|
||||
- For governor's state datum:
|
||||
|
||||
* 'Agora.Governor.nextProposalId' is advanced.
|
||||
* Nothing is changed other that that.
|
||||
* 'Agora.Governor.nextProposalId' is advanced.
|
||||
* Nothing is changed other that that.
|
||||
|
||||
- Exactly one stake (the "input stake") must be provided in the input:
|
||||
* At least 'Agora.Stake.stackedAmount' of GT must be spent in the transaction.
|
||||
* The transaction must be signed by the stake owner.
|
||||
- Exactly one stake (the "input stake") must be provided in the input:
|
||||
* At least 'Agora.Stake.stackedAmount' of GT must be spent in the transaction.
|
||||
* The transaction must be signed by the stake owner.
|
||||
|
||||
- Exactly one new proposal state token is minted.
|
||||
- An UTXO which holds the newly minted proposal state token is sent to the proposal validator.
|
||||
This UTXO must have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must:
|
||||
- Exactly one new proposal state token is minted.
|
||||
- An UTXO which holds the newly minted proposal state token is sent to the proposal validator.
|
||||
This UTXO must have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must:
|
||||
|
||||
* Copy its id and thresholds from the governor's state.
|
||||
* Have status set to 'Proposal.Draft'.
|
||||
* Have zero votes.
|
||||
* Have exactly one cosigner - the stake owner
|
||||
* Copy its id and thresholds from the governor's state.
|
||||
* Have status set to 'Proposal.Draft'.
|
||||
* Have zero votes.
|
||||
* Have exactly one cosigner - the stake owner
|
||||
|
||||
- An UTXO which holds the stake state token is sent back to the stake validator.
|
||||
This UTXO must have a valid datum of type 'Agora.Stake.StakeDatum':
|
||||
- An UTXO which holds the stake state token is sent back to the stake validator.
|
||||
This UTXO must have a valid datum of type 'Agora.Stake.StakeDatum':
|
||||
|
||||
* The 'Agora.Stake.stakedAmount' and 'Agora.Stake.owner' should not be changed,
|
||||
comparing to the input stake.
|
||||
* The new proposal locks must be appended to the 'Agora.Stake.lockedBy'.
|
||||
* The 'Agora.Stake.stakedAmount' and 'Agora.Stake.owner' should not be changed,
|
||||
comparing to the input stake.
|
||||
* The new proposal locks must be appended to the 'Agora.Stake.lockedBy'.
|
||||
|
||||
== Minting GATs
|
||||
== Minting GATs
|
||||
|
||||
When the redeemer is 'Agora.Governor.MintGATs', the script will check:
|
||||
When the redeemer is 'Agora.Governor.MintGATs', the script will check:
|
||||
|
||||
- Governor's state is not changed.
|
||||
- Exactly only one proposal is in the inputs. Let's call this the /input proposal/.
|
||||
- The proposal is in the 'Proposal.Executable' state.
|
||||
- Governor's state is not changed.
|
||||
- Exactly only one proposal is in the inputs. Let's call this the /input proposal/.
|
||||
- The proposal is in the 'Proposal.Executable' state.
|
||||
|
||||
NOTE: The input proposal is found by looking for the UTXO with a proposal state token in the inputs.
|
||||
NOTE: The input proposal is found by looking for the UTXO with a proposal state token in the inputs.
|
||||
|
||||
=== Effect Group Selection
|
||||
=== Effect Group Selection
|
||||
|
||||
Currently a proposal can have two or more than two options to vote on,
|
||||
meaning that it can contains two or more effect groups,
|
||||
according to [#39](https://github.com/Liqwid-Labs/agora/issues/39).
|
||||
Currently a proposal can have two or more than two options to vote on,
|
||||
meaning that it can contains two or more effect groups,
|
||||
according to [#39](https://github.com/Liqwid-Labs/agora/issues/39).
|
||||
|
||||
Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same.
|
||||
This is checked by 'Proposal.proposalDatumValid'.
|
||||
Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same.
|
||||
This is checked by 'Proposal.proposalDatumValid'.
|
||||
|
||||
The script will look at the the 'Proposal.votes' to determine which group has the highest votes,
|
||||
said group shoud be executed.
|
||||
The script will look at the the 'Proposal.votes' to determine which group has the highest votes,
|
||||
said group shoud be executed.
|
||||
|
||||
During the process, minimum votes requirement will also be enforced.
|
||||
During the process, minimum votes requirement will also be enforced.
|
||||
|
||||
Next, the script will:
|
||||
Next, the script will:
|
||||
|
||||
- Ensure that for every effect in the said effect group,
|
||||
exactly one valid GAT is minted and sent to the effect.
|
||||
- The amount of GAT minted in the transaction should be equal to the number of effects.
|
||||
- A new UTXO is sent to the proposal validator, this UTXO should:
|
||||
- Ensure that for every effect in the said effect group,
|
||||
exactly one valid GAT is minted and sent to the effect.
|
||||
- The amount of GAT minted in the transaction should be equal to the number of effects.
|
||||
- A new UTXO is sent to the proposal validator, this UTXO should:
|
||||
|
||||
* Include the one proposal state token.
|
||||
* Have a valid datum of type 'Proposal.ProposalDatum'.
|
||||
This datum should be as same as the one of the input proposal,
|
||||
except its status should be 'Proposal.Finished'.
|
||||
* Include the one proposal state token.
|
||||
* Have a valid datum of type 'Proposal.ProposalDatum'.
|
||||
This datum should be as same as the one of the input proposal,
|
||||
except its status should be 'Proposal.Finished'.
|
||||
|
||||
== Changing the State
|
||||
== Changing the State
|
||||
|
||||
Redeemer 'Agora.Governor.MutateGovernor' allows the state datum to be changed by an external effect.
|
||||
Redeemer 'Agora.Governor.MutateGovernor' allows the state datum to be changed by an external effect.
|
||||
|
||||
In this case, the script will check
|
||||
In this case, the script will check
|
||||
|
||||
- Exactly one GAT is burnt in the transaction.
|
||||
- Said GAT is tagged by the effect.
|
||||
- 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
|
||||
|
|
|
|||
|
|
@ -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
134
agora/Agora/Plutarch/Orphans.hs
Normal 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)
|
||||
|
|
@ -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,21 +73,55 @@ 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:
|
||||
|
||||
@
|
||||
"No" ~ 'ResultTag' 0
|
||||
"Yes" ~ 'ResultTag' 1
|
||||
@
|
||||
@
|
||||
"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,32 +195,62 @@ 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.
|
||||
It's important that the "shape" is consistent with the shape of 'effects'.
|
||||
It's important that the "shape" is consistent with the shape of 'effects'.
|
||||
|
||||
e.g. if the 'effects' field looks like the following:
|
||||
e.g. if the 'effects' field looks like the following:
|
||||
|
||||
@[('ResultTag' 0, []), ('ResultTag' 1, [(vh, dh)])]@
|
||||
@[('ResultTag' 0, []), ('ResultTag' 1, [(vh, dh)])]@
|
||||
|
||||
Then 'ProposalVotes' needs be of the shape:
|
||||
Then 'ProposalVotes' needs be of the shape:
|
||||
|
||||
@[('ResultTag' 0, n), ('ResultTag' 1, m)]@
|
||||
@[('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 =
|
||||
|
|
@ -493,8 +711,10 @@ proposalDatumValid proposal =
|
|||
|
||||
{- | Find the winner result tag, given the votes, the quorum the "neutral" result tag.
|
||||
|
||||
The winner should be unambiguous, meaning that if two options have the same highest votes,
|
||||
the "neutral" option will be the winner.
|
||||
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
|
||||
|
|
|
|||
|
|
@ -70,21 +70,23 @@ import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
|
|||
|
||||
{- | Policy for Proposals.
|
||||
|
||||
== What this policy does
|
||||
== What this policy does
|
||||
|
||||
=== For minting:
|
||||
=== For minting:
|
||||
|
||||
- Governor is happy with mint.
|
||||
- Governor is happy with mint.
|
||||
|
||||
* The governor must do most of the checking for the validity of the
|
||||
transaction. For example, the governor must check that the datum
|
||||
is correct, and that the ST is correctly paid to the right validator.
|
||||
* The governor must do most of the checking for the validity of the
|
||||
transaction. For example, the governor must check that the datum
|
||||
is correct, and that the ST is correctly paid to the right validator.
|
||||
|
||||
- Exactly 1 token is minted.
|
||||
- Exactly 1 token is minted.
|
||||
|
||||
=== For burning:
|
||||
=== For burning:
|
||||
|
||||
- This policy cannot be burned.
|
||||
- This policy cannot be burned.
|
||||
|
||||
@since 0.1.0
|
||||
-}
|
||||
proposalPolicy ::
|
||||
-- | The assetclass of GST, see 'Agora.Governor.Scripts.governorPolicy'.
|
||||
|
|
@ -119,29 +121,31 @@ proposalPolicy (AssetClass (govCs, govTn)) =
|
|||
|
||||
{- | The validator for Proposals.
|
||||
|
||||
The documentation for various of the redeemers lives at 'Agora.Proposal.ProposalRedeemer'.
|
||||
The documentation for various of the redeemers lives at 'Agora.Proposal.ProposalRedeemer'.
|
||||
|
||||
== What this validator does
|
||||
== What this validator does
|
||||
|
||||
=== Voting/unlocking
|
||||
=== Voting/unlocking
|
||||
|
||||
When voting and unlocking, the proposal must witness a state transition
|
||||
occuring in the relevant Stake. This transition must place a lock on
|
||||
the stake that is tagged with the right 'Agora.Proposal.ResultTag', and 'Agora.Proposal.ProposalId'.
|
||||
When voting and unlocking, the proposal must witness a state transition
|
||||
occuring in the relevant Stake. This transition must place a lock on
|
||||
the stake that is tagged with the right 'Agora.Proposal.ResultTag', and 'Agora.Proposal.ProposalId'.
|
||||
|
||||
=== Periods
|
||||
=== Periods
|
||||
|
||||
Most redeemers are time-sensitive.
|
||||
Most redeemers are time-sensitive.
|
||||
|
||||
A list of all time-sensitive redeemers and their requirements:
|
||||
A list of all time-sensitive redeemers and their requirements:
|
||||
|
||||
- 'Agora.Proposal.Vote' can only be used when both the status is in 'Agora.Proposal.VotingReady',
|
||||
and 'Agora.Proposal.Time.isVotingPeriod' is true.
|
||||
- 'Agora.Proposal.Cosign' can only be used when both the status is in 'Agora.Proposal.Draft',
|
||||
and 'Agora.Proposal.Time.isDraftPeriod' is true.
|
||||
- 'Agora.Proposal.AdvanceProposal' can only be used when the status can be advanced
|
||||
(see 'Agora.Proposal.AdvanceProposal' docs).
|
||||
- 'Agora.Proposal.Unlock' is always valid.
|
||||
- 'Agora.Proposal.Vote' can only be used when both the status is in 'Agora.Proposal.VotingReady',
|
||||
and 'Agora.Proposal.Time.isVotingPeriod' is true.
|
||||
- 'Agora.Proposal.Cosign' can only be used when both the status is in 'Agora.Proposal.Draft',
|
||||
and 'Agora.Proposal.Time.isDraftPeriod' is true.
|
||||
- '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 =
|
||||
|
|
|
|||
|
|
@ -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,61 +83,120 @@ 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
|
||||
)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{- | == Establishing timing in Proposal interactions.
|
||||
|
||||
In Plutus, it's impossible to determine time exactly. It's also impossible
|
||||
to get a single point in time, yet often we need to check
|
||||
various constraints on time.
|
||||
In Plutus, it's impossible to determine time exactly. It's also impossible
|
||||
to get a single point in time, yet often we need to check
|
||||
various constraints on time.
|
||||
|
||||
For the purposes of proposals, there's a single most important feature:
|
||||
The ability to determine if we can perform an action. In order to correctly
|
||||
determine if we are able to perform certain actions, we need to know what
|
||||
time it roughly is, compared to when the proposal was created.
|
||||
For the purposes of proposals, there's a single most important feature:
|
||||
The ability to determine if we can perform an action. In order to correctly
|
||||
determine if we are able to perform certain actions, we need to know what
|
||||
time it roughly is, compared to when the proposal was created.
|
||||
|
||||
'PProposalTime' represents "the time according to the proposal".
|
||||
Its representation is opaque, and doesn't matter.
|
||||
'PProposalTime' represents "the time according to the proposal".
|
||||
Its representation is opaque, and doesn't matter.
|
||||
|
||||
Various functions work simply on 'PProposalTime' and 'ProposalTimingConfig'.
|
||||
In particular, 'currentProposalTime' is useful for extracting the time
|
||||
from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field
|
||||
of 'PlutusLedgerApi.V1.TxInfo'.
|
||||
Various functions work simply on 'PProposalTime' and 'ProposalTimingConfig'.
|
||||
In particular, 'currentProposalTime' is useful for extracting the time
|
||||
from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field
|
||||
of 'PlutusLedgerApi.V1.TxInfo'.
|
||||
|
||||
We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
|
||||
We avoid 'PPOSIXTimeRange' where we can in order to save on operations.
|
||||
|
||||
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.
|
||||
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 $
|
||||
|
|
@ -201,8 +299,10 @@ createProposalStartingTime = phoistAcyclic $
|
|||
|
||||
{- | Get the current proposal time, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
|
||||
|
||||
If it's impossible to get a fully-bounded time, (e.g. either end of the 'PPOSIXTimeRange' is
|
||||
an infinity) then we error out.
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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 ("", ""))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
given the 'lockedBy' field of a stake and the target proposal.
|
||||
|
||||
@since 0.1.0
|
||||
-}
|
||||
pgetStakeUsage ::
|
||||
Term
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
@ -153,53 +155,55 @@ stakePolicy gtClassRef =
|
|||
|
||||
{- | Validator intended for Stake UTXOs to be locked by.
|
||||
|
||||
== What this Validator does:
|
||||
== What this Validator does:
|
||||
|
||||
=== 'DepositWithdraw'
|
||||
=== 'DepositWithdraw'
|
||||
|
||||
Deposit or withdraw some GT to the stake.
|
||||
Deposit or withdraw some GT to the stake.
|
||||
|
||||
- Tx must be signed by the owner.
|
||||
- The 'stakedAmount' field must be updated.
|
||||
- The stake must not be locked.
|
||||
- The new UTXO must have the previous value plus the difference
|
||||
as stated by the redeemer.
|
||||
- Tx must be signed by the owner.
|
||||
- The 'stakedAmount' field must be updated.
|
||||
- The stake must not be locked.
|
||||
- The new UTXO must have the previous value plus the difference
|
||||
as stated by the redeemer.
|
||||
|
||||
=== 'PermitVote'
|
||||
=== 'PermitVote'
|
||||
|
||||
Allow a 'ProposalLock' to be put on the stake in order to vote
|
||||
on a proposal.
|
||||
Allow a 'ProposalLock' to be put on the stake in order to vote
|
||||
on a proposal.
|
||||
|
||||
- A proposal token must be spent alongside the stake.
|
||||
- A proposal token must be spent alongside the stake.
|
||||
|
||||
* Its total votes must be correctly updated to include this stake's
|
||||
contribution.
|
||||
* Its total votes must be correctly updated to include this stake's
|
||||
contribution.
|
||||
|
||||
- Tx must be signed by the owner.
|
||||
- Tx must be signed by the owner.
|
||||
|
||||
=== 'RetractVotes'
|
||||
=== 'RetractVotes'
|
||||
|
||||
Remove a 'ProposalLock' set when voting on a proposal.
|
||||
Remove a 'ProposalLock' set when voting on a proposal.
|
||||
|
||||
- A proposal token must be spent alongside the stake.
|
||||
- Tx must be signed by the owner.
|
||||
- A proposal token must be spent alongside the stake.
|
||||
- Tx must be signed by the owner.
|
||||
|
||||
=== 'Destroy'
|
||||
=== 'Destroy'
|
||||
|
||||
Destroy the stake in order to reclaim the min ADA.
|
||||
Destroy the stake in order to reclaim the min ADA.
|
||||
|
||||
- The stake must not be locked.
|
||||
- Tx must be signed by the owner.
|
||||
- The stake must not be locked.
|
||||
- Tx must be signed by the owner.
|
||||
|
||||
=== 'WitnessStake'
|
||||
=== 'WitnessStake'
|
||||
|
||||
Allow this Stake to be included in a transaction without making
|
||||
any changes to it. In the future,
|
||||
this could use [CIP-31](https://cips.cardano.org/cips/cip31/) instead.
|
||||
Allow this Stake to be included in a transaction without making
|
||||
any changes to it. In the future,
|
||||
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.
|
||||
- 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 =
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
64
bench.csv
|
|
@ -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
|
||||
|
|
|
|||
|
Loading…
Add table
Add a link
Reference in a new issue