156 lines
5.4 KiB
Haskell
156 lines
5.4 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
{- | Module : Main
|
|
Maintainer : emi@haskell.fyi
|
|
Description: Export scripts given configuration.
|
|
|
|
Export scripts given configuration.
|
|
-}
|
|
module Main (main) where
|
|
|
|
import Agora.AuthorityToken (AuthorityToken, authorityTokenPolicy)
|
|
import Agora.Governor (Governor (Governor))
|
|
import Agora.Governor qualified as Governor
|
|
import Agora.Governor.Scripts (authorityTokenFromGovernor, authorityTokenSymbolFromGovernor, governorPolicy, governorValidator, proposalFromGovernor, stakeFromGovernor)
|
|
import Agora.Proposal (Proposal)
|
|
import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
|
|
import Agora.SafeMoney (GTTag)
|
|
import Agora.Stake (Stake)
|
|
import Agora.Stake.Scripts (stakePolicy, stakeValidator)
|
|
import Agora.Treasury (treasuryValidator)
|
|
import Data.Aeson qualified as Aeson
|
|
import Data.Default (def)
|
|
import Data.Function ((&))
|
|
import Data.Tagged (Tagged)
|
|
import Data.Text (Text)
|
|
import Development.GitRev (gitBranch, gitHash)
|
|
import GHC.Generics qualified as GHC
|
|
import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy)
|
|
import PlutusLedgerApi.V1 (TxOutRef)
|
|
import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol)
|
|
import PlutusLedgerApi.V1.Value qualified as Value
|
|
import ScriptExport.API (runServer)
|
|
import ScriptExport.Options (parseOptions)
|
|
import ScriptExport.ScriptInfo (ScriptInfo, mkPolicyInfo, mkValidatorInfo)
|
|
import ScriptExport.Types (Builders, insertBuilder)
|
|
|
|
main :: IO ()
|
|
main =
|
|
parseOptions >>= runServer revision builders
|
|
where
|
|
-- This encodes the git revision of the server. It's useful for the caller
|
|
-- to be able to ensure they are compatible with it.
|
|
revision :: Text
|
|
revision = $(gitBranch) <> "@" <> $(gitHash)
|
|
|
|
{- | Builders for Agora scripts.
|
|
|
|
@since 0.2.0
|
|
-}
|
|
builders :: Builders
|
|
builders =
|
|
def
|
|
-- Agora scripts
|
|
& insertBuilder "governorPolicy" ((.governorPolicyInfo) . agoraScripts)
|
|
& insertBuilder "governorValidator" ((.governorValidatorInfo) . agoraScripts)
|
|
& insertBuilder "stakePolicy" ((.stakePolicyInfo) . agoraScripts)
|
|
& insertBuilder "stakeValidator" ((.stakeValidatorInfo) . agoraScripts)
|
|
& insertBuilder "proposalPolicy" ((.proposalPolicyInfo) . agoraScripts)
|
|
& insertBuilder "proposalValidator" ((.proposalValidatorInfo) . agoraScripts)
|
|
& insertBuilder "treasuryValidator" ((.treasuryValidatorInfo) . agoraScripts)
|
|
& insertBuilder "authorityTokenPolicy" ((.authorityTokenPolicyInfo) . agoraScripts)
|
|
|
|
-- Trivial scripts. These are useful for testing, but they likely aren't useful
|
|
-- to you if you are actually interested in deploying to mainnet.
|
|
& insertBuilder "alwaysSucceedsPolicy"
|
|
(\() -> mkPolicyInfo $ plam $ \_ _ -> popaque (pconstant ()) )
|
|
& insertBuilder "alwaysSucceedsValidator"
|
|
(\() -> mkValidatorInfo $ plam $ \_ _ _ -> popaque (pconstant ()) )
|
|
& insertBuilder "neverSucceedsPolicy"
|
|
(\() -> mkPolicyInfo $ plam $ \_ _ -> perror )
|
|
& insertBuilder "neverSucceedsValidator"
|
|
(\() -> mkValidatorInfo $ plam $ \_ _ _ -> perror )
|
|
|
|
{- | Create scripts from params.
|
|
|
|
@since 0.2.0
|
|
-}
|
|
agoraScripts :: ScriptParams -> AgoraScripts
|
|
agoraScripts params =
|
|
AgoraScripts
|
|
{ governorPolicyInfo = mkPolicyInfo (governorPolicy governor)
|
|
, governorValidatorInfo = mkValidatorInfo (governorValidator governor)
|
|
, stakePolicyInfo = mkPolicyInfo (stakePolicy params.gtClassRef)
|
|
, stakeValidatorInfo = mkValidatorInfo (stakeValidator stake)
|
|
, proposalPolicyInfo = mkPolicyInfo (proposalPolicy governorSTAssetClass)
|
|
, proposalValidatorInfo = mkValidatorInfo (proposalValidator proposal)
|
|
, treasuryValidatorInfo = mkValidatorInfo (treasuryValidator authorityTokenSymbol)
|
|
, authorityTokenPolicyInfo = mkPolicyInfo (authorityTokenPolicy authorityToken)
|
|
}
|
|
where
|
|
governor :: Governor
|
|
governor =
|
|
Governor
|
|
{ Governor.gstOutRef = params.governorInitialSpend
|
|
, Governor.gtClassRef = params.gtClassRef
|
|
, Governor.maximumCosigners = params.maximumCosigners
|
|
}
|
|
|
|
authorityToken :: AuthorityToken
|
|
authorityToken = authorityTokenFromGovernor governor
|
|
|
|
authorityTokenSymbol :: CurrencySymbol
|
|
authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
|
|
|
|
governorSTAssetClass :: AssetClass
|
|
governorSTAssetClass =
|
|
Value.assetClass (mintingPolicySymbol $ mkMintingPolicy $ governorPolicy governor) ""
|
|
|
|
proposal :: Proposal
|
|
proposal = proposalFromGovernor governor
|
|
|
|
stake :: Stake
|
|
stake = stakeFromGovernor governor
|
|
|
|
{- | Params required for creating script export.
|
|
|
|
@since 0.2.0
|
|
-}
|
|
data ScriptParams where
|
|
ScriptParams ::
|
|
{ governorInitialSpend :: TxOutRef
|
|
, gtClassRef :: Tagged GTTag AssetClass
|
|
, maximumCosigners :: Integer
|
|
} ->
|
|
ScriptParams
|
|
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
|
|
deriving stock (Show, Eq, GHC.Generic, Ord)
|
|
|
|
{- | Scripts that get exported.
|
|
|
|
@since 0.2.0
|
|
-}
|
|
data AgoraScripts = AgoraScripts
|
|
{ governorPolicyInfo :: ScriptInfo
|
|
, governorValidatorInfo :: ScriptInfo
|
|
, stakePolicyInfo :: ScriptInfo
|
|
, stakeValidatorInfo :: ScriptInfo
|
|
, proposalPolicyInfo :: ScriptInfo
|
|
, proposalValidatorInfo :: ScriptInfo
|
|
, treasuryValidatorInfo :: ScriptInfo
|
|
, authorityTokenPolicyInfo :: ScriptInfo
|
|
}
|
|
deriving anyclass
|
|
( -- | @since 0.2.0
|
|
Aeson.ToJSON
|
|
, -- | @since 0.2.0
|
|
Aeson.FromJSON
|
|
)
|
|
deriving stock
|
|
( -- | @since 0.2.0
|
|
Show
|
|
, -- | @since 0.2.0
|
|
Eq
|
|
, -- | @since 0.2.0
|
|
GHC.Generic
|
|
)
|