From 77401ad0a759f64ba65845bc3f1c447448b28054 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 22 Jun 2022 18:15:20 +0200 Subject: [PATCH] add `@since` tags to everything --- CHANGELOG.md | 6 +- agora.cabal | 2 +- agora/Agora/AuthorityToken.hs | 36 ++- agora/Agora/Effect.hs | 4 +- agora/Agora/Effect/GovernorMutation.hs | 125 ++++--- agora/Agora/Effect/NoOp.hs | 21 +- agora/Agora/Effect/TreasuryWithdrawal.hs | 72 +++-- agora/Agora/Governor.hs | 113 +++++-- agora/Agora/Governor/Scripts.hs | 174 ++++++---- agora/Agora/MultiSig.hs | 65 +++- agora/Agora/Proposal.hs | 396 ++++++++++++++++++----- agora/Agora/Proposal/Scripts.hs | 54 ++-- agora/Agora/Proposal/Time.hs | 187 ++++++++--- agora/Agora/SafeMoney.hs | 38 ++- agora/Agora/ScriptInfo.hs | 52 ++- agora/Agora/Stake.hs | 131 ++++++-- agora/Agora/Stake/Scripts.hs | 64 ++-- agora/Agora/Treasury.hs | 43 ++- agora/Agora/Utils.hs | 75 +++-- 19 files changed, 1213 insertions(+), 445 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3c2ba57..787db68 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/agora.cabal b/agora.cabal index 143f880..af4a5fb 100644 --- a/agora.cabal +++ b/agora.cabal @@ -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 license: Apache-2.0 diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 03e03cf..af97e96 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -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' -> diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index 1c35079..3a56ed0 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -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). diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index caab4b3..6939031 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -18,39 +18,6 @@ module Agora.Effect.GovernorMutation ( mutateGovernorValidator, ) where --------------------------------------------------------------------------------- - -import Control.Applicative (Const) -import GHC.Generics qualified as GHC -import Generics.SOP (Generic, I (I)) - --------------------------------------------------------------------------------- - -import Plutarch.Api.V1 ( - PTxOutRef, - PValidator, - PValue, - ) -import Plutarch.Api.V1.ScriptContext (ptryFindDatum) -import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pvalueOf) -import Plutarch.DataRepr ( - DerivePConstantViaData (..), - PDataFields, - PIsDataReprInstances (PIsDataReprInstances), - ) -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, @@ -67,10 +34,35 @@ import Agora.Utils ( mustBePDJust, mustBePJust, ) +import Control.Applicative (Const) +import GHC.Generics qualified as GHC +import Generics.SOP (Generic, I (I)) +import Plutarch.Api.V1 ( + PTxOutRef, + PValidator, + PValue, + ) +import Plutarch.Api.V1.ScriptContext (ptryFindDatum) +import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pvalueOf) +import Plutarch.DataRepr ( + DerivePConstantViaData (..), + PDataFields, + PIsDataReprInstances (PIsDataReprInstances), + ) +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 -------------------------------------------------------------------------------- --- | 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 +76,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,17 +90,39 @@ 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. + +-- | @since 0.1.0 instance PTryFrom PData (PAsData PMutateGovernorDatum) where type PTryFromExcess PData (PAsData PMutateGovernorDatum) = Const () ptryFrom' d k = @@ -115,26 +132,28 @@ instance PTryFrom PData (PAsData PMutateGovernorDatum) where {- | 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) $ diff --git a/agora/Agora/Effect/NoOp.hs b/agora/Agora/Effect/NoOp.hs index f2437b6..0ff1dc6 100644 --- a/agora/Agora/Effect/NoOp.hs +++ b/agora/Agora/Effect/NoOp.hs @@ -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 ()) diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs index 9104e33..76ccff1 100644 --- a/agora/Agora/Effect/TreasuryWithdrawal.hs +++ b/agora/Agora/Effect/TreasuryWithdrawal.hs @@ -13,12 +13,11 @@ module Agora.Effect.TreasuryWithdrawal ( treasuryWithdrawalValidator, ) where +import Agora.Effect (makeEffect) +import Agora.Utils (isPubKey) import Control.Applicative (Const) 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 ( @@ -38,6 +35,7 @@ import Plutarch.DataRepr ( PIsDataReprInstances (..), ) import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC) +import Plutarch.Internal (punsafeCoerce) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.TryFrom (PTryFrom (..)) import PlutusLedgerApi.V1.Credential (Credential) @@ -46,9 +44,11 @@ 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 +56,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,20 +87,37 @@ 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) +-- | @since 0.1.0 instance PTryFrom PData (PAsData PTreasuryWithdrawalDatum) where type PTryFromExcess PData (PAsData PTreasuryWithdrawalDatum) = Const () ptryFrom' opq cont = @@ -101,12 +132,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 $ diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 3fd2a5a..cb8ed34 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -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,10 @@ import Agora.Proposal.Time ( ProposalTimingConfig, ) import Agora.SafeMoney (GTTag) - --------------------------------------------------------------------------------- - +import Control.Applicative (Const) +import Data.Tagged (Tagged (..)) +import GHC.Generics qualified as GHC +import Generics.SOP (Generic, I (I)) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -59,16 +51,16 @@ 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 +74,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 +84,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 +97,7 @@ data GovernorRedeemer MutateGovernor deriving stock (Show, GHC.Generic) +-- | @since 0.1.0 PlutusTx.makeIsDataIndexed ''GovernorRedeemer [ ('CreateProposal, 0) @@ -109,7 +105,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 +122,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 +138,104 @@ 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 + +-- | @since 0.1.0 instance PTryFrom PData (PAsData PGovernorDatum) where type PTryFromExcess PData (PAsData PGovernorDatum) = Const () 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 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index b832c86..b2639a8 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -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 diff --git a/agora/Agora/MultiSig.hs b/agora/Agora/MultiSig.hs index 5bb091b..a454ad2 100644 --- a/agora/Agora/MultiSig.hs +++ b/agora/Agora/MultiSig.hs @@ -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 $ diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 2705291..7a3f42d 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -36,23 +36,14 @@ module Agora.Proposal ( pretractVotes, ) where --------------------------------------------------------------------------------- - +import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig) +import Agora.SafeMoney (GTTag) +import Agora.Utils (mustBePJust) import Control.Applicative (Const) import Control.Arrow (first) 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, @@ -73,12 +64,10 @@ import Plutarch.Lift ( 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 +77,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 +134,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 +169,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 +199,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 +276,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 +328,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,23 +346,49 @@ 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 @@ -287,6 +396,8 @@ deriving via -- FIXME: This instance and the one below, for 'PProposalId', should be derived. -- Soon this will be possible through 'DerivePNewtype'. + +-- | @since 0.1.0 instance PTryFrom PData (PAsData PResultTag) where type PTryFromExcess PData (PAsData PResultTag) = PTryFromExcess PData (PAsData PInteger) ptryFrom' d k = @@ -300,10 +411,24 @@ instance PTryFrom PData (PAsData PResultTag) where -- Since 'PResultTag' is a simple newtype, their shape is the same. k . first punsafeCoerce --- | Plutarch-level version of 'PProposalId'. -newtype PProposalId (s :: S) = PProposalId (Term s PInteger) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PProposalId PInteger) +{- | Plutarch-level version of 'PProposalId'. + @since 0.1.0 +-} +newtype PProposalId (s :: S) = PProposalId (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 PProposalId PInteger) + +-- | @since 0.1.0 instance PTryFrom PData (PAsData PProposalId) where type PTryFromExcess PData (PAsData PProposalId) = PTryFromExcess PData (PAsData PInteger) ptryFrom' d k = @@ -317,13 +442,19 @@ instance PTryFrom PData (PAsData PProposalId) where -- Since 'PProposalId' is a simple newtype, their shape is the same. k . first punsafeCoerce +-- | @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 +462,38 @@ 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 (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 +505,52 @@ 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) +-- | @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'. +{- | 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. +{- | 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 +568,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 +590,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,36 +610,76 @@ 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. + +-- | @since 0.1.0 instance PTryFrom PData (PAsData PProposalDatum) where type PTryFromExcess PData (PAsData PProposalDatum) = Const () ptryFrom' d k = k (punsafeCoerce d, ()) +-- | @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. + +-- | @since 0.1.0 instance PTryFrom PData (PAsData PProposalRedeemer) where type PTryFromExcess PData (PAsData PProposalRedeemer) = Const () ptryFrom' d k = @@ -460,7 +691,10 @@ instance PTryFrom PData (PAsData PProposalRedeemer) where -- 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 +702,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 +729,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 +778,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 +807,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 diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index c560e1b..6d92604 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -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 = diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 8e62f93..25292b9 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -58,7 +58,10 @@ 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 +70,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 +84,115 @@ 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 + +-- | @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 +205,33 @@ 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 instance PUnsafeLiftDecl PProposalTimingConfig where type PLifted PProposalTimingConfig = ProposalTimingConfig + +-- | @since 0.1.0 deriving via (DerivePConstantViaData ProposalTimingConfig PProposalTimingConfig) instance @@ -163,9 +240,22 @@ 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 instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth + +-- | @since 0.1.0 deriving via (DerivePConstantViaNewtype MaxTimeRangeWidth PMaxTimeRangeWidth PPOSIXTime) instance @@ -174,12 +264,16 @@ deriving via -------------------------------------------------------------------------------- -- FIXME: Orphan instance, move this to plutarch-extra. + +-- | @since 0.1.0 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 +295,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 +328,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 +350,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 +367,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 +385,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 +403,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 diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index 35c1335..77552ba 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -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 ("", "")) diff --git a/agora/Agora/ScriptInfo.hs b/agora/Agora/ScriptInfo.hs index c170878..09c7ac6 100644 --- a/agora/Agora/ScriptInfo.hs +++ b/agora/Agora/ScriptInfo.hs @@ -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 diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 61b6b68..e0f0636 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -72,13 +72,19 @@ 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 +111,8 @@ data Stake = Stake │ Stake Policy │◄─┘ └►│ Proposal Policy │ └──────────────┘ └─────────────────┘ @ + + @since 0.1.0 -} data ProposalLock = ProposalLock { vote :: ResultTag @@ -114,11 +122,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 +167,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 +190,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,11 +205,28 @@ 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 @@ -198,7 +237,10 @@ instance PTryFrom PData (PAsData PStakeDatum) where instance PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum deriving via (DerivePConstantViaData StakeDatum PStakeDatum) instance (PConstantDecl StakeDatum) --- | Plutarch-level redeemer for Stake scripts. +{- | 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 +249,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 @@ -222,7 +277,10 @@ deriving via instance PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (PConstantDecl StakeRedeemer) --- | Plutarch-level version of 'ProposalLock'. +{- | Plutarch-level version of 'ProposalLock'. + + @since 0.1.0 +-} newtype PProposalLock (s :: S) = PProposalLock { getProposalLock :: Term @@ -250,7 +308,10 @@ deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (PCons -------------------------------------------------------------------------------- --- | 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 +319,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 +345,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 +356,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 +388,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 diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index a1c8c3f..be546f8 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -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 = diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index a63df8f..85f4869 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -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. diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index b772445..02ef1eb 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -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