diff --git a/agora-scripts/API.hs b/agora-scripts/API.hs index 499faf8..efccc4e 100644 --- a/agora-scripts/API.hs +++ b/agora-scripts/API.hs @@ -25,7 +25,9 @@ import Agora.Stake (Stake (..)) import Agora.Stake.Scripts (stakePolicy, stakeValidator) import Agora.Treasury (treasuryValidator) import Codec.Serialise.Orphans () +import Data.Aeson qualified as Aeson import Data.Cache.Cached (cachedFor) +import Data.Default.Class (Default (def)) import Data.Function ((&)) import Data.Proxy (Proxy (Proxy)) import Development.GitRev (gitBranch, gitHash) @@ -39,14 +41,16 @@ import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol) import PlutusLedgerApi.V1.Value qualified as Value import Prettyprinter (defaultLayoutOptions, hsep, layoutPretty, viaShow, (<+>)) import Prettyprinter.Render.String (renderString) -import Servant.API (JSON, Post, ReqBody, type (:>)) +import Servant.API (JSON, Post, ReqBody, (:<|>) (..), type (:>)) import Servant.Server qualified as Servant import System.Clock (TimeSpec (TimeSpec)) import Text.Printf (printf) -import Types (AgoraScripts (..), ScriptParams (..)) +import Types (AgoraScripts (..), Builders, ScriptParams (..), ScriptQuery, insertBuilder, runQuery) -- | Servant API type for script generation. -type API = "generate-scripts" :> ReqBody '[JSON] ScriptParams :> Post '[JSON] AgoraScripts +type API = + "generate-scripts" :> ReqBody '[JSON] ScriptParams :> Post '[JSON] AgoraScripts + :<|> "query-script" :> ReqBody '[JSON] ScriptQuery :> Post '[JSON] Aeson.Value -- | Run a Warp server that exposes a script generation endpoint. runServer :: Options -> IO () @@ -74,12 +78,27 @@ runServer options = do -- Scripts stay cached for five minutes agoraScripts' <- cachedFor (Just $ TimeSpec 300 0) agoraScripts + query <- cachedFor (Just $ TimeSpec 300 0) (`runQuery` agoraBuilders) printf "[info] Running 'agora-scripts' on :%d\n" (Warp.getPort settings) - Servant.serve (Proxy @API) agoraScripts' + Servant.serve + (Proxy @API) + (agoraScripts' :<|> query) & corsMiddleware & Warp.runSettings settings +agoraBuilders :: Builders +agoraBuilders = + def + & insertBuilder "governorPolicy" ((.governorPolicyInfo) . agoraScripts) + & insertBuilder "governorValidator" ((.governorValidatorInfo) . agoraScripts) + & insertBuilder "stakePolicyInfo" ((.stakePolicyInfo) . agoraScripts) + & insertBuilder "stakeValidatorInfo" ((.stakeValidatorInfo) . agoraScripts) + & insertBuilder "proposalPolicyInfo" ((.proposalPolicyInfo) . agoraScripts) + & insertBuilder "proposalValidatorInfo" ((.proposalValidatorInfo) . agoraScripts) + & insertBuilder "treasuryValidatorInfo" ((.treasuryValidatorInfo) . agoraScripts) + & insertBuilder "authorityTokenPolicyInfo" ((.authorityTokenPolicyInfo) . agoraScripts) + -- | Create scripts from params. agoraScripts :: ScriptParams -> AgoraScripts agoraScripts params = diff --git a/agora-scripts/Types.hs b/agora-scripts/Types.hs index db32cf6..7a36404 100644 --- a/agora-scripts/Types.hs +++ b/agora-scripts/Types.hs @@ -5,12 +5,26 @@ Description: Param and script types for generation. Param and script types for generation. -} -module Types (ScriptParams (..), AgoraScripts (..)) where +module Types ( + ScriptParams (..), + AgoraScripts (..), + ScriptQuery (..), + Builders (..), + throughJSON, + runQuery, + insertBuilder, +) where import Agora.SafeMoney (GTTag) import Agora.ScriptInfo (PolicyInfo, ValidatorInfo) import Data.Aeson qualified as Aeson +import Data.Coerce (coerce) +import Data.Default.Class (Default (def)) +import Data.Hashable (Hashable) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map import Data.Tagged (Tagged) +import Data.Text (Text) import GHC.Generics qualified as GHC import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1.Value (AssetClass) @@ -40,3 +54,31 @@ data AgoraScripts = AgoraScripts } deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) deriving stock (Show, Eq, GHC.Generic) + +data ScriptQuery = ScriptQuery + { name :: Text + , paramsPayload :: Aeson.Value + } + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) + deriving stock (Show, Eq, GHC.Generic, Ord) + deriving anyclass (Hashable) + +-- | Run a query on Builders. +runQuery :: ScriptQuery -> Builders -> Aeson.Value +runQuery s (Builders b) = + maybe Aeson.Null ($ s.paramsPayload) (Map.lookup s.name b) + +throughJSON :: (Aeson.FromJSON p, Aeson.ToJSON s) => (p -> s) -> (Aeson.Value -> Aeson.Value) +throughJSON f = Aeson.toJSON . \case { Aeson.Error _ -> Nothing; Aeson.Success v -> Just (f v) } . Aeson.fromJSON + +-- | Represents a list of named pure functions. +newtype Builders = Builders + { getBuilders :: Map Text (Aeson.Value -> Aeson.Value) + } + +instance Default Builders where + def = Builders Map.empty + +-- | Insert a pure function into the Builders map. +insertBuilder :: (Aeson.FromJSON p, Aeson.ToJSON s) => Text -> (p -> s) -> Builders -> Builders +insertBuilder k = coerce . Map.insert k . throughJSON diff --git a/agora.cabal b/agora.cabal index 4bcf4b5..8dd8e27 100644 --- a/agora.cabal +++ b/agora.cabal @@ -28,6 +28,7 @@ common lang BinaryLiterals ConstrainedClassMethods ConstraintKinds + DuplicateRecordFields DataKinds DeriveAnyClass DeriveDataTypeable @@ -255,6 +256,7 @@ executable agora-scripts , wai , wai-cors , warp + , containers executable agora-purescript-bridge import: lang, deps, exe-opts diff --git a/agora/Agora/Aeson/Orphans.hs b/agora/Agora/Aeson/Orphans.hs index 75ff1af..6c14c62 100644 --- a/agora/Agora/Aeson/Orphans.hs +++ b/agora/Agora/Aeson/Orphans.hs @@ -109,6 +109,15 @@ deriving via instance (Aeson.FromJSON Plutus.ValidatorHash) +deriving via + (AsBase16Bytes Plutus.BuiltinByteString) + instance + (Aeson.ToJSON Plutus.BuiltinByteString) +deriving via + (AsBase16Bytes Plutus.BuiltinByteString) + instance + (Aeson.FromJSON Plutus.BuiltinByteString) + deriving via (AsBase16Codec Plutus.Validator) instance diff --git a/agora/Agora/ScriptInfo.hs b/agora/Agora/ScriptInfo.hs index 09c7ac6..4942654 100644 --- a/agora/Agora/ScriptInfo.hs +++ b/agora/Agora/ScriptInfo.hs @@ -9,6 +9,7 @@ module Agora.ScriptInfo ( -- * Types PolicyInfo (..), ValidatorInfo (..), + ScriptInfo (..), -- * Introduction functions mkValidatorInfo, @@ -19,8 +20,17 @@ 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 PlutusLedgerApi.V1 (MintingPolicy, Validator, ValidatorHash) -import PlutusLedgerApi.V1.Value (CurrencySymbol) +import PlutusLedgerApi.V1 (BuiltinByteString, CurrencySymbol (unCurrencySymbol), MintingPolicy, Script, Validator, ValidatorHash, unMintingPolicyScript) + +-- | Bundle containing a 'Script' and its hash. +data ScriptInfo = ScriptInfo + { script :: Script + -- ^ The validator script. + , hash :: BuiltinByteString + -- ^ Hash of the script. + } + deriving stock (Show, Eq, GHC.Generic) + deriving anyclass (Aeson.ToJSON, Aeson.FromJSON) {- | Bundle containing a 'Validator' and its hash.