tag assetclasses and currency symbols
This commit is contained in:
Hongrui Fang
parent
49b40c24a8
commit
ec9f6d3425
14 changed files with 250 additions and 112 deletions
|
|
@ -10,6 +10,7 @@ Tests for Authority token functions
|
|||
module Spec.AuthorityToken (specs) where
|
||||
|
||||
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
||||
import Data.Tagged (Tagged (Tagged))
|
||||
import Plutarch.Extra.Compile (mustCompile)
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import PlutusLedgerApi.V1 (
|
||||
|
|
@ -45,7 +46,7 @@ mkInputs = fmap (TxInInfo (TxOutRef "" 0))
|
|||
singleAuthorityTokenBurnedTest :: Value -> [TxOut] -> Script
|
||||
singleAuthorityTokenBurnedTest mint outs =
|
||||
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 =
|
||||
pif
|
||||
|
|
|
|||
|
|
@ -11,6 +11,8 @@ module Agora.AuthorityToken (
|
|||
singleAuthorityTokenBurned,
|
||||
) where
|
||||
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
|
||||
import Agora.Utils (psymbolValueOfT, ptag, ptoScottEncodingT, puntag)
|
||||
import Plutarch.Api.V1 (
|
||||
PCredential (..),
|
||||
PCurrencySymbol (..),
|
||||
|
|
@ -28,12 +30,13 @@ import Plutarch.Api.V2 (
|
|||
PTxInfo (PTxInfo),
|
||||
PTxOut (PTxOut),
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData, ptoScottEncoding)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData)
|
||||
import Plutarch.Extra.Bool (passert)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
|
||||
import Plutarch.Extra.Maybe (pfromJust)
|
||||
import Plutarch.Extra.ScriptContext (pisTokenSpent)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
||||
pguardC,
|
||||
pletC,
|
||||
|
|
@ -41,7 +44,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
pmatchC,
|
||||
)
|
||||
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
|
||||
-}
|
||||
authorityTokensValidIn :: forall (s :: S). Term s (PCurrencySymbol :--> PTxOut :--> PBool)
|
||||
authorityTokensValidIn :: forall (s :: S). Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PTxOut :--> PBool)
|
||||
authorityTokensValidIn = phoistAcyclic $
|
||||
plam $ \authorityTokenSym txOut'' -> unTermCont $ do
|
||||
PTxOut txOut' <- pmatchC txOut''
|
||||
|
|
@ -72,7 +75,7 @@ authorityTokensValidIn = phoistAcyclic $
|
|||
PValue value' <- pmatchC txOut.value
|
||||
PMap value <- pmatchC value'
|
||||
pure $
|
||||
pmatch (plookupAssoc # pfstBuiltin # psndBuiltin # pdata authorityTokenSym # value) $ \case
|
||||
pmatch (plookupAssoc # pfstBuiltin # psndBuiltin # pdata (puntag authorityTokenSym) # value) $ \case
|
||||
PJust (pfromData -> _tokenMap') ->
|
||||
pmatch (pfield @"credential" # address) $ \case
|
||||
PPubKeyCredential _ ->
|
||||
|
|
@ -94,13 +97,13 @@ authorityTokensValidIn = phoistAcyclic $
|
|||
-}
|
||||
singleAuthorityTokenBurned ::
|
||||
forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
|
||||
Term s PCurrencySymbol ->
|
||||
Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
|
||||
Term s (PBuiltinList PTxInInfo) ->
|
||||
Term s (PValue keys amounts) ->
|
||||
Term s PBool
|
||||
singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
|
||||
let gatAmountMinted :: Term _ PInteger
|
||||
gatAmountMinted = psymbolValueOf # gatCs # mint
|
||||
gatAmountMinted = psymbolValueOfT # gatCs # mint
|
||||
|
||||
let inputsWithGAT =
|
||||
pfoldMap
|
||||
|
|
@ -116,7 +119,7 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
|
|||
$ resolved
|
||||
|
||||
pure . pcon . PSum $
|
||||
psymbolValueOf
|
||||
psymbolValueOfT
|
||||
# gatCs
|
||||
#$ pfield @"value"
|
||||
#$ resolved
|
||||
|
|
@ -144,15 +147,15 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
|
|||
|
||||
@since 0.1.0
|
||||
-}
|
||||
authorityTokenPolicy :: ClosedTerm (PAssetClassData :--> PMintingPolicy)
|
||||
authorityTokenPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
|
||||
authorityTokenPolicy =
|
||||
plam $ \atAssetClass _redeemer ctx' ->
|
||||
plam $ \gstAssetClass _redeemer ctx' ->
|
||||
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
|
||||
txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
|
||||
let inputs = txInfo.inputs
|
||||
govTokenSpent = pisTokenSpent # (ptoScottEncoding # atAssetClass) # inputs
|
||||
govTokenSpent = pisTokenSpent # puntag (ptoScottEncodingT # gstAssetClass) # inputs
|
||||
|
||||
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
|
||||
|
||||
|
|
@ -171,7 +174,7 @@ authorityTokenPolicy =
|
|||
pguardC "All outputs only emit valid GATs" $
|
||||
pall
|
||||
# plam
|
||||
(authorityTokensValidIn # ownSymbol #)
|
||||
(authorityTokensValidIn # ptag ownSymbol #)
|
||||
# txInfo.outputs
|
||||
pure $ pconstant ()
|
||||
)
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ Helpers for constructing effects.
|
|||
module Agora.Effect (makeEffect) where
|
||||
|
||||
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
||||
import Agora.SafeMoney (AuthorityTokenTag)
|
||||
import Plutarch.Api.V1 (
|
||||
PCurrencySymbol,
|
||||
)
|
||||
|
|
@ -17,6 +18,7 @@ import Plutarch.Api.V2 (
|
|||
PTxOutRef,
|
||||
PValidator,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
|
||||
|
||||
{- | Helper "template" for creating effect validator.
|
||||
|
|
@ -30,13 +32,13 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFiel
|
|||
makeEffect ::
|
||||
forall (datum :: PType) (s :: S).
|
||||
(PTryFrom PData datum, PIsData datum) =>
|
||||
( Term s PCurrencySymbol ->
|
||||
( Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
|
||||
Term s datum ->
|
||||
Term s PTxOutRef ->
|
||||
Term s (PAsData PTxInfo) ->
|
||||
Term s POpaque
|
||||
) ->
|
||||
Term s PCurrencySymbol ->
|
||||
Term s (PTagged AuthorityTokenTag PCurrencySymbol) ->
|
||||
Term s PValidator
|
||||
makeEffect f atSymbol =
|
||||
plam $ \datum _redeemer ctx' -> unTermCont $ do
|
||||
|
|
|
|||
|
|
@ -26,6 +26,8 @@ import Agora.Governor (
|
|||
PGovernorRedeemer,
|
||||
)
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
|
||||
import Agora.Utils (psymbolValueOfT)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash)
|
||||
import Plutarch.Api.V2 (
|
||||
PScriptPurpose (PSpending),
|
||||
|
|
@ -46,8 +48,8 @@ import Plutarch.Extra.ScriptContext (
|
|||
ptryFromOutputDatum,
|
||||
ptryFromRedeemer,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
|
||||
import Plutarch.Extra.Value (psymbolValueOf)
|
||||
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
import PlutusTx qualified
|
||||
|
|
@ -150,8 +152,8 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum
|
|||
mutateGovernorValidator ::
|
||||
ClosedTerm
|
||||
( PValidatorHash
|
||||
:--> PCurrencySymbol
|
||||
:--> PCurrencySymbol
|
||||
:--> PTagged GovernorSTTag PCurrencySymbol
|
||||
:--> PTagged AuthorityTokenTag PCurrencySymbol
|
||||
:--> PValidator
|
||||
)
|
||||
mutateGovernorValidator =
|
||||
|
|
@ -191,7 +193,7 @@ mutateGovernorValidator =
|
|||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Governor UTxO should carry GST" $
|
||||
psymbolValueOf
|
||||
psymbolValueOfT
|
||||
# gstSymbol
|
||||
# (pfield @"value" # inputF.resolved)
|
||||
#== 1
|
||||
|
|
|
|||
|
|
@ -9,8 +9,10 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where
|
|||
|
||||
import Agora.Effect (makeEffect)
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import Agora.SafeMoney (AuthorityTokenTag)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol)
|
||||
import Plutarch.Api.V2 (PValidator)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import Plutarch.Orphans ()
|
||||
|
||||
{- | Dummy datum for NoOp effect.
|
||||
|
|
@ -40,7 +42,7 @@ instance PTryFrom PData (PAsData PNoOp)
|
|||
|
||||
@since 1.0.0
|
||||
-}
|
||||
noOpValidator :: ClosedTerm (PCurrencySymbol :--> PValidator)
|
||||
noOpValidator :: ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
|
||||
noOpValidator = plam $
|
||||
makeEffect $
|
||||
\_ (_datum :: Term s (PAsData PNoOp)) _ _ -> popaque (pconstant ())
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@ module Agora.Effect.TreasuryWithdrawal (
|
|||
|
||||
import Agora.Effect (makeEffect)
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import Agora.SafeMoney (AuthorityTokenTag)
|
||||
import Plutarch.Api.V1 (
|
||||
PCredential,
|
||||
PCurrencySymbol,
|
||||
|
|
@ -36,6 +37,7 @@ import Plutarch.DataRepr (
|
|||
import Plutarch.Extra.Field (pletAllC)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pdeleteFirst)
|
||||
import Plutarch.Extra.ScriptContext (pisPubKey)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
|
||||
import PlutusLedgerApi.V1.Credential (Credential)
|
||||
|
|
@ -133,7 +135,7 @@ instance PTryFrom PData PTreasuryWithdrawalDatum
|
|||
-}
|
||||
treasuryWithdrawalValidator ::
|
||||
forall (s :: S).
|
||||
Term s (PCurrencySymbol :--> PValidator)
|
||||
Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
|
||||
treasuryWithdrawalValidator = plam $
|
||||
makeEffect $
|
||||
\_cs (datum :: Term _ PTreasuryWithdrawalDatum) effectInputRef txInfo -> unTermCont $ do
|
||||
|
|
|
|||
|
|
@ -36,10 +36,12 @@ import Agora.Proposal (
|
|||
pwinner,
|
||||
)
|
||||
import Agora.Proposal.Time (validateProposalStartingTime)
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag, ProposalSTTag, StakeSTTag)
|
||||
import Agora.Stake (
|
||||
pnumCreatedProposals,
|
||||
presolveStakeInputDatum,
|
||||
)
|
||||
import Agora.Utils (psymbolValueOfT, ptoScottEncodingT, puntag)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol)
|
||||
import Plutarch.Api.V1.AssocMap (plookup)
|
||||
import Plutarch.Api.V1.AssocMap qualified as AssocMap
|
||||
|
|
@ -51,7 +53,7 @@ import Plutarch.Api.V2 (
|
|||
PTxOutRef,
|
||||
PValidator,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData, passetClass, ptoScottEncoding)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData, passetClass)
|
||||
import Plutarch.Extra.Field (pletAll, pletAllC)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, plistEqualsBy, pmapMaybe)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup)
|
||||
|
|
@ -67,6 +69,7 @@ import Plutarch.Extra.ScriptContext (
|
|||
ptryFromOutputDatum,
|
||||
pvalueSpent,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
||||
pguardC,
|
||||
pletC,
|
||||
|
|
@ -261,10 +264,10 @@ governorValidator ::
|
|||
-- | Lazy precompiled scripts.
|
||||
ClosedTerm
|
||||
( PAddress
|
||||
:--> PAssetClassData
|
||||
:--> PCurrencySymbol
|
||||
:--> PCurrencySymbol
|
||||
:--> PCurrencySymbol
|
||||
:--> PTagged StakeSTTag PAssetClassData
|
||||
:--> PTagged GovernorSTTag PCurrencySymbol
|
||||
:--> PTagged ProposalSTTag PCurrencySymbol
|
||||
:--> PTagged AuthorityTokenTag PCurrencySymbol
|
||||
:--> PValidator
|
||||
)
|
||||
governorValidator =
|
||||
|
|
@ -315,7 +318,7 @@ governorValidator =
|
|||
[ ptraceIfFalse "Own by governor validator" $
|
||||
outputF.address #== governorInputF.address
|
||||
, ptraceIfFalse "Has governor ST" $
|
||||
psymbolValueOf # gstSymbol # outputF.value #== 1
|
||||
psymbolValueOfT # gstSymbol # outputF.value #== 1
|
||||
]
|
||||
|
||||
datum =
|
||||
|
|
@ -339,7 +342,7 @@ governorValidator =
|
|||
let isProposalUTxO =
|
||||
txOutF.address
|
||||
#== pdata proposalValidatorAddress
|
||||
#&& psymbolValueOf
|
||||
#&& psymbolValueOfT
|
||||
# pstSymbol
|
||||
# txOutF.value
|
||||
#== 1
|
||||
|
|
@ -386,7 +389,7 @@ governorValidator =
|
|||
|
||||
pguardC "Exactly one proposal token must be minted" $
|
||||
let vMap = pfromData $ pto txInfoF.mint
|
||||
tnMap = plookup # pstSymbol # vMap
|
||||
tnMap = plookup # puntag pstSymbol # vMap
|
||||
-- Ada and PST
|
||||
onlyPST = plength # pto vMap #== 2
|
||||
onePST =
|
||||
|
|
@ -404,7 +407,7 @@ governorValidator =
|
|||
# "Stake input should present"
|
||||
#$ pfindJust
|
||||
# ( presolveStakeInputDatum
|
||||
# (ptoScottEncoding # sstClass)
|
||||
# (ptoScottEncodingT # sstClass)
|
||||
# txInfoF.datums
|
||||
)
|
||||
# pfromData txInfoF.inputs
|
||||
|
|
@ -475,7 +478,7 @@ governorValidator =
|
|||
-- 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" $
|
||||
(psymbolValueOf # pstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
|
||||
(psymbolValueOfT # pstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
|
||||
|
||||
let proposalInputDatum =
|
||||
passertPJust
|
||||
|
|
@ -508,7 +511,7 @@ governorValidator =
|
|||
outputF <- pletFieldsC @'["address", "datum", "value"] output
|
||||
|
||||
let isAuthorityUTxO =
|
||||
psymbolValueOf
|
||||
psymbolValueOfT
|
||||
# atSymbol
|
||||
# outputF.value
|
||||
#== 1
|
||||
|
|
@ -535,7 +538,7 @@ governorValidator =
|
|||
# pconstant ""
|
||||
# plam (pscriptHashToTokenName . pfromData)
|
||||
# effect.scriptHash
|
||||
gatAssetClass = passetClass # atSymbol # tagToken
|
||||
gatAssetClass = passetClass # puntag atSymbol # tagToken
|
||||
valueGATCorrect =
|
||||
passetClassValueOf
|
||||
# gatAssetClass
|
||||
|
|
|
|||
|
|
@ -3,10 +3,11 @@
|
|||
module Agora.Linker (linker, AgoraScriptInfo (..)) where
|
||||
|
||||
import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners))
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, StakeSTTag)
|
||||
import Agora.Utils (validatorHashToAddress)
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.Map (fromList)
|
||||
import Data.Tagged (untag)
|
||||
import Data.Tagged (Tagged (Tagged))
|
||||
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash)
|
||||
import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
|
||||
import Plutarch.Extra.ScriptContext (validatorHashToTokenName)
|
||||
|
|
@ -31,10 +32,10 @@ import Prelude hiding ((#))
|
|||
@since 1.0.0
|
||||
-}
|
||||
data AgoraScriptInfo = AgoraScriptInfo
|
||||
{ governorAssetClass :: AssetClass
|
||||
, authorityTokenSymbol :: CurrencySymbol
|
||||
, proposalAssetClass :: AssetClass
|
||||
, stakeAssetClass :: AssetClass
|
||||
{ governorAssetClass :: Tagged GovernorSTTag AssetClass
|
||||
, authorityTokenSymbol :: Tagged AuthorityTokenTag CurrencySymbol
|
||||
, proposalAssetClass :: Tagged ProposalSTTag AssetClass
|
||||
, stakeAssetClass :: Tagged StakeSTTag AssetClass
|
||||
, governor :: Governor
|
||||
}
|
||||
deriving stock (Generic, Show)
|
||||
|
|
@ -46,17 +47,72 @@ data AgoraScriptInfo = AgoraScriptInfo
|
|||
-}
|
||||
linker :: Linker Governor (ScriptExport AgoraScriptInfo)
|
||||
linker = do
|
||||
govPol <- fetchTS @MintingPolicyRole @'[TxOutRef] "agora:governorPolicy"
|
||||
govVal <- fetchTS @ValidatorRole @'[Address, AssetClass, CurrencySymbol, CurrencySymbol, CurrencySymbol] "agora:governorValidator"
|
||||
stkPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:stakePolicy"
|
||||
stkVal <- fetchTS @ValidatorRole @'[CurrencySymbol, AssetClass, AssetClass] "agora:stakeValidator"
|
||||
prpPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:proposalPolicy"
|
||||
prpVal <- fetchTS @ValidatorRole @'[AssetClass, CurrencySymbol, CurrencySymbol, Integer] "agora:proposalValidator"
|
||||
treVal <- fetchTS @ValidatorRole @'[CurrencySymbol] "agora:treasuryValidator"
|
||||
atkPol <- fetchTS @MintingPolicyRole @'[AssetClass] "agora:authorityTokenPolicy"
|
||||
noOpVal <- fetchTS @ValidatorRole @'[CurrencySymbol] "agora:noOpValidator"
|
||||
treaWithdrawalVal <- fetchTS @ValidatorRole @'[CurrencySymbol] "agora:treasuryWithdrawalValidator"
|
||||
mutateGovVal <- fetchTS @ValidatorRole @'[ValidatorHash, CurrencySymbol, CurrencySymbol] "agora:mutateGovernorValidator"
|
||||
govPol <-
|
||||
fetchTS
|
||||
@MintingPolicyRole
|
||||
@'[TxOutRef]
|
||||
"agora:governorPolicy"
|
||||
govVal <-
|
||||
fetchTS
|
||||
@ValidatorRole
|
||||
@'[ Address
|
||||
, Tagged StakeSTTag AssetClass
|
||||
, 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
|
||||
|
||||
|
|
@ -64,10 +120,10 @@ linker = do
|
|||
govVal' =
|
||||
govVal
|
||||
# propValAddress
|
||||
# sstAssetClass
|
||||
# gstSymbol
|
||||
# pstSymbol
|
||||
# atSymbol
|
||||
# Tagged sstAssetClass
|
||||
# Tagged gstSymbol
|
||||
# Tagged pstSymbol
|
||||
# Tagged atSymbol
|
||||
gstSymbol =
|
||||
mintingPolicySymbol $
|
||||
toMintingPolicy
|
||||
|
|
@ -76,34 +132,41 @@ linker = do
|
|||
AssetClass gstSymbol ""
|
||||
govValHash = validatorHash $ toValidator govVal'
|
||||
|
||||
at = gstAssetClass
|
||||
atPol' = atkPol # at
|
||||
atPol' = atkPol # Tagged gstAssetClass
|
||||
atSymbol = mintingPolicySymbol $ toMintingPolicy atPol'
|
||||
|
||||
propPol' = prpPol # gstAssetClass
|
||||
propPol' = prpPol # Tagged gstAssetClass
|
||||
propVal' =
|
||||
prpVal
|
||||
# sstAssetClass
|
||||
# gstSymbol
|
||||
# pstSymbol
|
||||
# Tagged sstAssetClass
|
||||
# Tagged gstSymbol
|
||||
# Tagged pstSymbol
|
||||
# governor.maximumCosigners
|
||||
propValAddress =
|
||||
validatorHashToAddress $ validatorHash $ toValidator propVal'
|
||||
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol'
|
||||
pstAssetClass = AssetClass pstSymbol ""
|
||||
|
||||
stakPol' = stkPol # untag governor.gtClassRef
|
||||
stakVal' = stkVal # sstSymbol # pstAssetClass # untag governor.gtClassRef
|
||||
stakPol' = stkPol # governor.gtClassRef
|
||||
stakVal' =
|
||||
stkVal
|
||||
# Tagged sstSymbol
|
||||
# Tagged pstAssetClass
|
||||
# governor.gtClassRef
|
||||
sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol'
|
||||
stakValTokenName =
|
||||
validatorHashToTokenName $ validatorHash $ toValidator stakVal'
|
||||
sstAssetClass = AssetClass sstSymbol stakValTokenName
|
||||
|
||||
treaVal' = treVal # atSymbol
|
||||
treaVal' = treVal # Tagged atSymbol
|
||||
|
||||
noOpVal' = noOpVal # atSymbol
|
||||
treaWithdrawalVal' = treaWithdrawalVal # atSymbol
|
||||
mutateGovVal' = mutateGovVal # govValHash # gstSymbol # atSymbol
|
||||
noOpVal' = noOpVal # Tagged atSymbol
|
||||
treaWithdrawalVal' = treaWithdrawalVal # Tagged atSymbol
|
||||
mutateGovVal' =
|
||||
mutateGovVal
|
||||
# govValHash
|
||||
# Tagged gstSymbol
|
||||
# Tagged atSymbol
|
||||
|
||||
return $
|
||||
ScriptExport
|
||||
|
|
@ -123,10 +186,10 @@ linker = do
|
|||
]
|
||||
, information =
|
||||
AgoraScriptInfo
|
||||
{ governorAssetClass = gstAssetClass
|
||||
, authorityTokenSymbol = atSymbol
|
||||
, proposalAssetClass = pstAssetClass
|
||||
, stakeAssetClass = sstAssetClass
|
||||
{ governorAssetClass = Tagged gstAssetClass
|
||||
, authorityTokenSymbol = Tagged atSymbol
|
||||
, proposalAssetClass = Tagged pstAssetClass
|
||||
, stakeAssetClass = Tagged sstAssetClass
|
||||
, governor = governor
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,10 +6,14 @@ import Plutarch.Lift (PConstantDecl (..), PUnsafeLiftDecl (PLifted))
|
|||
|
||||
import Data.Bifunctor (Bifunctor (bimap))
|
||||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Tagged (Tagged (Tagged))
|
||||
import Data.Traversable (for)
|
||||
import Plutarch.Api.V1 (KeyGuarantees (Sorted), PMap)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import PlutusTx qualified
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Ply (PlyArg)
|
||||
import Ply.Plutarch.Class (PlyArgOf)
|
||||
|
||||
-- | @since 1.0.0
|
||||
instance
|
||||
|
|
@ -74,3 +78,9 @@ instance
|
|||
isSorted [] = True
|
||||
isSorted [_] = True
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ import Agora.Proposal.Time (
|
|||
pgetRelation,
|
||||
pisWithin,
|
||||
)
|
||||
import Agora.SafeMoney (GovernorSTTag, ProposalSTTag, StakeSTTag)
|
||||
import Agora.Stake (
|
||||
PStakeDatum,
|
||||
pextractVoteOption,
|
||||
|
|
@ -35,6 +36,7 @@ import Agora.Stake (
|
|||
pisVoter,
|
||||
presolveStakeInputDatum,
|
||||
)
|
||||
import Agora.Utils (psymbolValueOfT, ptoScottEncodingT)
|
||||
import Plutarch.Api.V1 (PCredential, PCurrencySymbol)
|
||||
import Plutarch.Api.V1.AssocMap (plookup)
|
||||
import Plutarch.Api.V2 (
|
||||
|
|
@ -45,7 +47,6 @@ import Plutarch.Api.V2 (
|
|||
)
|
||||
import Plutarch.Extra.AssetClass (
|
||||
PAssetClassData,
|
||||
ptoScottEncoding,
|
||||
)
|
||||
import Plutarch.Extra.Category (PCategory (pidentity))
|
||||
import Plutarch.Extra.Field (pletAll, pletAllC)
|
||||
|
|
@ -72,6 +73,7 @@ import Plutarch.Extra.ScriptContext (
|
|||
ptryFromRedeemer,
|
||||
)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
||||
pguardC,
|
||||
pletC,
|
||||
|
|
@ -80,7 +82,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
ptryFromC,
|
||||
)
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Extra.Value (passetClassValueOf, psymbolValueOf)
|
||||
import Plutarch.Extra.Value (passetClassValueOfT, psymbolValueOf)
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
|
||||
{- | Policy for Proposals.
|
||||
|
|
@ -108,7 +110,7 @@ import Plutarch.Unsafe (punsafeCoerce)
|
|||
|
||||
@since 1.0.0
|
||||
-}
|
||||
proposalPolicy :: ClosedTerm (PAssetClassData :--> PMintingPolicy)
|
||||
proposalPolicy :: ClosedTerm (PTagged GovernorSTTag PAssetClassData :--> PMintingPolicy)
|
||||
proposalPolicy =
|
||||
plam $ \gstAssetClass _redeemer ctx -> unTermCont $ do
|
||||
ctxF <- pletAllC ctx
|
||||
|
|
@ -132,8 +134,8 @@ proposalPolicy =
|
|||
( flip pletAll $ \inputF ->
|
||||
let value = pfield @"value" # inputF.resolved
|
||||
isGovernorInput =
|
||||
passetClassValueOf
|
||||
# (ptoScottEncoding # gstAssetClass)
|
||||
passetClassValueOfT
|
||||
# (ptoScottEncodingT # gstAssetClass)
|
||||
# value
|
||||
#== 1
|
||||
in pif
|
||||
|
|
@ -238,9 +240,9 @@ instance DerivePlutusType PStakeInputsContext where
|
|||
-}
|
||||
proposalValidator ::
|
||||
ClosedTerm
|
||||
( PAssetClassData
|
||||
:--> PCurrencySymbol
|
||||
:--> PCurrencySymbol
|
||||
( PTagged StakeSTTag PAssetClassData
|
||||
:--> PTagged GovernorSTTag PCurrencySymbol
|
||||
:--> PTagged ProposalSTTag PCurrencySymbol
|
||||
:--> PInteger
|
||||
:--> PValidator
|
||||
)
|
||||
|
|
@ -301,7 +303,7 @@ proposalValidator =
|
|||
[ ptraceIfFalse "Own by proposal validator" $
|
||||
outputF.address #== proposalInputF.address
|
||||
, ptraceIfFalse "Has proposal ST" $
|
||||
psymbolValueOf # pstSymbol # outputF.value #== 1
|
||||
psymbolValueOfT # pstSymbol # outputF.value #== 1
|
||||
]
|
||||
|
||||
handleProposalUTxO =
|
||||
|
|
@ -341,7 +343,7 @@ proposalValidator =
|
|||
resolveStakeInputDatum <-
|
||||
pletC $
|
||||
presolveStakeInputDatum
|
||||
# (ptoScottEncoding # sstClass)
|
||||
# (ptoScottEncodingT # sstClass)
|
||||
# txInfoF.datums
|
||||
spendStakes' :: Term _ ((PStakeInputsContext :--> PUnit) :--> PUnit) <-
|
||||
pletC $
|
||||
|
|
@ -727,7 +729,7 @@ proposalValidator =
|
|||
. (pfield @"resolved" #) ->
|
||||
value
|
||||
) ->
|
||||
psymbolValueOf # gstSymbol # value #== 1
|
||||
psymbolValueOfT # gstSymbol # value #== 1
|
||||
)
|
||||
# pfromData txInfoF.inputs
|
||||
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ import Agora.Proposal (
|
|||
ProposalId,
|
||||
ResultTag,
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.SafeMoney (GTTag, StakeSTTag)
|
||||
import Data.Tagged (Tagged)
|
||||
import Generics.SOP qualified as SOP
|
||||
import Plutarch.Api.V1 (PCredential)
|
||||
|
|
@ -79,7 +79,7 @@ import Plutarch.Extra.ScriptContext (ptryFromOutputDatum)
|
|||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Extra.Value (passetClassValueOf)
|
||||
import Plutarch.Extra.Value (passetClassValueOfT)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
|
||||
import Plutarch.Orphans ()
|
||||
import PlutusLedgerApi.V2 (Credential)
|
||||
|
|
@ -715,7 +715,7 @@ presolveStakeInputDatum ::
|
|||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
( PAssetClass
|
||||
( PTagged StakeSTTag PAssetClass
|
||||
:--> PMap 'Unsorted PDatumHash PDatum
|
||||
:--> PTxInInfo
|
||||
:--> PMaybe PStakeDatum
|
||||
|
|
@ -726,7 +726,7 @@ presolveStakeInputDatum = phoistAcyclic $
|
|||
(pletFields @'["value", "datum", "address"])
|
||||
( \txOutF ->
|
||||
let isStakeUTxO =
|
||||
passetClassValueOf
|
||||
passetClassValueOfT
|
||||
# sstClass
|
||||
# txOutF.value
|
||||
#== 1
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ module Agora.Stake.Scripts (
|
|||
|
||||
import Agora.Credential (authorizationContext, pauthorizedBy)
|
||||
import Agora.Proposal (PProposalDatum, PProposalRedeemer)
|
||||
import Agora.SafeMoney (GTTag, ProposalSTTag, StakeSTTag)
|
||||
import Agora.Stake (
|
||||
PProposalContext (
|
||||
PNewProposal,
|
||||
|
|
@ -52,7 +53,7 @@ import Agora.Stake.Redeemers (
|
|||
ppermitVote,
|
||||
pretractVote,
|
||||
)
|
||||
import Agora.Utils (pisDNothing)
|
||||
import Agora.Utils (pisDNothing, ptoScottEncodingT, puntag)
|
||||
import Plutarch.Api.V1 (
|
||||
PCredential (PPubKeyCredential, PScriptCredential),
|
||||
PCurrencySymbol,
|
||||
|
|
@ -71,7 +72,6 @@ import Plutarch.Extra.AssetClass (
|
|||
PAssetClass,
|
||||
PAssetClassData,
|
||||
passetClass,
|
||||
ptoScottEncoding,
|
||||
)
|
||||
import Plutarch.Extra.Bool (passert)
|
||||
import Plutarch.Extra.Field (pletAll, pletAllC)
|
||||
|
|
@ -92,6 +92,7 @@ import Plutarch.Extra.ScriptContext (
|
|||
pvalidatorHashToTokenName,
|
||||
pvalueSpent,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
||||
pguardC,
|
||||
pletC,
|
||||
|
|
@ -101,6 +102,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
)
|
||||
import Plutarch.Extra.Value (
|
||||
passetClassValueOf,
|
||||
passetClassValueOfT,
|
||||
psymbolValueOf,
|
||||
psymbolValueOf',
|
||||
)
|
||||
|
|
@ -128,15 +130,14 @@ import Prelude hiding (Num ((+)))
|
|||
== Arguments
|
||||
|
||||
Following arguments should be provided(in this order):
|
||||
1. governor ST assetclass
|
||||
1. governance token assetclass
|
||||
|
||||
@since 1.0.0
|
||||
-}
|
||||
stakePolicy ::
|
||||
-- | The (governance) token that a Stake can store.
|
||||
ClosedTerm (PAssetClassData :--> PMintingPolicy)
|
||||
ClosedTerm (PTagged GTTag PAssetClassData :--> PMintingPolicy)
|
||||
stakePolicy =
|
||||
plam $ \gstClass _redeemer ctx' -> unTermCont $ do
|
||||
plam $ \gtClass _redeemer ctx' -> unTermCont $ do
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
txInfo <- pletC $ ctx.txInfo
|
||||
let _a :: Term _ PTxInfo
|
||||
|
|
@ -202,10 +203,10 @@ stakePolicy =
|
|||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Stake ouput has expected amount of stake token" $
|
||||
passetClassValueOf
|
||||
# (ptoScottEncoding # gstClass)
|
||||
passetClassValueOfT
|
||||
# (ptoScottEncodingT # gtClass)
|
||||
# outputF.value
|
||||
#== pto (pfromData datumF.stakedAmount)
|
||||
#== (pfromData datumF.stakedAmount)
|
||||
, ptraceIfFalse "Stake Owner should sign the transaction" $
|
||||
pauthorizedBy
|
||||
# authorizationContext txInfoF
|
||||
|
|
@ -229,17 +230,17 @@ stakePolicy =
|
|||
Following arguments should be provided(in this order):
|
||||
1. stake ST symbol
|
||||
2. proposal ST assetclass
|
||||
3. governor ST assetclass
|
||||
3. governance token assetclass
|
||||
|
||||
@since 1.0.0
|
||||
-}
|
||||
mkStakeValidator ::
|
||||
StakeRedeemerImpl s ->
|
||||
Term s PCurrencySymbol ->
|
||||
Term s PAssetClass ->
|
||||
Term s PAssetClass ->
|
||||
Term s (PTagged StakeSTTag PCurrencySymbol) ->
|
||||
Term s (PTagged ProposalSTTag PAssetClass) ->
|
||||
Term s (PTagged GTTag PAssetClass) ->
|
||||
Term s PValidator
|
||||
mkStakeValidator impl sstSymbol pstClass gstClass =
|
||||
mkStakeValidator impl sstSymbol pstClass gtClass =
|
||||
plam $ \_datum redeemer ctx -> unTermCont $ do
|
||||
ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
|
||||
txInfo <- pletC $ pfromData ctxF.txInfo
|
||||
|
|
@ -280,7 +281,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
PScriptCredential r -> pfield @"_0" # r
|
||||
_ -> perror
|
||||
|
||||
sstClass <- pletC $ passetClass # sstSymbol # sstName
|
||||
sstClass <- pletC $ passetClass # puntag sstSymbol # sstName
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -405,13 +406,12 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
( \output ->
|
||||
let validateGT = plam $ \stakeDatum ->
|
||||
let expected =
|
||||
pto $
|
||||
pfromData $
|
||||
pfield @"stakedAmount" # stakeDatum
|
||||
pfromData $
|
||||
pfield @"stakedAmount" # stakeDatum
|
||||
|
||||
actual =
|
||||
passetClassValueOf
|
||||
# gstClass
|
||||
passetClassValueOfT
|
||||
# gtClass
|
||||
# (pfield @"value" # output)
|
||||
in pif
|
||||
(expected #== actual)
|
||||
|
|
@ -431,10 +431,11 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
plam $
|
||||
flip pletAll $ \txOutF ->
|
||||
let isProposalUTxO =
|
||||
passetClassValueOf
|
||||
passetClassValueOfT
|
||||
# pstClass
|
||||
# txOutF.value
|
||||
#== 1
|
||||
|
||||
proposalDatum =
|
||||
pfromData $
|
||||
ptryFromOutputDatum @(PAsData PProposalDatum)
|
||||
|
|
@ -443,7 +444,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
in pif isProposalUTxO (pjust # proposalDatum) pnothing
|
||||
|
||||
let pstMinted =
|
||||
passetClassValueOf # pstClass # txInfoF.mint #== 1
|
||||
passetClassValueOfT # pstClass # txInfoF.mint #== 1
|
||||
|
||||
newProposalContext =
|
||||
pcon $
|
||||
|
|
@ -596,15 +597,15 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
Following arguments should be provided(in this order):
|
||||
1. stake ST symbol
|
||||
2. proposal ST assetclass
|
||||
3. governor ST assetclass
|
||||
3. governance token assetclass
|
||||
|
||||
@since 1.0.0
|
||||
-}
|
||||
stakeValidator ::
|
||||
ClosedTerm
|
||||
( PCurrencySymbol
|
||||
:--> PAssetClassData
|
||||
:--> PAssetClassData
|
||||
( PTagged StakeSTTag PCurrencySymbol
|
||||
:--> PTagged ProposalSTTag PAssetClassData
|
||||
:--> PTagged GTTag PAssetClassData
|
||||
:--> PValidator
|
||||
)
|
||||
stakeValidator =
|
||||
|
|
@ -620,5 +621,5 @@ stakeValidator =
|
|||
}
|
||||
)
|
||||
sstSymbol
|
||||
(ptoScottEncoding # pstClass)
|
||||
(ptoScottEncoding # gstClass)
|
||||
(ptoScottEncodingT # pstClass)
|
||||
(ptoScottEncodingT # gstClass)
|
||||
|
|
|
|||
|
|
@ -13,8 +13,10 @@ module Agora.Treasury (
|
|||
) where
|
||||
|
||||
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
||||
import Agora.SafeMoney (AuthorityTokenTag)
|
||||
import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
|
||||
import Plutarch.Api.V2 (PScriptPurpose (PSpending), PValidator)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
|
||||
|
||||
{- | 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
|
||||
-}
|
||||
treasuryValidator ::
|
||||
ClosedTerm (PCurrencySymbol :--> PValidator)
|
||||
ClosedTerm (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
|
||||
treasuryValidator = plam $ \atSymbol _ _ ctx' -> unTermCont $ do
|
||||
-- plet required fields from script context.
|
||||
ctx <- pletFieldsC @["txInfo", "purpose"] ctx'
|
||||
|
|
|
|||
|
|
@ -13,11 +13,23 @@ module Agora.Utils (
|
|||
punwords,
|
||||
pisNothing,
|
||||
pisDNothing,
|
||||
ptoScottEncodingT,
|
||||
psymbolValueOfT,
|
||||
ptag,
|
||||
puntag,
|
||||
) where
|
||||
|
||||
import Plutarch.Api.V2 (
|
||||
AmountGuarantees,
|
||||
KeyGuarantees,
|
||||
PCurrencySymbol,
|
||||
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 (
|
||||
Address (Address),
|
||||
Credential (ScriptCredential),
|
||||
|
|
@ -67,3 +79,36 @@ pisDNothing = phoistAcyclic $
|
|||
flip pmatch $ \case
|
||||
PDNothing _ -> pconstant True
|
||||
_ -> 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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue