fix documentation
This commit is contained in:
parent
484cd5dce1
commit
224a49abb3
6 changed files with 69 additions and 23 deletions
|
|
@ -1,3 +1,9 @@
|
||||||
|
{- |
|
||||||
|
Module : Sample.Proposal.Vote
|
||||||
|
Maintainer : connor@mlabs.city
|
||||||
|
Description: Generate sample data for testing the functionalities of voting on proposals.
|
||||||
|
Sample and utilities for testing the functionalities of voting on proposals.
|
||||||
|
-}
|
||||||
module Sample.Proposal.Vote (
|
module Sample.Proposal.Vote (
|
||||||
ParameterBundle (..),
|
ParameterBundle (..),
|
||||||
VoteParameters (..),
|
VoteParameters (..),
|
||||||
|
|
|
||||||
|
|
@ -183,6 +183,7 @@ instance DerivePlutusType PStakeInputsContext where
|
||||||
When voting and unlocking, the proposal must witness a state transition
|
When voting and unlocking, the proposal must witness a state transition
|
||||||
occuring in the relevant Stake. This transition must place a lock on
|
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'.
|
the stake that is tagged with the right 'Agora.Proposal.ResultTag', and 'Agora.Proposal.ProposalId'.
|
||||||
|
Note that only one proposal per transaction is supported.
|
||||||
|
|
||||||
=== Periods
|
=== Periods
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -458,10 +458,13 @@ data PSignedBy (s :: S)
|
||||||
instance DerivePlutusType PSignedBy where
|
instance DerivePlutusType PSignedBy where
|
||||||
type DPTStrat _ = PlutusTypeScott
|
type DPTStrat _ = PlutusTypeScott
|
||||||
|
|
||||||
-- | @since 1.0.0
|
{- | The signature context.
|
||||||
|
|
||||||
|
@since 1.0.0
|
||||||
|
-}
|
||||||
data PSigContext (s :: S) = PSigContext
|
data PSigContext (s :: S) = PSigContext
|
||||||
{ owner :: Term s PCredential
|
{ owner :: Term s PCredential
|
||||||
, delegate :: Term s (PMaybeData (PAsData PCredential))
|
, delegatee :: Term s (PMaybeData (PAsData PCredential))
|
||||||
, signedBy :: Term s PSignedBy
|
, signedBy :: Term s PSignedBy
|
||||||
}
|
}
|
||||||
deriving stock
|
deriving stock
|
||||||
|
|
@ -562,7 +565,8 @@ instance DerivePlutusType PStakeRedeemerHandlerContext where
|
||||||
-}
|
-}
|
||||||
type PStakeRedeemerHandler = PStakeRedeemerHandlerContext :--> PUnit
|
type PStakeRedeemerHandler = PStakeRedeemerHandlerContext :--> PUnit
|
||||||
|
|
||||||
{- | Newtype wrapper around @'ClosedTerm' 'PStakeRedeemerHandler'@ to allow type inference to work.
|
{- | Newtype wrapper around @'ClosedTerm' 'PStakeRedeemerHandler'@ to allow type
|
||||||
|
inference to work.
|
||||||
|
|
||||||
@since 1.0.0
|
@since 1.0.0
|
||||||
-}
|
-}
|
||||||
|
|
@ -570,6 +574,7 @@ newtype PStakeRedeemerHandlerTerm
|
||||||
= PStakeRedeemerHandlerTerm
|
= PStakeRedeemerHandlerTerm
|
||||||
(ClosedTerm PStakeRedeemerHandler)
|
(ClosedTerm PStakeRedeemerHandler)
|
||||||
|
|
||||||
|
-- | @since 1.0.0
|
||||||
runStakeRedeemerHandler ::
|
runStakeRedeemerHandler ::
|
||||||
PStakeRedeemerHandlerTerm ->
|
PStakeRedeemerHandlerTerm ->
|
||||||
ClosedTerm PStakeRedeemerHandler
|
ClosedTerm PStakeRedeemerHandler
|
||||||
|
|
|
||||||
|
|
@ -58,6 +58,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
|
||||||
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
||||||
import Prelude hiding (Num ((+)))
|
import Prelude hiding (Num ((+)))
|
||||||
|
|
||||||
|
-- | A wrapper which ensures that no proposal is presented in the transaction.
|
||||||
pwithoutProposal ::
|
pwithoutProposal ::
|
||||||
forall (s :: S).
|
forall (s :: S).
|
||||||
Term
|
Term
|
||||||
|
|
@ -73,6 +74,9 @@ pwithoutProposal = phoistAcyclic $
|
||||||
(f # ctx)
|
(f # ctx)
|
||||||
(ptraceError "No proposal is allowed")
|
(ptraceError "No proposal is allowed")
|
||||||
|
|
||||||
|
{- | Validate stake outputs given a function that converts an input stake datum
|
||||||
|
to an ouput stake datum. / O(n^2) /.
|
||||||
|
-}
|
||||||
pbatchUpdateInputs ::
|
pbatchUpdateInputs ::
|
||||||
forall (s :: S).
|
forall (s :: S).
|
||||||
Term
|
Term
|
||||||
|
|
@ -88,6 +92,7 @@ pbatchUpdateInputs = phoistAcyclic $
|
||||||
# ctxF.stakeOutputDatums
|
# ctxF.stakeOutputDatums
|
||||||
# ctxF.stakeInputDatums
|
# ctxF.stakeInputDatums
|
||||||
|
|
||||||
|
-- | Extract the 'PSigContext.signedBy' field from 'PStakeRedeemerHandlerContext'.
|
||||||
pgetSignedBy ::
|
pgetSignedBy ::
|
||||||
forall (s :: S).
|
forall (s :: S).
|
||||||
Term
|
Term
|
||||||
|
|
@ -99,15 +104,16 @@ pgetSignedBy = phoistAcyclic $
|
||||||
sctxF <- pmatchC ctxF.sigContext
|
sctxF <- pmatchC ctxF.sigContext
|
||||||
pure sctxF.signedBy
|
pure sctxF.signedBy
|
||||||
|
|
||||||
|
-- | Return true if the tx is authorized by either the owner or the delegatee.
|
||||||
pisSignedBy ::
|
pisSignedBy ::
|
||||||
forall (s :: S).
|
forall (s :: S).
|
||||||
Term
|
Term
|
||||||
s
|
s
|
||||||
(PBool :--> PBool :--> PStakeRedeemerHandlerContext :--> PBool)
|
(PBool :--> PStakeRedeemerHandlerContext :--> PBool)
|
||||||
pisSignedBy = phoistAcyclic $
|
pisSignedBy = phoistAcyclic $
|
||||||
plam $ \byOwner byDelegate ctx ->
|
plam $ \byDelegate ctx ->
|
||||||
pmatch (pgetSignedBy # ctx) $ \case
|
pmatch (pgetSignedBy # ctx) $ \case
|
||||||
PSignedByOwner -> byOwner
|
PSignedByOwner -> pconstant True
|
||||||
PSignedByDelegate -> byDelegate
|
PSignedByDelegate -> byDelegate
|
||||||
PUnknownSig -> pconstant False
|
PUnknownSig -> pconstant False
|
||||||
|
|
||||||
|
|
@ -154,7 +160,7 @@ pvoteHelper = phoistAcyclic $
|
||||||
ctxF <- pmatchC ctx
|
ctxF <- pmatchC ctx
|
||||||
|
|
||||||
pguardC "Owner or delegate signs this transaction" $
|
pguardC "Owner or delegate signs this transaction" $
|
||||||
pisSignedBy # pconstant True # pconstant True # ctx
|
pisSignedBy # pconstant True # ctx
|
||||||
|
|
||||||
-- This puts trust into the Proposal. The Proposal must necessarily check
|
-- This puts trust into the Proposal. The Proposal must necessarily check
|
||||||
-- that this is not abused.
|
-- that this is not abused.
|
||||||
|
|
@ -164,6 +170,7 @@ pvoteHelper = phoistAcyclic $
|
||||||
|
|
||||||
pure $ pconstant ()
|
pure $ pconstant ()
|
||||||
|
|
||||||
|
-- | Add new lock the the existing list of locked.
|
||||||
paddNewLock ::
|
paddNewLock ::
|
||||||
forall (s :: S).
|
forall (s :: S).
|
||||||
Term
|
Term
|
||||||
|
|
@ -172,7 +179,10 @@ paddNewLock ::
|
||||||
:--> PBuiltinList (PAsData PProposalLock)
|
:--> PBuiltinList (PAsData PProposalLock)
|
||||||
:--> PBuiltinList (PAsData PProposalLock)
|
:--> PBuiltinList (PAsData PProposalLock)
|
||||||
)
|
)
|
||||||
paddNewLock = phoistAcyclic $ plam $ \newLock -> pcons # pdata newLock
|
paddNewLock = phoistAcyclic $
|
||||||
|
plam $
|
||||||
|
-- Prepend the lock.
|
||||||
|
\newLock -> pcons # pdata newLock
|
||||||
|
|
||||||
{- | Default implementation of 'Agora.Stake.PermitVote'.
|
{- | Default implementation of 'Agora.Stake.PermitVote'.
|
||||||
|
|
||||||
|
|
@ -201,11 +211,15 @@ ppermitVote = pvoteHelper #$ phoistAcyclic $
|
||||||
in paddNewLock # newLock
|
in paddNewLock # newLock
|
||||||
_ -> ptraceError "Expected proposal"
|
_ -> ptraceError "Expected proposal"
|
||||||
|
|
||||||
|
{- | Remove stake locks with the proposal id given the list of existing locks.
|
||||||
|
The first parameter controls whether to revmove creator locks or not.
|
||||||
|
-}
|
||||||
premoveLocks ::
|
premoveLocks ::
|
||||||
forall (s :: S).
|
forall (s :: S).
|
||||||
Term
|
Term
|
||||||
s
|
s
|
||||||
( PProposalId :--> PBool
|
( PProposalId
|
||||||
|
:--> PBool
|
||||||
:--> PBuiltinList (PAsData PProposalLock)
|
:--> PBuiltinList (PAsData PProposalLock)
|
||||||
:--> PBuiltinList (PAsData PProposalLock)
|
:--> PBuiltinList (PAsData PProposalLock)
|
||||||
)
|
)
|
||||||
|
|
@ -248,7 +262,7 @@ pdelegateHelper = phoistAcyclic $
|
||||||
sigCtxF <- pmatchC ctxF.sigContext
|
sigCtxF <- pmatchC ctxF.sigContext
|
||||||
|
|
||||||
pguardC "Owner signs this transaction" $
|
pguardC "Owner signs this transaction" $
|
||||||
pisSignedBy # pconstant True # pconstant False # ctx
|
pisSignedBy # pconstant False # ctx
|
||||||
|
|
||||||
let newDelegate = f # ctxF.redeemerContext
|
let newDelegate = f # ctxF.redeemerContext
|
||||||
|
|
||||||
|
|
@ -307,7 +321,7 @@ pdestroy = phoistAcyclic $
|
||||||
ctxF <- pmatchC ctx
|
ctxF <- pmatchC ctx
|
||||||
|
|
||||||
pguardC "Owner signs this transaction" $
|
pguardC "Owner signs this transaction" $
|
||||||
pisSignedBy # pconstant True # pconstant False # ctx
|
pisSignedBy # pconstant False # ctx
|
||||||
|
|
||||||
pguardC "Stake unlocked" $
|
pguardC "Stake unlocked" $
|
||||||
pnot #$ pany # pstakeLocked # ctxF.stakeInputDatums
|
pnot #$ pany # pstakeLocked # ctxF.stakeInputDatums
|
||||||
|
|
@ -324,7 +338,7 @@ pdepositWithdraw = phoistAcyclic $
|
||||||
ctxF <- pmatchC ctx
|
ctxF <- pmatchC ctx
|
||||||
|
|
||||||
pguardC "Owner signs this transaction" $
|
pguardC "Owner signs this transaction" $
|
||||||
pisSignedBy # pconstant True # pconstant False # ctx
|
pisSignedBy # pconstant False # ctx
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -74,7 +74,6 @@ import Plutarch.Api.V2 (
|
||||||
AmountGuarantees,
|
AmountGuarantees,
|
||||||
PMintingPolicy,
|
PMintingPolicy,
|
||||||
PScriptPurpose (PMinting, PSpending),
|
PScriptPurpose (PMinting, PSpending),
|
||||||
PTxInInfo,
|
|
||||||
PTxInfo,
|
PTxInfo,
|
||||||
PTxOut,
|
PTxOut,
|
||||||
PValidator,
|
PValidator,
|
||||||
|
|
@ -289,6 +288,7 @@ mkStakeValidator
|
||||||
|
|
||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- Returns stake datum if the given UTxO is a stake UTxO.
|
||||||
getStakeDatum :: Term _ (PTxOut :--> PMaybe PStakeDatum) <-
|
getStakeDatum :: Term _ (PTxOut :--> PMaybe PStakeDatum) <-
|
||||||
pletC $
|
pletC $
|
||||||
plam $ \txOut -> unTermCont $ do
|
plam $ \txOut -> unTermCont $ do
|
||||||
|
|
@ -314,6 +314,8 @@ mkStakeValidator
|
||||||
|
|
||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- Find all stake inputs.
|
||||||
|
|
||||||
stakeInputDatums <-
|
stakeInputDatums <-
|
||||||
pletC $
|
pletC $
|
||||||
pmapMaybe
|
pmapMaybe
|
||||||
|
|
@ -322,6 +324,8 @@ mkStakeValidator
|
||||||
|
|
||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- Assemble the signature context.
|
||||||
|
|
||||||
firstStakeInputDatumF <-
|
firstStakeInputDatumF <-
|
||||||
pletFieldsC @'["owner", "delegatedTo"] $
|
pletFieldsC @'["owner", "delegatedTo"] $
|
||||||
phead # stakeInputDatums
|
phead # stakeInputDatums
|
||||||
|
|
@ -372,8 +376,14 @@ mkStakeValidator
|
||||||
|
|
||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- Find all stake outputs.
|
||||||
|
|
||||||
let gtAssetClass = passetClass # pconstant gtSym # pconstant gtTn
|
let gtAssetClass = passetClass # pconstant gtSym # pconstant gtTn
|
||||||
|
|
||||||
|
-- First step of validating stake outputs. We make sure that every stake
|
||||||
|
-- output UTxO carries correct amount of GTs specified by its datum.
|
||||||
|
--
|
||||||
|
-- Note that non-GT assets are treated transparently.
|
||||||
stakeOutputDatums <-
|
stakeOutputDatums <-
|
||||||
pletC $
|
pletC $
|
||||||
pmapMaybe
|
pmapMaybe
|
||||||
|
|
@ -381,6 +391,7 @@ mkStakeValidator
|
||||||
( \output ->
|
( \output ->
|
||||||
let validateGT = plam $ \stakeDatum ->
|
let validateGT = plam $ \stakeDatum ->
|
||||||
let expected = pfield @"stakedAmount" # stakeDatum
|
let expected = pfield @"stakedAmount" # stakeDatum
|
||||||
|
|
||||||
actual =
|
actual =
|
||||||
pvalueDiscrete
|
pvalueDiscrete
|
||||||
# gtAssetClass
|
# gtAssetClass
|
||||||
|
|
@ -459,7 +470,6 @@ mkStakeValidator
|
||||||
)
|
)
|
||||||
# txInfoF.redeemers
|
# txInfoF.redeemers
|
||||||
|
|
||||||
getContext :: Term _ (PTxInInfo :--> PMaybe PProposalContext)
|
|
||||||
getContext = plam $
|
getContext = plam $
|
||||||
flip pletAll $ \inInfoF ->
|
flip pletAll $ \inInfoF ->
|
||||||
pfmap
|
pfmap
|
||||||
|
|
@ -475,7 +485,8 @@ mkStakeValidator
|
||||||
|
|
||||||
contexts =
|
contexts =
|
||||||
pmapMaybe @PList # getContext # pfromData txInfoF.inputs
|
pmapMaybe @PList # getContext # pfromData txInfoF.inputs
|
||||||
in precList
|
in -- Can only handle one proposal at a time.
|
||||||
|
precList
|
||||||
( \_ h t ->
|
( \_ h t ->
|
||||||
pif
|
pif
|
||||||
(pnull # t)
|
(pnull # t)
|
||||||
|
|
@ -519,7 +530,7 @@ mkStakeValidator
|
||||||
|
|
||||||
-- Call the redeemer handler.
|
-- Call the redeemer handler.
|
||||||
|
|
||||||
stakeRedeemer :: Term _ PStakeRedeemer <- fst <$> ptryFromC redeemer
|
stakeRedeemer <- fst <$> ptryFromC redeemer
|
||||||
|
|
||||||
pure $
|
pure $
|
||||||
popaque $
|
popaque $
|
||||||
|
|
@ -546,6 +557,7 @@ mkStakeValidator
|
||||||
|
|
||||||
Deposit or withdraw some GT to the stake.
|
Deposit or withdraw some GT to the stake.
|
||||||
|
|
||||||
|
- Only one stake per tx is supported.
|
||||||
- Tx must be signed by the owner.
|
- Tx must be signed by the owner.
|
||||||
- The 'stakedAmount' field must be updated.
|
- The 'stakedAmount' field must be updated.
|
||||||
- The stake must not be locked.
|
- The stake must not be locked.
|
||||||
|
|
@ -557,9 +569,9 @@ mkStakeValidator
|
||||||
Allow a 'ProposalLock' to be put on the stake in order to vote
|
Allow a 'ProposalLock' to be put on the stake in order to vote
|
||||||
on a proposal.
|
on a proposal.
|
||||||
|
|
||||||
- A proposal token must be spent alongside the stake.
|
- A proposal token must be spent alongside the staked.
|
||||||
|
|
||||||
* Its total votes must be correctly updated to include this stake's
|
* Its total votes must be correctly updated to include all stakes'
|
||||||
contribution.
|
contribution.
|
||||||
|
|
||||||
- Tx must be signed by the owner.
|
- Tx must be signed by the owner.
|
||||||
|
|
@ -568,14 +580,14 @@ mkStakeValidator
|
||||||
|
|
||||||
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.
|
- A proposal token must be spent or minted alongside the stakes.
|
||||||
- Tx must be signed by the owner.
|
- Tx must be signed by the owner.
|
||||||
|
|
||||||
=== 'Destroy'
|
=== 'Destroy'
|
||||||
|
|
||||||
Destroy the stake in order to reclaim the min ADA.
|
Destroy stakes in order to reclaim the GTs.
|
||||||
|
|
||||||
- The stake must not be locked.
|
- The stakes must not be locked.
|
||||||
- Tx must be signed by the owner.
|
- Tx must be signed by the owner.
|
||||||
|
|
||||||
@since 0.1.0
|
@since 0.1.0
|
||||||
|
|
|
||||||
|
|
@ -237,7 +237,11 @@ pisSingleton =
|
||||||
(\_ _ t -> pnull # t)
|
(\_ _ t -> pnull # t)
|
||||||
(const $ pconstant False)
|
(const $ pconstant False)
|
||||||
|
|
||||||
-- | @since 1.0.0
|
{- Throws an error if the given list contains zero or more than one elements.
|
||||||
|
Otherwise returns the only element.
|
||||||
|
|
||||||
|
@since 1.0.0
|
||||||
|
-}
|
||||||
pfromSingleton ::
|
pfromSingleton ::
|
||||||
forall (a :: PType) (list :: PType -> PType) (s :: S).
|
forall (a :: PType) (list :: PType -> PType) (s :: S).
|
||||||
(PIsListLike list a) =>
|
(PIsListLike list a) =>
|
||||||
|
|
@ -253,7 +257,11 @@ pfromSingleton =
|
||||||
)
|
)
|
||||||
(const $ ptraceError "Empty list")
|
(const $ ptraceError "Empty list")
|
||||||
|
|
||||||
-- | @since 1.0.0
|
{- | A version of 'pmap' which can throw out elements and change the list type
|
||||||
|
along the way.
|
||||||
|
|
||||||
|
@since 1.0.0
|
||||||
|
-}
|
||||||
pmapMaybe ::
|
pmapMaybe ::
|
||||||
forall
|
forall
|
||||||
(listO :: PType -> PType)
|
(listO :: PType -> PType)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue