Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

tag assetclasses and currency symbols

Browse source
This commit is contained in:
Hongrui Fang 2022-11-04 22:15:12 +08:00
parent e5fb851510
commit a0946a8dbc
14 changed files with 250 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

3
agora-specs/Spec/AuthorityToken.hs
View file

@ -10,6 +10,7 @@ Tests for Authority token functions
module Spec.AuthorityToken (specs) where module Spec.AuthorityToken (specs) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Data.Tagged (Tagged (Tagged))
import Plutarch.Extra.Compile (mustCompile) import Plutarch.Extra.Compile (mustCompile)
import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Unsafe (punsafeCoerce)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1 (
@ -45,7 +46,7 @@ mkInputs = fmap (TxInInfo (TxOutRef "" 0))
singleAuthorityTokenBurnedTest :: Value -> [TxOut] -> Script singleAuthorityTokenBurnedTest :: Value -> [TxOut] -> Script
singleAuthorityTokenBurnedTest mint outs = singleAuthorityTokenBurnedTest mint outs =
let actual :: ClosedTerm PBool let actual :: ClosedTerm PBool
actual = singleAuthorityTokenBurned (pconstant currencySymbol) (punsafeCoerce $ pconstant $ mkInputs outs) (pconstant mint) actual = singleAuthorityTokenBurned (pconstant $ Tagged currencySymbol) (punsafeCoerce $ pconstant $ mkInputs outs) (pconstant mint)
s :: ClosedTerm POpaque s :: ClosedTerm POpaque
s = s =
pif pif

25
agora/Agora/AuthorityToken.hs
View file

@ -11,6 +11,8 @@ module Agora.AuthorityToken (
singleAuthorityTokenBurned, singleAuthorityTokenBurned,
) where ) where
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (psymbolValueOfT, ptag, ptoScottEncodingT, puntag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential (..), PCredential (..),
PCurrencySymbol (..), PCurrencySymbol (..),
@ -28,12 +30,13 @@ import Plutarch.Api.V2 (
PTxInfo (PTxInfo), PTxInfo (PTxInfo),
PTxOut (PTxOut), PTxOut (PTxOut),
) )
import Plutarch.Extra.AssetClass (PAssetClassData, ptoScottEncoding) import Plutarch.Extra.AssetClass (PAssetClassData)
import Plutarch.Extra.Bool (passert) import Plutarch.Extra.Bool (passert)
import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc) import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
import Plutarch.Extra.Maybe (pfromJust) import Plutarch.Extra.Maybe (pfromJust)
import Plutarch.Extra.ScriptContext (pisTokenSpent) import Plutarch.Extra.ScriptContext (pisTokenSpent)
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pguardC, pguardC,
pletC, pletC,
@ -41,7 +44,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pmatchC, pmatchC,
) )
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Extra.Value (psymbolValueOf, psymbolValueOf') import Plutarch.Extra.Value (psymbolValueOf')
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -63,7 +66,7 @@ import Plutarch.Extra.Value (psymbolValueOf, psymbolValueOf')
@since 1.0.0 @since 1.0.0
-} -}
authorityTokensValidIn :: forall (s :: S). Term s (PCurrencySymbol :--> PTxOut :--> PBool) authorityTokensValidIn :: forall (s :: S). Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PTxOut :--> PBool)
authorityTokensValidIn = phoistAcyclic $ authorityTokensValidIn = phoistAcyclic $
plam $ \authorityTokenSym txOut'' -> unTermCont $ do plam $ \authorityTokenSym txOut'' -> unTermCont $ do
PTxOut txOut' <- pmatchC txOut'' PTxOut txOut' <- pmatchC txOut''
@ -72,7 +75,7 @@ authorityTokensValidIn = phoistAcyclic $
PValue value' <- pmatchC txOut.value PValue value' <- pmatchC txOut.value
PMap value <- pmatchC value' PMap value <- pmatchC value'
pure $ pure $
pmatch (plookupAssoc # pfstBuiltin # psndBuiltin # pdata authorityTokenSym # value) $ \case pmatch (plookupAssoc # pfstBuiltin # psndBuiltin # pdata (puntag authorityTokenSym) # value) $ \case
PJust (pfromData -> _tokenMap') -> PJust (pfromData -> _tokenMap') ->
pmatch (pfield @"credential" # address) $ \case pmatch (pfield @"credential" # address) $ \case
PPubKeyCredential _ -> PPubKeyCredential _ ->
@ -94,13 +97,13 @@ authorityTokensValidIn = phoistAcyclic $
-} -}
singleAuthorityTokenBurned :: singleAuthorityTokenBurned ::
forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S). forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
Term s PCurrencySymbol -> Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
Term s (PBuiltinList PTxInInfo) -> Term s (PBuiltinList PTxInInfo) ->
Term s (PValue keys amounts) -> Term s (PValue keys amounts) ->
Term s PBool Term s PBool
singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
let gatAmountMinted :: Term _ PInteger let gatAmountMinted :: Term _ PInteger
gatAmountMinted = psymbolValueOf # gatCs # mint gatAmountMinted = psymbolValueOfT # gatCs # mint
let inputsWithGAT = let inputsWithGAT =
pfoldMap pfoldMap
@ -116,7 +119,7 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
$ resolved $ resolved
pure . pcon . PSum $ pure . pcon . PSum $
psymbolValueOf psymbolValueOfT
# gatCs # gatCs
#$ pfield @"value" #$ pfield @"value"
#$ resolved #$ resolved
@ -144,15 +147,15 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
@since 0.1.0 @since 0.1.0
-} -}
authorityTokenPolicy :: ClosedTerm (PAssetClassData :--> PMintingPolicy) authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
authorityTokenPolicy = authorityTokenPolicy =
plam $ \atAssetClass _redeemer ctx' -> plam $ \gstAssetClass _redeemer ctx' ->
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo' txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
let inputs = txInfo.inputs let inputs = txInfo.inputs
govTokenSpent = pisTokenSpent # (ptoScottEncoding # atAssetClass) # inputs govTokenSpent = pisTokenSpent # puntag (ptoScottEncodingT # gstAssetClass) # inputs
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
@ -171,7 +174,7 @@ authorityTokenPolicy =
pguardC "All outputs only emit valid GATs" $ pguardC "All outputs only emit valid GATs" $
pall pall
# plam # plam
(authorityTokensValidIn # ownSymbol #) (authorityTokensValidIn # ptag ownSymbol #)
# txInfo.outputs # txInfo.outputs
pure $ pconstant () pure $ pconstant ()
) )

6
agora/Agora/Effect.hs
View file

@ -8,6 +8,7 @@ Helpers for constructing effects.
module Agora.Effect (makeEffect) where module Agora.Effect (makeEffect) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Agora.SafeMoney (AuthorityTokenTag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCurrencySymbol, PCurrencySymbol,
) )
@ -17,6 +18,7 @@ import Plutarch.Api.V2 (
PTxOutRef, PTxOutRef,
PValidator, PValidator,
) )
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
{- | Helper "template" for creating effect validator. {- | Helper "template" for creating effect validator.
@ -30,13 +32,13 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFiel
makeEffect :: makeEffect ::
forall (datum :: PType) (s :: S). forall (datum :: PType) (s :: S).
(PTryFrom PData datum, PIsData datum) => (PTryFrom PData datum, PIsData datum) =>
( Term s PCurrencySymbol -> ( Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
Term s datum -> Term s datum ->
Term s PTxOutRef -> Term s PTxOutRef ->
Term s (PAsData PTxInfo) -> Term s (PAsData PTxInfo) ->
Term s POpaque Term s POpaque
) -> ) ->
Term s PCurrencySymbol -> Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
Term s PValidator Term s PValidator
makeEffect f atSymbol = makeEffect f atSymbol =
plam $ \datum _redeemer ctx' -> unTermCont $ do plam $ \datum _redeemer ctx' -> unTermCont $ do

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

@ -26,6 +26,8 @@ import Agora.Governor (
PGovernorRedeemer, PGovernorRedeemer,
) )
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (psymbolValueOfT)
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash) import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PScriptPurpose (PSpending), PScriptPurpose (PSpending),
@ -46,8 +48,8 @@ import Plutarch.Extra.ScriptContext (
ptryFromOutputDatum, ptryFromOutputDatum,
ptryFromRedeemer, ptryFromRedeemer,
) )
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
import Plutarch.Extra.Value (psymbolValueOf)
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
import PlutusTx qualified import PlutusTx qualified
@ -150,8 +152,8 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum
mutateGovernorValidator :: mutateGovernorValidator ::
ClosedTerm ClosedTerm
( PValidatorHash ( PValidatorHash
:--> PCurrencySymbol :--> PTagged GovernorSTTag PCurrencySymbol
:--> PCurrencySymbol :--> PTagged AuthorityTokenTag PCurrencySymbol
:--> PValidator :--> PValidator
) )
mutateGovernorValidator = mutateGovernorValidator =
@ -191,7 +193,7 @@ mutateGovernorValidator =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Governor UTxO should carry GST" $ [ ptraceIfFalse "Governor UTxO should carry GST" $
psymbolValueOf psymbolValueOfT
# gstSymbol # gstSymbol
# (pfield @"value" # inputF.resolved) # (pfield @"value" # inputF.resolved)
#== 1 #== 1

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

@ -9,8 +9,10 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Agora.SafeMoney (AuthorityTokenTag)
import Plutarch.Api.V1 (PCurrencySymbol) import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V2 (PValidator) import Plutarch.Api.V2 (PValidator)
import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Orphans () import Plutarch.Orphans ()
{- | Dummy datum for NoOp effect. {- | Dummy datum for NoOp effect.
@ -40,7 +42,7 @@ instance PTryFrom PData (PAsData PNoOp)
@since 1.0.0 @since 1.0.0
-} -}
noOpValidator :: ClosedTerm (PCurrencySymbol :--> PValidator) noOpValidator :: ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
noOpValidator = plam $ noOpValidator = plam $
makeEffect $ makeEffect $
\_ (_datum :: Term s (PAsData PNoOp)) _ _ -> popaque (pconstant ()) \_ (_datum :: Term s (PAsData PNoOp)) _ _ -> popaque (pconstant ())

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

@ -15,6 +15,7 @@ module Agora.Effect.TreasuryWithdrawal (
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Agora.SafeMoney (AuthorityTokenTag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential, PCredential,
PCurrencySymbol, PCurrencySymbol,
@ -36,6 +37,7 @@ import Plutarch.DataRepr (
import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.Field (pletAllC)
import "liqwid-plutarch-extra" Plutarch.Extra.List (pdeleteFirst) import "liqwid-plutarch-extra" Plutarch.Extra.List (pdeleteFirst)
import Plutarch.Extra.ScriptContext (pisPubKey) import Plutarch.Extra.ScriptContext (pisPubKey)
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
import PlutusLedgerApi.V1.Credential (Credential) import PlutusLedgerApi.V1.Credential (Credential)
@ -133,7 +135,7 @@ instance PTryFrom PData PTreasuryWithdrawalDatum
-} -}
treasuryWithdrawalValidator :: treasuryWithdrawalValidator ::
forall (s :: S). forall (s :: S).
Term s (PCurrencySymbol :--> PValidator) Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
treasuryWithdrawalValidator = plam $ treasuryWithdrawalValidator = plam $
makeEffect $ makeEffect $
\_cs (datum :: Term _ PTreasuryWithdrawalDatum) effectInputRef txInfo -> unTermCont $ do \_cs (datum :: Term _ PTreasuryWithdrawalDatum) effectInputRef txInfo -> unTermCont $ do

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

@ -36,10 +36,12 @@ import Agora.Proposal (
pwinner, pwinner,
) )
import Agora.Proposal.Time (validateProposalStartingTime) import Agora.Proposal.Time (validateProposalStartingTime)
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag, ProposalSTTag, StakeSTTag)
import Agora.Stake ( import Agora.Stake (
pnumCreatedProposals, pnumCreatedProposals,
presolveStakeInputDatum, presolveStakeInputDatum,
) )
import Agora.Utils (psymbolValueOfT, ptoScottEncodingT, puntag)
import Plutarch.Api.V1 (PCurrencySymbol) import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V1.AssocMap (plookup)
import Plutarch.Api.V1.AssocMap qualified as AssocMap import Plutarch.Api.V1.AssocMap qualified as AssocMap
@ -51,7 +53,7 @@ import Plutarch.Api.V2 (
PTxOutRef, PTxOutRef,
PValidator, PValidator,
) )
import Plutarch.Extra.AssetClass (PAssetClassData, passetClass, ptoScottEncoding) import Plutarch.Extra.AssetClass (PAssetClassData, passetClass)
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, plistEqualsBy, pmapMaybe) import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, plistEqualsBy, pmapMaybe)
import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup) import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup)
@ -67,6 +69,7 @@ import Plutarch.Extra.ScriptContext (
ptryFromOutputDatum, ptryFromOutputDatum,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pguardC, pguardC,
pletC, pletC,
@ -261,10 +264,10 @@ governorValidator ::
-- | Lazy precompiled scripts. -- | Lazy precompiled scripts.
ClosedTerm ClosedTerm
( PAddress ( PAddress
:--> PAssetClassData :--> PTagged StakeSTTag PAssetClassData
:--> PCurrencySymbol :--> PTagged GovernorSTTag PCurrencySymbol
:--> PCurrencySymbol :--> PTagged ProposalSTTag PCurrencySymbol
:--> PCurrencySymbol :--> PTagged AuthorityTokenTag PCurrencySymbol
:--> PValidator :--> PValidator
) )
governorValidator = governorValidator =
@ -315,7 +318,7 @@ governorValidator =
[ ptraceIfFalse "Own by governor validator" $ [ ptraceIfFalse "Own by governor validator" $
outputF.address #== governorInputF.address outputF.address #== governorInputF.address
, ptraceIfFalse "Has governor ST" $ , ptraceIfFalse "Has governor ST" $
psymbolValueOf # gstSymbol # outputF.value #== 1 psymbolValueOfT # gstSymbol # outputF.value #== 1
] ]
datum = datum =
@ -339,7 +342,7 @@ governorValidator =
let isProposalUTxO = let isProposalUTxO =
txOutF.address txOutF.address
#== pdata proposalValidatorAddress #== pdata proposalValidatorAddress
#&& psymbolValueOf #&& psymbolValueOfT
# pstSymbol # pstSymbol
# txOutF.value # txOutF.value
#== 1 #== 1
@ -386,7 +389,7 @@ governorValidator =
pguardC "Exactly one proposal token must be minted" $ pguardC "Exactly one proposal token must be minted" $
let vMap = pfromData $ pto txInfoF.mint let vMap = pfromData $ pto txInfoF.mint
tnMap = plookup # pstSymbol # vMap tnMap = plookup # puntag pstSymbol # vMap
-- Ada and PST -- Ada and PST
onlyPST = plength # pto vMap #== 2 onlyPST = plength # pto vMap #== 2
onePST = onePST =
@ -404,7 +407,7 @@ governorValidator =
# "Stake input should present" # "Stake input should present"
#$ pfindJust #$ pfindJust
# ( presolveStakeInputDatum # ( presolveStakeInputDatum
# (ptoScottEncoding # sstClass) # (ptoScottEncodingT # sstClass)
# txInfoF.datums # txInfoF.datums
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
@ -475,7 +478,7 @@ governorValidator =
-- Filter out proposal inputs and ouputs using PST and the address of proposal validator. -- Filter out proposal inputs and ouputs using PST and the address of proposal validator.
pguardC "The governor can only process one proposal at a time" $ pguardC "The governor can only process one proposal at a time" $
(psymbolValueOf # pstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1 (psymbolValueOfT # pstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
let proposalInputDatum = let proposalInputDatum =
passertPJust passertPJust
@ -508,7 +511,7 @@ governorValidator =
outputF <- pletFieldsC @'["address", "datum", "value"] output outputF <- pletFieldsC @'["address", "datum", "value"] output
let isAuthorityUTxO = let isAuthorityUTxO =
psymbolValueOf psymbolValueOfT
# atSymbol # atSymbol
# outputF.value # outputF.value
#== 1 #== 1
@ -535,7 +538,7 @@ governorValidator =
# pconstant "" # pconstant ""
# plam (pscriptHashToTokenName . pfromData) # plam (pscriptHashToTokenName . pfromData)
# effect.scriptHash # effect.scriptHash
gatAssetClass = passetClass # atSymbol # tagToken gatAssetClass = passetClass # puntag atSymbol # tagToken
valueGATCorrect = valueGATCorrect =
passetClassValueOf passetClassValueOf
# gatAssetClass # gatAssetClass

135
agora/Agora/Linker.hs
View file

@ -3,10 +3,11 @@
module Agora.Linker (linker, AgoraScriptInfo (..)) where module Agora.Linker (linker, AgoraScriptInfo (..)) where
import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners)) import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners))
import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, StakeSTTag)
import Agora.Utils (validatorHashToAddress) import Agora.Utils (validatorHashToAddress)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.Map (fromList) import Data.Map (fromList)
import Data.Tagged (untag) import Data.Tagged (Tagged (Tagged))
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash) import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash)
import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (validatorHashToTokenName)
@ -31,10 +32,10 @@ import Prelude hiding ((#))
@since 1.0.0 @since 1.0.0
-} -}
data AgoraScriptInfo = AgoraScriptInfo data AgoraScriptInfo = AgoraScriptInfo
{ governorAssetClass :: AssetClass { governorAssetClass :: Tagged GovernorSTTag AssetClass
, authorityTokenSymbol :: CurrencySymbol , authorityTokenSymbol :: Tagged AuthorityTokenTag CurrencySymbol
, proposalAssetClass :: AssetClass , proposalAssetClass :: Tagged ProposalSTTag AssetClass
, stakeAssetClass :: AssetClass , stakeAssetClass :: Tagged StakeSTTag AssetClass
, governor :: Governor , governor :: Governor
} }
deriving stock (Generic, Show) deriving stock (Generic, Show)
@ -46,17 +47,72 @@ data AgoraScriptInfo = AgoraScriptInfo
-} -}
linker :: Linker Governor (ScriptExport AgoraScriptInfo) linker :: Linker Governor (ScriptExport AgoraScriptInfo)
linker = do linker = do
govPol <- fetchTS @MintingPolicyRole @'[TxOutRef] "agora:governorPolicy" govPol <-
govVal <- fetchTS @ValidatorRole @'[Address, AssetClass, CurrencySymbol, CurrencySymbol, CurrencySymbol] "agora:governorValidator" fetchTS
stkPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:stakePolicy" @MintingPolicyRole
stkVal <- fetchTS @ValidatorRole @'[CurrencySymbol, AssetClass, AssetClass] "agora:stakeValidator" @'[TxOutRef]
prpPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:proposalPolicy" "agora:governorPolicy"
prpVal <- fetchTS @ValidatorRole @'[AssetClass, CurrencySymbol, CurrencySymbol, Integer] "agora:proposalValidator" govVal <-
treVal <- fetchTS @ValidatorRole @'[CurrencySymbol] "agora:treasuryValidator" fetchTS
atkPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:authorityTokenPolicy" @ValidatorRole
noOpVal <- fetchTS @ValidatorRole @'[CurrencySymbol] "agora:noOpValidator" @'[ Address
treaWithdrawalVal <- fetchTS @ValidatorRole @'[CurrencySymbol] "agora:treasuryWithdrawalValidator" , Tagged StakeSTTag AssetClass
mutateGovVal <- fetchTS @ValidatorRole @'[ValidatorHash, CurrencySymbol, CurrencySymbol] "agora:mutateGovernorValidator" , Tagged GovernorSTTag CurrencySymbol
, Tagged ProposalSTTag CurrencySymbol
, Tagged AuthorityTokenTag CurrencySymbol
]
"agora:governorValidator"
stkPol <-
fetchTS
@MintingPolicyRole
@'[Tagged GTTag AssetClass]
"agora:stakePolicy"
stkVal <-
fetchTS
@ValidatorRole
@'[ Tagged StakeSTTag CurrencySymbol
, Tagged ProposalSTTag AssetClass
, Tagged GTTag AssetClass
]
"agora:stakeValidator"
prpPol <-
fetchTS @MintingPolicyRole
@'[Tagged GovernorSTTag AssetClass]
"agora:proposalPolicy"
prpVal <-
fetchTS
@ValidatorRole
@'[ Tagged StakeSTTag AssetClass
, Tagged GovernorSTTag CurrencySymbol
, Tagged ProposalSTTag CurrencySymbol
, Integer
]
"agora:proposalValidator"
treVal <-
fetchTS
@ValidatorRole
@'[Tagged AuthorityTokenTag CurrencySymbol]
"agora:treasuryValidator"
atkPol <-
fetchTS
@MintingPolicyRole
@'[Tagged GovernorSTTag AssetClass]
"agora:authorityTokenPolicy"
noOpVal <-
fetchTS
@ValidatorRole
@'[Tagged AuthorityTokenTag CurrencySymbol]
"agora:noOpValidator"
treaWithdrawalVal <-
fetchTS
@ValidatorRole
@'[Tagged AuthorityTokenTag CurrencySymbol]
"agora:treasuryWithdrawalValidator"
mutateGovVal <-
fetchTS
@ValidatorRole
@'[ValidatorHash, Tagged GovernorSTTag CurrencySymbol, Tagged AuthorityTokenTag CurrencySymbol]
"agora:mutateGovernorValidator"
governor <- getParam governor <- getParam
@ -64,10 +120,10 @@ linker = do
govVal' = govVal' =
govVal govVal
# propValAddress # propValAddress
# sstAssetClass # Tagged sstAssetClass
# gstSymbol # Tagged gstSymbol
# pstSymbol # Tagged pstSymbol
# atSymbol # Tagged atSymbol
gstSymbol = gstSymbol =
mintingPolicySymbol $ mintingPolicySymbol $
toMintingPolicy toMintingPolicy
@ -76,34 +132,41 @@ linker = do
AssetClass gstSymbol "" AssetClass gstSymbol ""
govValHash = validatorHash $ toValidator govVal' govValHash = validatorHash $ toValidator govVal'
at = gstAssetClass atPol' = atkPol # Tagged gstAssetClass
atPol' = atkPol # at
atSymbol = mintingPolicySymbol $ toMintingPolicy atPol' atSymbol = mintingPolicySymbol $ toMintingPolicy atPol'
propPol' = prpPol # gstAssetClass propPol' = prpPol # Tagged gstAssetClass
propVal' = propVal' =
prpVal prpVal
# sstAssetClass # Tagged sstAssetClass
# gstSymbol # Tagged gstSymbol
# pstSymbol # Tagged pstSymbol
# governor.maximumCosigners # governor.maximumCosigners
propValAddress = propValAddress =
validatorHashToAddress $ validatorHash $ toValidator propVal' validatorHashToAddress $ validatorHash $ toValidator propVal'
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol' pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol'
pstAssetClass = AssetClass pstSymbol "" pstAssetClass = AssetClass pstSymbol ""
stakPol' = stkPol # untag governor.gtClassRef stakPol' = stkPol # governor.gtClassRef
stakVal' = stkVal # sstSymbol # pstAssetClass # untag governor.gtClassRef stakVal' =
stkVal
# Tagged sstSymbol
# Tagged pstAssetClass
# governor.gtClassRef
sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol' sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol'
stakValTokenName = stakValTokenName =
validatorHashToTokenName $ validatorHash $ toValidator stakVal' validatorHashToTokenName $ validatorHash $ toValidator stakVal'
sstAssetClass = AssetClass sstSymbol stakValTokenName sstAssetClass = AssetClass sstSymbol stakValTokenName
treaVal' = treVal # atSymbol treaVal' = treVal # Tagged atSymbol
noOpVal' = noOpVal # atSymbol noOpVal' = noOpVal # Tagged atSymbol
treaWithdrawalVal' = treaWithdrawalVal # atSymbol treaWithdrawalVal' = treaWithdrawalVal # Tagged atSymbol
mutateGovVal' = mutateGovVal # govValHash # gstSymbol # atSymbol mutateGovVal' =
mutateGovVal
# govValHash
# Tagged gstSymbol
# Tagged atSymbol
return $ return $
ScriptExport ScriptExport
@ -123,10 +186,10 @@ linker = do
] ]
, information = , information =
AgoraScriptInfo AgoraScriptInfo
{ governorAssetClass = gstAssetClass { governorAssetClass = Tagged gstAssetClass
, authorityTokenSymbol = atSymbol , authorityTokenSymbol = Tagged atSymbol
, proposalAssetClass = pstAssetClass , proposalAssetClass = Tagged pstAssetClass
, stakeAssetClass = sstAssetClass , stakeAssetClass = Tagged sstAssetClass
, governor = governor , governor = governor
} }
} }

