192 lines
5.9 KiB
Haskell
192 lines
5.9 KiB
Haskell
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
|
|
|
|
module Agora.Linker (linker, AgoraScriptInfo (..)) where
|
|
|
|
import Agora.Governor (Governor (gstOutRef, gtClassRef, maximumCosigners))
|
|
import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, StakeSTTag)
|
|
import Data.Aeson qualified as Aeson
|
|
import Data.Map (fromList)
|
|
import Data.Tagged (Tagged (Tagged))
|
|
import Plutarch.Api.V1 (scriptHash)
|
|
import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
|
|
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
|
|
import PlutusLedgerApi.V1 (CurrencySymbol (CurrencySymbol), ScriptHash, TxOutRef, getScriptHash)
|
|
import Ply (
|
|
ScriptRole (MintingPolicyRole, ValidatorRole),
|
|
(#),
|
|
)
|
|
import ScriptExport.ScriptInfo (
|
|
Linker,
|
|
ScriptExport (..),
|
|
fetchTS,
|
|
getParam,
|
|
toRoledScript,
|
|
toScript,
|
|
)
|
|
import Prelude hiding ((#))
|
|
|
|
{- | Additional information provided after linking.
|
|
|
|
@since 1.0.0
|
|
-}
|
|
data AgoraScriptInfo = AgoraScriptInfo
|
|
{ governorAssetClass :: Tagged GovernorSTTag AssetClass
|
|
, authorityTokenSymbol :: Tagged AuthorityTokenTag CurrencySymbol
|
|
, proposalAssetClass :: Tagged ProposalSTTag AssetClass
|
|
, stakeAssetClass :: Tagged StakeSTTag AssetClass
|
|
, governor :: Governor
|
|
}
|
|
deriving stock (Generic, Show)
|
|
deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
|
|
|
|
{- | Links parameterized Agora scripts given parameters.
|
|
|
|
@since 1.0.0
|
|
-}
|
|
linker :: Linker Governor (ScriptExport AgoraScriptInfo)
|
|
linker = do
|
|
govPol <-
|
|
fetchTS
|
|
@MintingPolicyRole
|
|
@'[TxOutRef]
|
|
"agora:governorPolicy"
|
|
govVal <-
|
|
fetchTS
|
|
@ValidatorRole
|
|
@'[ ScriptHash
|
|
, 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
|
|
@'[ ScriptHash
|
|
, Tagged GovernorSTTag CurrencySymbol
|
|
, Tagged AuthorityTokenTag CurrencySymbol
|
|
]
|
|
"agora:mutateGovernorValidator"
|
|
|
|
governor <- getParam
|
|
|
|
let govPol' = govPol # governor.gstOutRef
|
|
govVal' =
|
|
govVal
|
|
# propValHash
|
|
# Tagged sstAssetClass
|
|
# Tagged gstSymbol
|
|
# Tagged pstSymbol
|
|
# Tagged atSymbol
|
|
gstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript govPol'
|
|
gstAssetClass =
|
|
AssetClass gstSymbol ""
|
|
govValHash = scriptHash $ toScript govVal'
|
|
|
|
atPol' = atkPol # Tagged gstAssetClass
|
|
atSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript atPol'
|
|
|
|
propPol' = prpPol # Tagged gstAssetClass
|
|
propVal' =
|
|
prpVal
|
|
# Tagged sstAssetClass
|
|
# Tagged gstSymbol
|
|
# Tagged pstSymbol
|
|
# governor.maximumCosigners
|
|
propValHash = scriptHash $ toScript propVal'
|
|
pstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript propPol'
|
|
pstAssetClass = AssetClass pstSymbol ""
|
|
|
|
stakPol' = stkPol # governor.gtClassRef
|
|
stakVal' =
|
|
stkVal
|
|
# Tagged sstSymbol
|
|
# Tagged pstAssetClass
|
|
# governor.gtClassRef
|
|
sstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript stakPol'
|
|
stakValTokenName =
|
|
scriptHashToTokenName $ scriptHash $ toScript stakVal'
|
|
sstAssetClass = AssetClass sstSymbol stakValTokenName
|
|
|
|
treaVal' = treVal # Tagged atSymbol
|
|
|
|
noOpVal' = noOpVal # Tagged atSymbol
|
|
treaWithdrawalVal' = treaWithdrawalVal # Tagged atSymbol
|
|
mutateGovVal' =
|
|
mutateGovVal
|
|
# govValHash
|
|
# Tagged gstSymbol
|
|
# Tagged atSymbol
|
|
|
|
return $
|
|
ScriptExport
|
|
{ scripts =
|
|
fromList
|
|
[ ("agora:governorPolicy", toRoledScript govPol')
|
|
, ("agora:governorValidator", toRoledScript govVal')
|
|
, ("agora:stakePolicy", toRoledScript stakPol')
|
|
, ("agora:stakeValidator", toRoledScript stakVal')
|
|
, ("agora:proposalPolicy", toRoledScript propPol')
|
|
, ("agora:proposalValidator", toRoledScript propVal')
|
|
, ("agora:treasuryValidator", toRoledScript treaVal')
|
|
, ("agora:authorityTokenPolicy", toRoledScript atPol')
|
|
, ("agora:noOpValidator", toRoledScript noOpVal')
|
|
, ("agora:treasuryWithdrawalValidator", toRoledScript treaWithdrawalVal')
|
|
, ("agora:mutateGovernorValidator", toRoledScript mutateGovVal')
|
|
]
|
|
, information =
|
|
AgoraScriptInfo
|
|
{ governorAssetClass = Tagged gstAssetClass
|
|
, authorityTokenSymbol = Tagged atSymbol
|
|
, proposalAssetClass = Tagged pstAssetClass
|
|
, stakeAssetClass = Tagged sstAssetClass
|
|
, governor = governor
|
|
}
|
|
}
|