init agora-scripts for generating ScriptInfo for CTL
This commit is contained in:
Emily Martins
parent
151e855732
commit
1ba5722409
6 changed files with 353 additions and 12 deletions
45
agora-scripts/Options.hs
Normal file
45
agora-scripts/Options.hs
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
{- |
|
||||
Module : Options
|
||||
Maintainer : emi@haskell.fyi
|
||||
Description: Command line options for 'agora-scripts'.
|
||||
|
||||
Command line options for 'agora-scripts'.
|
||||
-}
|
||||
module Options (Options (..), parseOptions) where
|
||||
|
||||
import Options.Applicative ((<**>))
|
||||
import Options.Applicative qualified as Opt
|
||||
|
||||
data Options = Options
|
||||
{ config :: FilePath
|
||||
, output :: FilePath
|
||||
}
|
||||
deriving stock (Show, Eq)
|
||||
|
||||
opt :: Opt.Parser Options
|
||||
opt =
|
||||
Options
|
||||
<$> Opt.strOption
|
||||
( Opt.long "config"
|
||||
<> Opt.short 'c'
|
||||
<> Opt.metavar "CONFIG_PATH"
|
||||
<> Opt.value "./"
|
||||
<> Opt.help "The path where the script configuration is."
|
||||
)
|
||||
<*> Opt.strOption
|
||||
( Opt.long "output"
|
||||
<> Opt.short 'o'
|
||||
<> Opt.metavar "OUTPUT_PATH"
|
||||
<> Opt.value "./"
|
||||
<> Opt.help "Output where generated scripts will be."
|
||||
)
|
||||
|
||||
parseOptions :: IO Options
|
||||
parseOptions = Opt.execParser p
|
||||
where
|
||||
p =
|
||||
Opt.info
|
||||
(opt <**> Opt.helper)
|
||||
( Opt.fullDesc
|
||||
<> Opt.progDesc "Generate Agora scripts for off-chain use."
|
||||
)
|
||||
66
agora-scripts/Scripts.hs
Normal file
66
agora-scripts/Scripts.hs
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
{- |
|
||||
Module : Scripts
|
||||
Maintainer : emi@haskell.fyi
|
||||
Description: Export scripts given configuration.
|
||||
|
||||
Export scripts given configuration.
|
||||
-}
|
||||
module Scripts (main) where
|
||||
|
||||
import Agora.Governor (Governor (Governor))
|
||||
import Agora.Governor qualified as Governor
|
||||
import Agora.Governor.Scripts (governorPolicy)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.ScriptInfo (PolicyInfo, mkPolicyInfo)
|
||||
import Control.Monad ((>=>))
|
||||
import Data.Aeson qualified as Aeson
|
||||
import GHC.Generics qualified as GHC
|
||||
import Options (Options (..), parseOptions)
|
||||
import Plutarch.SafeMoney (Tagged)
|
||||
import Plutus.V1.Ledger.Api (TxOutRef)
|
||||
import Plutus.V1.Ledger.Value (AssetClass)
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
data ScriptsConfig = ScriptsConfig
|
||||
{ governorInitialSpend :: TxOutRef
|
||||
, gtClassRef :: Tagged GTTag AssetClass
|
||||
, maximumCosigners :: Integer
|
||||
}
|
||||
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
|
||||
deriving stock (Show, Eq, GHC.Generic)
|
||||
|
||||
data AgoraScripts = AgoraScripts
|
||||
{ governorPolicyInfo :: PolicyInfo
|
||||
}
|
||||
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
|
||||
deriving stock (Show, Eq, GHC.Generic)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Hello, world!"
|
||||
|
||||
options <- parseOptions
|
||||
|
||||
params <-
|
||||
Aeson.eitherDecodeFileStrict @ScriptsConfig options.config
|
||||
>>= either (putStrLn >=> const exitFailure) pure
|
||||
|
||||
let scripts = agoraScripts params
|
||||
|
||||
print params
|
||||
print scripts
|
||||
|
||||
pure ()
|
||||
|
||||
agoraScripts :: ScriptsConfig -> AgoraScripts
|
||||
agoraScripts config =
|
||||
AgoraScripts
|
||||
{ governorPolicyInfo = mkPolicyInfo (governorPolicy governor)
|
||||
}
|
||||
where
|
||||
governor =
|
||||
Governor
|
||||
{ Governor.gstOutRef = config.governorInitialSpend
|
||||
, Governor.gtClassRef = config.gtClassRef
|
||||
, Governor.maximumCosigners = config.maximumCosigners
|
||||
}
|
||||
35
agora.cabal
35
agora.cabal
|
|
@ -146,18 +146,21 @@ library
|
|||
Agora.Utils
|
||||
Agora.Utils.Value
|
||||
|
||||
Agora.ScriptInfo
|
||||
Agora.Aeson.Orphans
|
||||
|
||||
other-modules:
|
||||
hs-source-dirs: agora
|
||||
|
||||
library pprelude
|
||||
default-language: Haskell2010
|
||||
exposed-modules: PPrelude
|
||||
hs-source-dirs: agora
|
||||
|
||||
build-depends:
|
||||
, base
|
||||
, plutarch
|
||||
|
||||
exposed-modules: PPrelude
|
||||
hs-source-dirs: agora
|
||||
default-language: Haskell2010
|
||||
|
||||
library agora-testlib
|
||||
import: lang, deps, test-deps
|
||||
exposed-modules: Test.Util
|
||||
|
|
@ -165,7 +168,6 @@ library agora-testlib
|
|||
|
||||
library agora-sample
|
||||
import: lang, deps, test-deps
|
||||
build-depends: agora-testlib
|
||||
exposed-modules:
|
||||
Sample.Effect.TreasuryWithdrawal
|
||||
Sample.Governor
|
||||
|
|
@ -173,9 +175,10 @@ library agora-sample
|
|||
Sample.Shared
|
||||
Sample.Stake
|
||||
Sample.Treasury
|
||||
|
||||
hs-source-dirs: agora-sample
|
||||
|
||||
build-depends: agora-testlib
|
||||
|
||||
test-suite agora-test
|
||||
import: lang, deps, test-deps
|
||||
type: exitcode-stdio-1.0
|
||||
|
|
@ -205,16 +208,26 @@ benchmark agora-bench
|
|||
, agora
|
||||
, agora-sample
|
||||
|
||||
executable agora-scripts
|
||||
import: lang, deps, exe-opts
|
||||
main-is: Scripts.hs
|
||||
hs-source-dirs: agora-scripts
|
||||
other-modules:
|
||||
Options
|
||||
build-depends:
|
||||
, agora
|
||||
, optparse-applicative
|
||||
|
||||
executable agora-purescript-bridge
|
||||
import: lang, deps, exe-opts
|
||||
main-is: Bridge.hs
|
||||
hs-source-dirs: agora-purescript-bridge
|
||||
other-modules:
|
||||
AgoraTypes
|
||||
Options
|
||||
|
||||
build-depends:
|
||||
, agora
|
||||
, optparse-applicative
|
||||
, path
|
||||
, purescript-bridge
|
||||
|
||||
hs-source-dirs: agora-purescript-bridge
|
||||
other-modules:
|
||||
AgoraTypes
|
||||
Options
|
||||
|
|
|
|||
146
agora/Agora/Aeson/Orphans.hs
Normal file
146
agora/Agora/Aeson/Orphans.hs
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module Agora.Aeson.Orphans (AsBase16Bytes (..)) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Coerce (Coercible, coerce)
|
||||
import Prelude
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Codec.Serialise qualified as Codec
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.Aeson.Types qualified as Aeson
|
||||
import Data.ByteString.Lazy qualified as Lazy
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.Encoding qualified as T
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutus.V1.Ledger.Api qualified as Plutus
|
||||
import Plutus.V1.Ledger.Bytes qualified as Plutus
|
||||
import Plutus.V1.Ledger.Value qualified as Plutus
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
newtype AsBase16Bytes a = AsBase16Bytes {unAsBase16Bytes :: a}
|
||||
newtype AsBase16Codec a = AsBase16Codec {unAsBase16Codec :: a}
|
||||
|
||||
deriving via
|
||||
(Plutus.CurrencySymbol, Plutus.TokenName)
|
||||
instance
|
||||
Aeson.ToJSON Plutus.AssetClass
|
||||
|
||||
deriving via
|
||||
(Plutus.CurrencySymbol, Plutus.TokenName)
|
||||
instance
|
||||
Aeson.FromJSON Plutus.AssetClass
|
||||
|
||||
deriving via
|
||||
AsBase16Bytes Plutus.TxId
|
||||
instance
|
||||
Aeson.FromJSON Plutus.TxId
|
||||
|
||||
deriving via
|
||||
AsBase16Bytes Plutus.TxId
|
||||
instance
|
||||
Aeson.ToJSON Plutus.TxId
|
||||
|
||||
deriving anyclass instance Aeson.FromJSON Plutus.TxOutRef
|
||||
deriving anyclass instance Aeson.ToJSON Plutus.TxOutRef
|
||||
|
||||
instance (Coercible a Plutus.LedgerBytes) => Aeson.ToJSON (AsBase16Bytes a) where
|
||||
toJSON =
|
||||
Aeson.String
|
||||
. Plutus.encodeByteString
|
||||
. Plutus.bytes
|
||||
. coerce @(AsBase16Bytes a) @Plutus.LedgerBytes
|
||||
|
||||
instance (Coercible Plutus.LedgerBytes a) => Aeson.FromJSON (AsBase16Bytes a) where
|
||||
parseJSON v =
|
||||
Aeson.parseJSON @T.Text v
|
||||
>>= either (Aeson.parserThrowError []) (pure . coerce @_ @(AsBase16Bytes a))
|
||||
. Plutus.fromHex
|
||||
. T.encodeUtf8
|
||||
|
||||
instance (Codec.Serialise a) => Aeson.ToJSON (AsBase16Codec a) where
|
||||
toJSON =
|
||||
Aeson.String
|
||||
. Plutus.encodeByteString
|
||||
. Lazy.toStrict
|
||||
. Codec.serialise @a
|
||||
. (.unAsBase16Codec)
|
||||
|
||||
instance (Codec.Serialise a) => Aeson.FromJSON (AsBase16Codec a) where
|
||||
parseJSON v =
|
||||
Aeson.parseJSON @T.Text v
|
||||
>>= either (Aeson.parserThrowError [] . show) (pure . AsBase16Codec)
|
||||
. Codec.deserialiseOrFail
|
||||
. Lazy.fromStrict
|
||||
. T.encodeUtf8
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
deriving via
|
||||
(AsBase16Bytes Plutus.CurrencySymbol)
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.CurrencySymbol)
|
||||
deriving via
|
||||
(AsBase16Bytes Plutus.CurrencySymbol)
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.CurrencySymbol)
|
||||
|
||||
deriving via
|
||||
(AsBase16Bytes Plutus.TokenName)
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.TokenName)
|
||||
deriving via
|
||||
(AsBase16Bytes Plutus.TokenName)
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.TokenName)
|
||||
|
||||
deriving via
|
||||
(AsBase16Bytes Plutus.ValidatorHash)
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.ValidatorHash)
|
||||
deriving via
|
||||
(AsBase16Bytes Plutus.ValidatorHash)
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.ValidatorHash)
|
||||
|
||||
deriving via
|
||||
(AsBase16Codec Plutus.Validator)
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.Validator)
|
||||
deriving via
|
||||
(AsBase16Codec Plutus.Validator)
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.Validator)
|
||||
|
||||
deriving via
|
||||
(AsBase16Codec Plutus.MintingPolicy)
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.MintingPolicy)
|
||||
deriving via
|
||||
(AsBase16Codec Plutus.MintingPolicy)
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.MintingPolicy)
|
||||
|
||||
deriving via
|
||||
(AsBase16Codec Plutus.Script)
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.Script)
|
||||
deriving via
|
||||
(AsBase16Codec Plutus.Script)
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.Script)
|
||||
|
||||
deriving via
|
||||
Integer
|
||||
instance
|
||||
(Aeson.ToJSON Plutus.POSIXTime)
|
||||
deriving via
|
||||
Integer
|
||||
instance
|
||||
(Aeson.FromJSON Plutus.POSIXTime)
|
||||
|
|
@ -8,6 +8,9 @@ Tags and extras for "Plutarch.SafeMoney".
|
|||
module Agora.SafeMoney (
|
||||
ADATag,
|
||||
GTTag,
|
||||
GovernorSTTag,
|
||||
StakeSTTag,
|
||||
ProposalSTTag,
|
||||
adaRef,
|
||||
) where
|
||||
|
||||
|
|
@ -18,7 +21,7 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
|
|||
import Plutarch.SafeMoney
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Example tags
|
||||
-- Tags
|
||||
|
||||
-- | Governance token.
|
||||
data GTTag
|
||||
|
|
@ -26,6 +29,15 @@ data GTTag
|
|||
-- | ADA.
|
||||
data ADATag
|
||||
|
||||
-- | Governor ST token.
|
||||
data GovernorSTTag
|
||||
|
||||
-- | Stake ST token.
|
||||
data StakeSTTag
|
||||
|
||||
-- | Proposal ST token.
|
||||
data ProposalSTTag
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Resolves ada tags.
|
||||
|
|
|
|||
59
agora/Agora/ScriptInfo.hs
Normal file
59
agora/Agora/ScriptInfo.hs
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
{- |
|
||||
Module : Agora.ScriptInfo
|
||||
Maintainer : emi@haskell.fyi
|
||||
Description: Exportable script bundles for off-chain consumption.
|
||||
|
||||
Exportable script bundles for off-chain consumption.
|
||||
-}
|
||||
module Agora.ScriptInfo (
|
||||
-- * Types
|
||||
PolicyInfo (..),
|
||||
ValidatorInfo (..),
|
||||
|
||||
-- * Introduction functions
|
||||
mkValidatorInfo,
|
||||
mkPolicyInfo,
|
||||
) where
|
||||
|
||||
import Agora.Aeson.Orphans ()
|
||||
import Data.Aeson qualified as Aeson
|
||||
import GHC.Generics qualified as GHC
|
||||
import Plutarch.Api.V1 (PMintingPolicy, PValidator, mintingPolicySymbol, mkMintingPolicy, mkValidator, validatorHash)
|
||||
import Plutus.V1.Ledger.Api (MintingPolicy, Validator, ValidatorHash)
|
||||
import Plutus.V1.Ledger.Value (CurrencySymbol)
|
||||
|
||||
-- | Bundle containing a 'Validator' and its hash.
|
||||
data ValidatorInfo = ValidatorInfo
|
||||
{ script :: Validator
|
||||
, hash :: ValidatorHash
|
||||
}
|
||||
deriving stock (Show, Eq, GHC.Generic)
|
||||
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
|
||||
|
||||
-- | Create a 'ValidatorInfo' given a Plutarch term.
|
||||
mkValidatorInfo :: ClosedTerm PValidator -> ValidatorInfo
|
||||
mkValidatorInfo term =
|
||||
ValidatorInfo
|
||||
{ script = validator
|
||||
, hash = validatorHash validator
|
||||
}
|
||||
where
|
||||
validator = mkValidator term
|
||||
|
||||
-- | Bundle containing a 'MintingPolicy' and its symbol.
|
||||
data PolicyInfo = PolicyInfo
|
||||
{ policy :: MintingPolicy
|
||||
, currencySymbol :: CurrencySymbol
|
||||
}
|
||||
deriving stock (Show, Eq, GHC.Generic)
|
||||
deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
|
||||
|
||||
-- | Create a 'PolicyInfo' given a Plutarch term.
|
||||
mkPolicyInfo :: ClosedTerm PMintingPolicy -> PolicyInfo
|
||||
mkPolicyInfo term =
|
||||
PolicyInfo
|
||||
{ policy = policy
|
||||
, currencySymbol = mintingPolicySymbol policy
|
||||
}
|
||||
where
|
||||
policy = mkMintingPolicy term
|
||||
Loading…
Add table
Add a link
Reference in a new issue