10
agora/Agora/Plutarch/Orphans.hs
View file

@ -6,10 +6,14 @@ import Plutarch.Lift (PConstantDecl (..), PUnsafeLiftDecl (PLifted))
import Data.Bifunctor (Bifunctor (bimap)) import Data.Bifunctor (Bifunctor (bimap))
import Data.Map.Strict qualified as StrictMap import Data.Map.Strict qualified as StrictMap
import Data.Tagged (Tagged (Tagged))
import Data.Traversable (for) import Data.Traversable (for)
import Plutarch.Api.V1 (KeyGuarantees (Sorted), PMap) import Plutarch.Api.V1 (KeyGuarantees (Sorted), PMap)
import Plutarch.Extra.Tagged (PTagged)
import PlutusTx qualified import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Ply (PlyArg)
import Ply.Plutarch.Class (PlyArgOf)
-- | @since 1.0.0 -- | @since 1.0.0
instance instance
@ -74,3 +78,9 @@ instance
isSorted [] = True isSorted [] = True
isSorted [_] = True isSorted [_] = True
isSorted (x : y : xs) = x < y && isSorted (y : xs) isSorted (x : y : xs) = x < y && isSorted (y : xs)
-- | @since 1.0.0
type instance PlyArgOf (PTagged tag a) = Tagged tag (PlyArgOf a)
-- | @since 1.0.0
deriving newtype instance PlyArg a => PlyArg (Tagged tag a)

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

@ -27,6 +27,7 @@ import Agora.Proposal.Time (
pgetRelation, pgetRelation,
pisWithin, pisWithin,
) )
import Agora.SafeMoney (GovernorSTTag, ProposalSTTag, StakeSTTag)
import Agora.Stake ( import Agora.Stake (
PStakeDatum, PStakeDatum,
pextractVoteOption, pextractVoteOption,
@ -35,6 +36,7 @@ import Agora.Stake (
pisVoter, pisVoter,
presolveStakeInputDatum, presolveStakeInputDatum,
) )
import Agora.Utils (psymbolValueOfT, ptoScottEncodingT)
import Plutarch.Api.V1 (PCredential, PCurrencySymbol) import Plutarch.Api.V1 (PCredential, PCurrencySymbol)
import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V1.AssocMap (plookup)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
@ -45,7 +47,6 @@ import Plutarch.Api.V2 (
) )
import Plutarch.Extra.AssetClass ( import Plutarch.Extra.AssetClass (
PAssetClassData, PAssetClassData,
ptoScottEncoding,
) )
import Plutarch.Extra.Category (PCategory (pidentity)) import Plutarch.Extra.Category (PCategory (pidentity))
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
@ -72,6 +73,7 @@ import Plutarch.Extra.ScriptContext (
ptryFromRedeemer, ptryFromRedeemer,
) )
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pguardC, pguardC,
pletC, pletC,
@ -80,7 +82,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
ptryFromC, ptryFromC,
) )
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Extra.Value (passetClassValueOf, psymbolValueOf) import Plutarch.Extra.Value (passetClassValueOfT, psymbolValueOf)
import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Unsafe (punsafeCoerce)
{- | Policy for Proposals. {- | Policy for Proposals.
@ -108,7 +110,7 @@ import Plutarch.Unsafe (punsafeCoerce)
@since 1.0.0 @since 1.0.0
-} -}
proposalPolicy :: ClosedTerm (PAssetClassData :--> PMintingPolicy) proposalPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
proposalPolicy = proposalPolicy =
plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do
ctxF <- pletAllC ctx ctxF <- pletAllC ctx
@ -132,8 +134,8 @@ proposalPolicy =
( flip pletAll $ \inputF -> ( flip pletAll $ \inputF ->
let value = pfield @"value" # inputF.resolved let value = pfield @"value" # inputF.resolved
isGovernorInput = isGovernorInput =
passetClassValueOf passetClassValueOfT
# (ptoScottEncoding # gstAssetClass) # (ptoScottEncodingT # gstAssetClass)
# value # value
#== 1 #== 1
in pif in pif
@ -238,9 +240,9 @@ instance DerivePlutusType PStakeInputsContext where
-} -}
proposalValidator :: proposalValidator ::
ClosedTerm ClosedTerm
( PAssetClassData ( PTagged StakeSTTag PAssetClassData
:--> PCurrencySymbol :--> PTagged GovernorSTTag PCurrencySymbol
:--> PCurrencySymbol :--> PTagged ProposalSTTag PCurrencySymbol
:--> PInteger :--> PInteger
:--> PValidator :--> PValidator
) )
@ -301,7 +303,7 @@ proposalValidator =
[ ptraceIfFalse "Own by proposal validator" $ [ ptraceIfFalse "Own by proposal validator" $
outputF.address #== proposalInputF.address outputF.address #== proposalInputF.address
, ptraceIfFalse "Has proposal ST" $ , ptraceIfFalse "Has proposal ST" $
psymbolValueOf # pstSymbol # outputF.value #== 1 psymbolValueOfT # pstSymbol # outputF.value #== 1
] ]
handleProposalUTxO = handleProposalUTxO =
@ -341,7 +343,7 @@ proposalValidator =
resolveStakeInputDatum <- resolveStakeInputDatum <-
pletC $ pletC $
presolveStakeInputDatum presolveStakeInputDatum
# (ptoScottEncoding # sstClass) # (ptoScottEncodingT # sstClass)
# txInfoF.datums # txInfoF.datums
spendStakes' :: Term _ ((PStakeInputsContext :--> PUnit) :--> PUnit) <- spendStakes' :: Term _ ((PStakeInputsContext :--> PUnit) :--> PUnit) <-
pletC $ pletC $
@ -727,7 +729,7 @@ proposalValidator =
. (pfield @"resolved" #) -> . (pfield @"resolved" #) ->
value value
) -> ) ->
psymbolValueOf # gstSymbol # value #== 1 psymbolValueOfT # gstSymbol # value #== 1
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs

8
agora/Agora/Stake.hs
View file

@ -49,7 +49,7 @@ import Agora.Proposal (
ProposalId, ProposalId,
ResultTag, ResultTag,
) )
import Agora.SafeMoney (GTTag) import Agora.SafeMoney (GTTag, StakeSTTag)
import Data.Tagged (Tagged) import Data.Tagged (Tagged)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PCredential) import Plutarch.Api.V1 (PCredential)
@ -79,7 +79,7 @@ import Plutarch.Extra.ScriptContext (ptryFromOutputDatum)
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Extra.Value (passetClassValueOf) import Plutarch.Extra.Value (passetClassValueOfT)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
import Plutarch.Orphans () import Plutarch.Orphans ()
import PlutusLedgerApi.V2 (Credential) import PlutusLedgerApi.V2 (Credential)
@ -715,7 +715,7 @@ presolveStakeInputDatum ::
forall (s :: S). forall (s :: S).
Term Term
s s
( PAssetClass ( PTagged StakeSTTag PAssetClass
:--> PMap 'Unsorted PDatumHash PDatum :--> PMap 'Unsorted PDatumHash PDatum
:--> PTxInInfo :--> PTxInInfo
:--> PMaybe PStakeDatum :--> PMaybe PStakeDatum
@ -726,7 +726,7 @@ presolveStakeInputDatum = phoistAcyclic $
(pletFields @'["value", "datum", "address"]) (pletFields @'["value", "datum", "address"])
( \txOutF -> ( \txOutF ->
let isStakeUTxO = let isStakeUTxO =
passetClassValueOf passetClassValueOfT
# sstClass # sstClass
# txOutF.value # txOutF.value
#== 1 #== 1

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

@ -13,6 +13,7 @@ module Agora.Stake.Scripts (
import Agora.Credential (authorizationContext, pauthorizedBy) import Agora.Credential (authorizationContext, pauthorizedBy)
import Agora.Proposal (PProposalDatum, PProposalRedeemer) import Agora.Proposal (PProposalDatum, PProposalRedeemer)
import Agora.SafeMoney (GTTag, ProposalSTTag, StakeSTTag)
import Agora.Stake ( import Agora.Stake (
PProposalContext ( PProposalContext (
PNewProposal, PNewProposal,
@ -52,7 +53,7 @@ import Agora.Stake.Redeemers (
ppermitVote, ppermitVote,
pretractVote, pretractVote,
) )
import Agora.Utils (pisDNothing) import Agora.Utils (pisDNothing, ptoScottEncodingT, puntag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential (PPubKeyCredential, PScriptCredential), PCredential (PPubKeyCredential, PScriptCredential),
PCurrencySymbol, PCurrencySymbol,
@ -71,7 +72,6 @@ import Plutarch.Extra.AssetClass (
PAssetClass, PAssetClass,
PAssetClassData, PAssetClassData,
passetClass, passetClass,
ptoScottEncoding,
) )
import Plutarch.Extra.Bool (passert) import Plutarch.Extra.Bool (passert)
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
@ -92,6 +92,7 @@ import Plutarch.Extra.ScriptContext (
pvalidatorHashToTokenName, pvalidatorHashToTokenName,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pguardC, pguardC,
pletC, pletC,
@ -101,6 +102,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
) )
import Plutarch.Extra.Value ( import Plutarch.Extra.Value (
passetClassValueOf, passetClassValueOf,
passetClassValueOfT,
psymbolValueOf, psymbolValueOf,
psymbolValueOf', psymbolValueOf',
) )
@ -128,15 +130,14 @@ import Prelude hiding (Num ((+)))
== Arguments == Arguments
Following arguments should be provided(in this order): Following arguments should be provided(in this order):
1. governor ST assetclass 1. governance token assetclass
@since 1.0.0 @since 1.0.0
-} -}
stakePolicy :: stakePolicy ::
-- | The (governance) token that a Stake can store. ClosedTerm (PTagged GTTag PAssetClassData :--> PMintingPolicy)
ClosedTerm (PAssetClassData :--> PMintingPolicy)
stakePolicy = stakePolicy =
plam $ \gstClass _redeemer ctx' -> unTermCont $ do plam $ \gtClass _redeemer ctx' -> unTermCont $ do
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
txInfo <- pletC $ ctx.txInfo txInfo <- pletC $ ctx.txInfo
let _a :: Term _ PTxInfo let _a :: Term _ PTxInfo
@ -202,10 +203,10 @@ stakePolicy =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Stake ouput has expected amount of stake token" $ [ ptraceIfFalse "Stake ouput has expected amount of stake token" $
passetClassValueOf passetClassValueOfT
# (ptoScottEncoding # gstClass) # (ptoScottEncodingT # gtClass)
# outputF.value # outputF.value
#== pto (pfromData datumF.stakedAmount) #== (pfromData datumF.stakedAmount)
, ptraceIfFalse "Stake Owner should sign the transaction" $ , ptraceIfFalse "Stake Owner should sign the transaction" $
pauthorizedBy pauthorizedBy
# authorizationContext txInfoF # authorizationContext txInfoF
@ -229,17 +230,17 @@ stakePolicy =
Following arguments should be provided(in this order): Following arguments should be provided(in this order):
1. stake ST symbol 1. stake ST symbol
2. proposal ST assetclass 2. proposal ST assetclass
3. governor ST assetclass 3. governance token assetclass
@since 1.0.0 @since 1.0.0
-} -}
mkStakeValidator :: mkStakeValidator ::
StakeRedeemerImpl s -> StakeRedeemerImpl s ->
Term s PCurrencySymbol -> Term s (PTagged StakeSTTag PCurrencySymbol) ->
Term s PAssetClass -> Term s (PTagged ProposalSTTag PAssetClass) ->
Term s PAssetClass -> Term s (PTagged GTTag PAssetClass) ->
Term s PValidator Term s PValidator
mkStakeValidator impl sstSymbol pstClass gstClass = mkStakeValidator impl sstSymbol pstClass gtClass =
plam $ \_datum redeemer ctx -> unTermCont $ do plam $ \_datum redeemer ctx -> unTermCont $ do
ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
txInfo <- pletC $ pfromData ctxF.txInfo txInfo <- pletC $ pfromData ctxF.txInfo
@ -280,7 +281,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
PScriptCredential r -> pfield @"_0" # r PScriptCredential r -> pfield @"_0" # r
_ -> perror _ -> perror
sstClass <- pletC $ passetClass # sstSymbol # sstName sstClass <- pletC $ passetClass # puntag sstSymbol # sstName
-------------------------------------------------------------------------- --------------------------------------------------------------------------
@ -405,13 +406,12 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
( \output -> ( \output ->
let validateGT = plam $ \stakeDatum -> let validateGT = plam $ \stakeDatum ->
let expected = let expected =
pto $ pfromData $
pfromData $ pfield @"stakedAmount" # stakeDatum
pfield @"stakedAmount" # stakeDatum
actual = actual =
passetClassValueOf passetClassValueOfT
# gstClass # gtClass
# (pfield @"value" # output) # (pfield @"value" # output)
in pif in pif
(expected #== actual) (expected #== actual)
@ -431,10 +431,11 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
plam $ plam $
flip pletAll $ \txOutF -> flip pletAll $ \txOutF ->
let isProposalUTxO = let isProposalUTxO =
passetClassValueOf passetClassValueOfT
# pstClass # pstClass
# txOutF.value # txOutF.value
#== 1 #== 1
proposalDatum = proposalDatum =
pfromData $ pfromData $
ptryFromOutputDatum @(PAsData PProposalDatum) ptryFromOutputDatum @(PAsData PProposalDatum)
@ -443,7 +444,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
in pif isProposalUTxO (pjust # proposalDatum) pnothing in pif isProposalUTxO (pjust # proposalDatum) pnothing
let pstMinted = let pstMinted =
passetClassValueOf # pstClass # txInfoF.mint #== 1 passetClassValueOfT # pstClass # txInfoF.mint #== 1
newProposalContext = newProposalContext =
pcon $ pcon $
@ -596,15 +597,15 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
Following arguments should be provided(in this order): Following arguments should be provided(in this order):
1. stake ST symbol 1. stake ST symbol
2. proposal ST assetclass 2. proposal ST assetclass
3. governor ST assetclass 3. governance token assetclass
@since 1.0.0 @since 1.0.0
-} -}
stakeValidator :: stakeValidator ::
ClosedTerm ClosedTerm
( PCurrencySymbol ( PTagged StakeSTTag PCurrencySymbol
:--> PAssetClassData :--> PTagged ProposalSTTag PAssetClassData
:--> PAssetClassData :--> PTagged GTTag PAssetClassData
:--> PValidator :--> PValidator
) )
stakeValidator = stakeValidator =
@ -620,5 +621,5 @@ stakeValidator =
} }
) )
sstSymbol sstSymbol
(ptoScottEncoding # pstClass) (ptoScottEncodingT # pstClass)
(ptoScottEncoding # gstClass) (ptoScottEncodingT # gstClass)

4
agora/Agora/Treasury.hs
View file

@ -13,8 +13,10 @@ module Agora.Treasury (
) where ) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Agora.SafeMoney (AuthorityTokenTag)
import Plutarch.Api.V1.Value (PCurrencySymbol, PValue) import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
import Plutarch.Api.V2 (PScriptPurpose (PSpending), PValidator) import Plutarch.Api.V2 (PScriptPurpose (PSpending), PValidator)
import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
{- | Validator ensuring that transactions consuming the treasury {- | Validator ensuring that transactions consuming the treasury
@ -28,7 +30,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletFieldsC, pm
@since 0.1.0 @since 0.1.0
-} -}
treasuryValidator :: treasuryValidator ::
ClosedTerm (PCurrencySymbol :--> PValidator) ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do
-- plet required fields from script context. -- plet required fields from script context.
ctx <- pletFieldsC @["txInfo", "purpose"] ctx' ctx <- pletFieldsC @["txInfo", "purpose"] ctx'

45
agora/Agora/Utils.hs
View file

@ -13,11 +13,23 @@ module Agora.Utils (
punwords, punwords,
pisNothing, pisNothing,
pisDNothing, pisDNothing,
ptoScottEncodingT,
psymbolValueOfT,
ptag,
puntag,
) where ) where
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
AmountGuarantees,
KeyGuarantees,
PCurrencySymbol,
PMaybeData (PDNothing), PMaybeData (PDNothing),
PValue,
) )
import Plutarch.Extra.AssetClass (PAssetClass, PAssetClassData, ptoScottEncoding)
import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Extra.Value (psymbolValueOf)
import Plutarch.Unsafe (punsafeDowncast)
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (ScriptCredential), Credential (ScriptCredential),
@ -67,3 +79,36 @@ pisDNothing = phoistAcyclic $
flip pmatch $ \case flip pmatch $ \case
PDNothing _ -> pconstant True PDNothing _ -> pconstant True
_ -> pconstant False _ -> pconstant False
-- | @since 1.0.0
ptoScottEncodingT ::
forall {k :: Type} (unit :: k) (s :: S).
Term s (PTagged unit PAssetClassData :--> PTagged unit PAssetClass)
ptoScottEncodingT = phoistAcyclic $
plam $ \d ->
punsafeDowncast $ ptoScottEncoding #$ pto d
-- | @since 1.0.0
psymbolValueOfT ::
forall
{k :: Type}
(unit :: k)
(keys :: KeyGuarantees)
(amounts :: AmountGuarantees)
(s :: S).
Term s (PTagged unit PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
psymbolValueOfT = phoistAcyclic $ plam $ \tcs -> psymbolValueOf # pto tcs
-- | @since 1.0.0
ptag ::
forall {k :: Type} (tag :: k) (a :: PType) (s :: S).
Term s a ->
Term s (PTagged tag a)
ptag = punsafeDowncast
-- | @since 1.0.0
puntag ::
forall {k :: Type} (tag :: k) (a :: PType) (s :: S).
Term s (PTagged tag a) ->
Term s a
puntag = pto