fix documentation
This commit is contained in:
parent
77414b86c4
commit
b840380a91
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 (
|
||||
ParameterBundle (..),
|
||||
VoteParameters (..),
|
||||
|
|
|
|||
|
|
@ -183,6 +183,7 @@ instance DerivePlutusType PStakeInputsContext where
|
|||
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'.
|
||||
Note that only one proposal per transaction is supported.
|
||||
|
||||
=== Periods
|
||||
|
||||
|
|
|
|||
|
|
@ -458,10 +458,13 @@ data PSignedBy (s :: S)
|
|||
instance DerivePlutusType PSignedBy where
|
||||
type DPTStrat _ = PlutusTypeScott
|
||||
|
||||
-- | @since 1.0.0
|
||||
{- | The signature context.
|
||||
|
||||
@since 1.0.0
|
||||
-}
|
||||
data PSigContext (s :: S) = PSigContext
|
||||
{ owner :: Term s PCredential
|
||||
, delegate :: Term s (PMaybeData (PAsData PCredential))
|
||||
, delegatee :: Term s (PMaybeData (PAsData PCredential))
|
||||
, signedBy :: Term s PSignedBy
|
||||
}
|
||||
deriving stock
|
||||
|
|
@ -562,7 +565,8 @@ instance DerivePlutusType PStakeRedeemerHandlerContext where
|
|||
-}
|
||||
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
|
||||
-}
|
||||
|
|
@ -570,6 +574,7 @@ newtype PStakeRedeemerHandlerTerm
|
|||
= PStakeRedeemerHandlerTerm
|
||||
(ClosedTerm PStakeRedeemerHandler)
|
||||
|
||||
-- | @since 1.0.0
|
||||
runStakeRedeemerHandler ::
|
||||
PStakeRedeemerHandlerTerm ->
|
||||
ClosedTerm PStakeRedeemerHandler
|
||||
|
|
|
|||
|
|
@ -58,6 +58,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
|
|||
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
||||
import Prelude hiding (Num ((+)))
|
||||
|
||||
-- | A wrapper which ensures that no proposal is presented in the transaction.
|
||||
pwithoutProposal ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
|
|
@ -73,6 +74,9 @@ pwithoutProposal = phoistAcyclic $
|
|||
(f # ctx)
|
||||
(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 ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
|
|
@ -88,6 +92,7 @@ pbatchUpdateInputs = phoistAcyclic $
|
|||
# ctxF.stakeOutputDatums
|
||||
# ctxF.stakeInputDatums
|
||||
|
||||
-- | Extract the 'PSigContext.signedBy' field from 'PStakeRedeemerHandlerContext'.
|
||||
pgetSignedBy ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
|
|
@ -99,15 +104,16 @@ pgetSignedBy = phoistAcyclic $
|
|||
sctxF <- pmatchC ctxF.sigContext
|
||||
pure sctxF.signedBy
|
||||
|
||||
-- | Return true if the tx is authorized by either the owner or the delegatee.
|
||||
pisSignedBy ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
(PBool :--> PBool :--> PStakeRedeemerHandlerContext :--> PBool)
|
||||
(PBool :--> PStakeRedeemerHandlerContext :--> PBool)
|
||||
pisSignedBy = phoistAcyclic $
|
||||
plam $ \byOwner byDelegate ctx ->
|
||||
plam $ \byDelegate ctx ->
|
||||
pmatch (pgetSignedBy # ctx) $ \case
|
||||
PSignedByOwner -> byOwner
|
||||
PSignedByOwner -> pconstant True
|
||||
PSignedByDelegate -> byDelegate
|
||||
PUnknownSig -> pconstant False
|
||||
|
||||
|
|
@ -154,7 +160,7 @@ pvoteHelper = phoistAcyclic $
|
|||
ctxF <- pmatchC ctx
|
||||
|
||||
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
|
||||
-- that this is not abused.
|
||||
|
|
@ -164,6 +170,7 @@ pvoteHelper = phoistAcyclic $
|
|||
|
||||
pure $ pconstant ()
|
||||
|
||||
-- | Add new lock the the existing list of locked.
|
||||
paddNewLock ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
|
|
@ -172,7 +179,10 @@ paddNewLock ::
|
|||
:--> 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'.
|
||||
|
||||
|
|
@ -201,11 +211,15 @@ ppermitVote = pvoteHelper #$ phoistAcyclic $
|
|||
in paddNewLock # newLock
|
||||
_ -> 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 ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
( PProposalId :--> PBool
|
||||
( PProposalId
|
||||
:--> PBool
|
||||
:--> PBuiltinList (PAsData PProposalLock)
|
||||
:--> PBuiltinList (PAsData PProposalLock)
|
||||
)
|
||||
|
|
@ -248,7 +262,7 @@ pdelegateHelper = phoistAcyclic $
|
|||
sigCtxF <- pmatchC ctxF.sigContext
|
||||
|
||||
pguardC "Owner signs this transaction" $
|
||||
pisSignedBy # pconstant True # pconstant False # ctx
|
||||
pisSignedBy # pconstant False # ctx
|
||||
|
||||
let newDelegate = f # ctxF.redeemerContext
|
||||
|
||||
|
|
@ -307,7 +321,7 @@ pdestroy = phoistAcyclic $
|
|||
ctxF <- pmatchC ctx
|
||||
|
||||
pguardC "Owner signs this transaction" $
|
||||
pisSignedBy # pconstant True # pconstant False # ctx
|
||||
pisSignedBy # pconstant False # ctx
|
||||
|
||||
pguardC "Stake unlocked" $
|
||||
pnot #$ pany # pstakeLocked # ctxF.stakeInputDatums
|
||||
|
|
@ -324,7 +338,7 @@ pdepositWithdraw = phoistAcyclic $
|
|||
ctxF <- pmatchC ctx
|
||||
|
||||
pguardC "Owner signs this transaction" $
|
||||
pisSignedBy # pconstant True # pconstant False # ctx
|
||||
pisSignedBy # pconstant False # ctx
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -74,7 +74,6 @@ import Plutarch.Api.V2 (
|
|||
AmountGuarantees,
|
||||
PMintingPolicy,
|
||||
PScriptPurpose (PMinting, PSpending),
|
||||
PTxInInfo,
|
||||
PTxInfo,
|
||||
PTxOut,
|
||||
PValidator,
|
||||
|
|
@ -289,6 +288,7 @@ mkStakeValidator
|
|||
|
||||
--------------------------------------------------------------------------
|
||||
|
||||
-- Returns stake datum if the given UTxO is a stake UTxO.
|
||||
getStakeDatum :: Term _ (PTxOut :--> PMaybe PStakeDatum) <-
|
||||
pletC $
|
||||
plam $ \txOut -> unTermCont $ do
|
||||
|
|
@ -314,6 +314,8 @@ mkStakeValidator
|
|||
|
||||
--------------------------------------------------------------------------
|
||||
|
||||
-- Find all stake inputs.
|
||||
|
||||
stakeInputDatums <-
|
||||
pletC $
|
||||
pmapMaybe
|
||||
|
|
@ -322,6 +324,8 @@ mkStakeValidator
|
|||
|
||||
--------------------------------------------------------------------------
|
||||
|
||||
-- Assemble the signature context.
|
||||
|
||||
firstStakeInputDatumF <-
|
||||
pletFieldsC @'["owner", "delegatedTo"] $
|
||||
phead # stakeInputDatums
|
||||
|
|
@ -372,8 +376,14 @@ mkStakeValidator
|
|||
|
||||
--------------------------------------------------------------------------
|
||||
|
||||
-- Find all stake outputs.
|
||||
|
||||
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 <-
|
||||
pletC $
|
||||
pmapMaybe
|
||||
|
|
@ -381,6 +391,7 @@ mkStakeValidator
|
|||
( \output ->
|
||||
let validateGT = plam $ \stakeDatum ->
|
||||
let expected = pfield @"stakedAmount" # stakeDatum
|
||||
|
||||
actual =
|
||||
pvalueDiscrete
|
||||
# gtAssetClass
|
||||
|
|
@ -459,7 +470,6 @@ mkStakeValidator
|
|||
)
|
||||
# txInfoF.redeemers
|
||||
|
||||
getContext :: Term _ (PTxInInfo :--> PMaybe PProposalContext)
|
||||
getContext = plam $
|
||||
flip pletAll $ \inInfoF ->
|
||||
pfmap
|
||||
|
|
@ -475,7 +485,8 @@ mkStakeValidator
|
|||
|
||||
contexts =
|
||||
pmapMaybe @PList # getContext # pfromData txInfoF.inputs
|
||||
in precList
|
||||
in -- Can only handle one proposal at a time.
|
||||
precList
|
||||
( \_ h t ->
|
||||
pif
|
||||
(pnull # t)
|
||||
|
|
@ -519,7 +530,7 @@ mkStakeValidator
|
|||
|
||||
-- Call the redeemer handler.
|
||||
|
||||
stakeRedeemer :: Term _ PStakeRedeemer <- fst <$> ptryFromC redeemer
|
||||
stakeRedeemer <- fst <$> ptryFromC redeemer
|
||||
|
||||
pure $
|
||||
popaque $
|
||||
|
|
@ -546,6 +557,7 @@ mkStakeValidator
|
|||
|
||||
Deposit or withdraw some GT to the stake.
|
||||
|
||||
- Only one stake per tx is supported.
|
||||
- Tx must be signed by the owner.
|
||||
- The 'stakedAmount' field must be updated.
|
||||
- The stake must not be locked.
|
||||
|
|
@ -557,9 +569,9 @@ mkStakeValidator
|
|||
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 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.
|
||||
|
||||
- Tx must be signed by the owner.
|
||||
|
|
@ -568,14 +580,14 @@ mkStakeValidator
|
|||
|
||||
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.
|
||||
|
||||
=== '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.
|
||||
|
||||
@since 0.1.0
|
||||
|
|
|
|||
|
|
@ -237,7 +237,11 @@ pisSingleton =
|
|||
(\_ _ t -> pnull # t)
|
||||
(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 ::
|
||||
forall (a :: PType) (list :: PType -> PType) (s :: S).
|
||||
(PIsListLike list a) =>
|
||||
|
|
@ -253,7 +257,11 @@ pfromSingleton =
|
|||
)
|
||||
(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 ::
|
||||
forall
|
||||
(listO :: PType -> PType)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue