Merge pull request #129 from Liqwid-Labs/emiflake/scripts-api

Scripts HTTP API

README.md

@@ -21,6 +21,18 @@ An up to date version of the [Nix package manager](nixos.org) (>=2.3) is require
 
 Open a development shell with `nix develop` and build the project with `cabal build`. Those pained by the need to remember to enter a Nix shell may consider using [nix-direnv](https://github.com/nix-community/nix-direnv).
 
+## `agora-scripts` HTTP export server
+
+To use scripts in a frontend, you can use the `agora-scripts` executable which allows you to query them on-demand.
+
+The CTL repo [`agora-offchain`](https://github.com/mlabs-haskell/agora-offchain) already has the setup prepared for this feature.
+
+In order to run the server, simply run the following command:
+
+```sh
+cabal run agora-scripts -- --enable-cors-middleware
+```
+
 ## Documentation
 
 Documentation for Agora is hosted on Notion. You can find the specs [here](https://liqwid.notion.site/e85c09d2c9a542b19aac8dd3d6caa98b?v=d863219cd6a14082a661c4959cabd6e7).

agora-scripts/Codec/Serialise/Orphans.hs

@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+{- |
+Module     : Codec.Serialise.Orphans
+Maintainer : emi@haskell.fyi
+Description: Orphan instances for Serialising and Hashing Cardano types.
+
+Orphan instances for Serialising and Hashing Cardano types.
+-}
+module Codec.Serialise.Orphans () where
+
+import Codec.Serialise (Serialise)
+import Data.Tagged (Tagged (Tagged))
+import PlutusLedgerApi.V1 (TxId, TxOutRef)
+import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol, TokenName)
+
+deriving anyclass instance
+  Serialise TxOutRef
+
+deriving anyclass instance
+  Serialise TxId
+
+deriving anyclass instance
+  Serialise AssetClass
+
+deriving anyclass instance
+  Serialise CurrencySymbol
+
+deriving anyclass instance
+  Serialise TokenName
+
+deriving newtype instance
+  Serialise a =>
+  Serialise (Tagged s a)

agora-scripts/Data/Cache/Cached.hs

@@ -0,0 +1,49 @@
+{- | Module     : API
+   Maintainer : emi@haskell.fyi
+   Description: API for script exporter.
+
+   API for script exporter.
+-}
+module Data.Cache.Cached (
+  cached,
+  cachedM,
+  cachedForM,
+) where
+
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Cache qualified as Cache
+import Data.Functor ((<&>))
+import Data.Hashable (Hashable)
+import System.Clock (TimeSpec)
+
+{- | 'cachedFor' but items last forever.
+
+   Uses a HashMap under the hood.
+-}
+cached :: (Monad m, MonadIO m, Hashable k, Ord k) => (k -> v) -> IO (k -> m v)
+cached f = cachedForM Nothing (pure . f)
+
+{- | 'cachedFor' but items last forever.
+
+   Uses a HashMap under the hood.
+-}
+cachedM :: (Monad m, MonadIO m, Hashable k, Ord k) => (k -> m v) -> IO (k -> m v)
+cachedM = cachedForM Nothing
+
+{- | Create a cached version of a function tainting result with MonadIO context.
+
+   Results are cached dependent on the first argument, @'Maybe' 'TimeSpec'@.
+
+   Uses a HashMap under the hood.
+-}
+cachedForM :: (Monad m, MonadIO m, Hashable k, Ord k) => Maybe TimeSpec -> (k -> m v) -> IO (k -> m v)
+cachedForM t f =
+  Cache.newCache t <&> \cache k -> do
+    res <- liftIO $ Cache.lookup cache k
+    case res of
+      Nothing -> do
+        v <- f k
+        liftIO $ Cache.insert cache k v
+        pure v
+      Just v -> do
+        pure v

agora-scripts/Main.hs

@@ -0,0 +1,144 @@
+{-# 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.ScriptInfo (ScriptInfo, mkPolicyInfo, mkValidatorInfo)
+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.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
+    & 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)
+
+{- | 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
+    )

agora-scripts/Options.hs

@@ -1,45 +0,0 @@
-{- |
-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 "./agora-scripts/agora-params.json"
-          <> Opt.help "The path where the script configuration is."
-      )
-    <*> Opt.strOption
-      ( Opt.long "output"
-          <> Opt.short 'o'
-          <> Opt.metavar "OUTPUT_PATH"
-          <> Opt.value "./agora-scripts/agora-scripts.json"
-          <> 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."
-        )

agora-scripts/ScriptExport/API.hs

@@ -0,0 +1,110 @@
+{- | Module   : ScriptExport.API
+     Maintainer : emi@haskell.fyi
+     Description: API for script exporter.
+
+     API for script exporter.
+-}
+module ScriptExport.API (
+  API,
+  runServer,
+) where
+
+import Codec.Serialise.Orphans ()
+import Data.Aeson qualified as Aeson
+import Data.Cache.Cached (cachedForM)
+import Data.Function ((&))
+import Data.Proxy (Proxy (Proxy))
+import Data.Text (Text)
+import GHC.Generics qualified as GHC
+import Network.HTTP.Types qualified as Http
+import Network.Wai qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai.Middleware.Cors (CorsResourcePolicy (corsRequestHeaders), cors, simpleCorsResourcePolicy)
+import Prettyprinter (Pretty (pretty), defaultLayoutOptions, hsep, layoutPretty, viaShow)
+import Prettyprinter.Render.String (renderString)
+import ScriptExport.Options (Options (..))
+import ScriptExport.Types (Builders, ScriptQuery (ScriptQuery), runQuery)
+import ScriptExport.Types qualified as Builders
+import Servant.API (Capture, Get, JSON, Post, ReqBody, (:<|>) (..), type (:>))
+import Servant.Server qualified as Servant
+import System.Clock (TimeSpec (TimeSpec))
+import Text.Printf (printf)
+
+{- | Servant API type for script generation.
+
+     @since 0.2.0
+-}
+type API =
+  -- POST /query-script/:name
+  "query-script"
+    :> Capture "name" Text
+    :> ReqBody '[JSON] Aeson.Value
+    :> Post '[JSON] Aeson.Value
+    -- GET /info
+    :<|> "info"
+      :> Get '[JSON] ServerInfo
+
+{- | Information about the server.
+
+     @since 0.2.0
+-}
+data ServerInfo = ServerInfo
+  { revision :: Text
+  , exposedBuilders :: [Text]
+  }
+  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
+    )
+
+-- | Run a Warp server that exposes a script generation endpoint.
+runServer :: Text -> Builders -> Options -> IO ()
+runServer revision builders options = do
+  let logger req status _maybeFileSize =
+        putStrLn . renderString . layoutPretty defaultLayoutOptions $
+          hsep
+            [ "[info]"
+            , viaShow $ Wai.requestMethod req
+            , viaShow $ Wai.rawPathInfo req
+            , "(" <> pretty (Http.statusCode status) <> ")"
+            ]
+
+      settings =
+        Warp.defaultSettings
+          & Warp.setPort options.port
+          & Warp.setLogger logger
+
+      corsPolicy =
+        simpleCorsResourcePolicy
+          { -- NOTE: Webpack dev server requires this for CORS workaround.
+            corsRequestHeaders = "content-type" : corsRequestHeaders simpleCorsResourcePolicy
+          }
+
+      corsMiddleware = cors . const $ Just corsPolicy
+
+      serverInfo =
+        ServerInfo
+          { revision = revision
+          , exposedBuilders = Builders.toList builders
+          }
+
+  -- Scripts stay cached for five minutes
+  query <- cachedForM (Just $ TimeSpec 300 0) (`runQuery` builders)
+
+  let handler = (\name -> query . ScriptQuery name) :<|> pure serverInfo
+
+  printf "[info] Running 'agora-scripts' on :%d\n" (Warp.getPort settings)
+
+  Servant.serve (Proxy @API) handler
+    & (if options.enableCorsMiddleware then corsMiddleware else id)
+    & Warp.runSettings settings

agora-scripts/ScriptExport/Options.hs

@@ -0,0 +1,51 @@
+{- |
+Module     : ScriptExport.Options
+Maintainer : emi@haskell.fyi
+Description: Command line options for 'agora-scripts'.
+
+Command line options for 'agora-scripts'.
+-}
+module ScriptExport.Options (Options (..), parseOptions) where
+
+import Network.Wai.Handler.Warp qualified as Warp
+import Options.Applicative ((<**>))
+import Options.Applicative qualified as Opt
+
+data Options = Options
+  { port :: Warp.Port
+  , enableCorsMiddleware :: Bool
+  }
+  deriving stock (Show, Eq)
+
+opt :: Opt.Parser Options
+opt =
+  Options
+    <$> Opt.option
+      Opt.auto
+      ( Opt.long "port"
+          <> Opt.short 'p'
+          <> Opt.metavar "PORT"
+          <> Opt.value 3939
+          <> Opt.help "The port to run the server on."
+      )
+    <*> Opt.switch
+      ( Opt.long "enable-cors-middleware"
+          <> Opt.short 'c'
+          <> Opt.help
+            ( unwords
+                [ "Enable cors middleware."
+                , "This is usually required for some local servers."
+                , "For security reasons, this should be disabled in production."
+                ]
+            )
+      )
+
+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."
+        )

agora-scripts/ScriptExport/Types.hs

@@ -0,0 +1,112 @@
+{- |
+Module     : ScriptExport.Types
+Maintainer : emi@haskell.fyi
+Description: Param and script types for generation.
+
+Param and script types for generation.
+-}
+module ScriptExport.Types (
+  ScriptQuery (..),
+  Builders,
+  runQuery,
+  insertBuilder,
+  toList,
+) where
+
+import Data.Aeson qualified as Aeson
+import Data.ByteString.Lazy.Char8 qualified as LBS
+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.Text (Text)
+import GHC.Generics qualified as GHC
+import Servant qualified
+
+{- | Query data for getting script info.
+
+     @since 0.2.0
+-}
+data ScriptQuery = ScriptQuery
+  { name :: Text
+  , paramsPayload :: Aeson.Value
+  }
+  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
+    , -- | @since 0.2.0
+      Ord
+    )
+  deriving anyclass
+    ( -- | @since 0.2.0
+      Hashable
+    )
+
+{- | Run a query on Builders.
+
+     @since 0.2.0
+-}
+runQuery :: ScriptQuery -> Builders -> Servant.Handler Aeson.Value
+runQuery s =
+  maybe
+    (Servant.throwError Servant.err404 {Servant.errBody = "Builder not found"})
+    ($ s.paramsPayload)
+    . Map.lookup s.name
+    . getBuilders
+
+{- | Represents a list of named pure functions.
+
+     @since 0.2.0
+-}
+newtype Builders = Builders
+  { getBuilders :: Map Text (Aeson.Value -> Servant.Handler Aeson.Value)
+  }
+
+-- | @since 0.2.0
+instance Default Builders where
+  def = Builders Map.empty
+
+{- | Insert a pure function into the Builders map.
+
+     @since 0.2.0
+-}
+insertBuilder ::
+  forall p s.
+  (Aeson.FromJSON p, Aeson.ToJSON s) =>
+  Text ->
+  (p -> s) ->
+  Builders ->
+  Builders
+insertBuilder k = coerce . Map.insert k . throughJSON
+  where
+    throughJSON ::
+      forall p s.
+      (Aeson.FromJSON p, Aeson.ToJSON s) =>
+      (p -> s) ->
+      (Aeson.Value -> Servant.Handler Aeson.Value)
+    throughJSON f v =
+      case Aeson.fromJSON v of
+        Aeson.Error e ->
+          Servant.throwError $
+            Servant.err400
+              { Servant.errBody = LBS.pack e
+              }
+        Aeson.Success v' -> pure . Aeson.toJSON $ f v'
+
+{- | Get a list of the available builders.
+
+     @since 0.2.0
+-}
+toList :: Builders -> [Text]
+toList = Map.keys . getBuilders

agora-scripts/Scripts.hs

@@ -1,121 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-{- |
-Module     : Scripts
-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.ScriptInfo (PolicyInfo, ValidatorInfo, mkPolicyInfo, mkValidatorInfo)
-import Agora.Stake (Stake)
-import Agora.Stake.Scripts (stakePolicy, stakeValidator)
-import Agora.Treasury (treasuryValidator)
-import Control.Monad ((>=>))
-import Data.Aeson qualified as Aeson
-import Data.Tagged (Tagged)
-import Development.GitRev (gitBranch, gitHash)
-import GHC.Generics qualified as GHC
-import Options (Options (..), parseOptions)
-import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy)
-import PlutusLedgerApi.V1 (TxOutRef)
-import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol)
-import PlutusLedgerApi.V1.Value qualified as Value
-import System.Exit (exitFailure)
-import Text.Printf (printf)
-
--- | Params required for creating script export.
-data ScriptParams = ScriptParams
-  { governorInitialSpend :: TxOutRef
-  , gtClassRef :: Tagged GTTag AssetClass
-  , maximumCosigners :: Integer
-  }
-  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
-  deriving stock (Show, Eq, GHC.Generic)
-
--- | Scripts that get exported.
-data AgoraScripts = AgoraScripts
-  { gitRev :: String
-  , governorPolicyInfo :: PolicyInfo
-  , governorValidatorInfo :: ValidatorInfo
-  , stakePolicyInfo :: PolicyInfo
-  , stakeValidatorInfo :: ValidatorInfo
-  , proposalPolicyInfo :: PolicyInfo
-  , proposalValidatorInfo :: ValidatorInfo
-  , treasuryValidatorInfo :: ValidatorInfo
-  , authorityTokenPolicyInfo :: PolicyInfo
-  }
-  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
-  deriving stock (Show, Eq, GHC.Generic)
-
-main :: IO ()
-main = do
-  options <- parseOptions
-
-  params <-
-    Aeson.eitherDecodeFileStrict @ScriptParams options.config
-      >>= either (putStrLn >=> const exitFailure) pure
-
-  let scripts = agoraScripts params
-
-  Aeson.encodeFile options.output scripts
-
-  printf "Done! Wrote to %s\n" options.output
-
--- | Create scripts from params.
-agoraScripts :: ScriptParams -> AgoraScripts
-agoraScripts params =
-  AgoraScripts
-    { gitRev = revision
-    , 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
-    revision :: String
-    revision = $(gitBranch) <> "@" <> $(gitHash)
-
-    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

agora-scripts/agora-params.json

@@ -1,11 +0,0 @@
-{
-  "governorInitialSpend": {
-    "txOutRefId": "7be688c61c209dd7a9f4948090db0b031b11a8850b0ee4695f786fea85fbfdee",
-    "txOutRefIdx": 0
-  },
-  "gtClassRef": [
-    "",
-    ""
-  ],
-  "maximumCosigners": 5
-}

agora.cabal

@@ -12,11 +12,11 @@ license:            Apache-2.0
 
 common lang
   ghc-options:
-    -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind
+    -Werror -Wall -Wcompat -Wincomplete-uni-patterns
-    -Wno-partial-type-signatures -Wmissing-export-lists
+    -Wno-unused-do-bind -Wno-partial-type-signatures
-    -Wincomplete-record-updates -Wmissing-deriving-strategies
+    -Wmissing-export-lists -Wincomplete-record-updates
-    -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls
+    -Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls
-    -fprint-explicit-kinds -Werror
+    -fprint-explicit-foralls -fprint-explicit-kinds
 
   mixins:
     base hiding (Prelude),
@@ -39,6 +39,7 @@ common lang
     DerivingStrategies
     DerivingVia
     DoAndIfThenElse
+    DuplicateRecordFields
     EmptyCase
     EmptyDataDecls
     EmptyDataDeriving
@@ -90,7 +91,9 @@ common deps
     , ansi-terminal
     , base                   >=4.14 && <5
     , base-compat
+    , base16
     , bytestring
+    , cardano-binary
     , cardano-prelude
     , containers
     , data-default
@@ -137,6 +140,7 @@ common exe-opts
 library
   import:          lang, deps
   exposed-modules:
+    Agora.Aeson.Orphans
     Agora.AuthorityToken
     Agora.Effect
     Agora.Effect.GovernorMutation
@@ -145,6 +149,7 @@ library
     Agora.Governor
     Agora.Governor.Scripts
     Agora.MultiSig
+    Agora.Plutarch.Orphans
     Agora.Proposal
     Agora.Proposal.Scripts
     Agora.Proposal.Time
@@ -156,9 +161,6 @@ library
     Agora.Utils
 
   other-modules:
-    Agora.Aeson.Orphans
-    Agora.Plutarch.Orphans
-
   hs-source-dirs:  agora
 
 library pprelude
@@ -232,13 +234,30 @@ benchmark agora-bench
 
 executable agora-scripts
   import:         lang, deps, exe-opts
-  main-is:        Scripts.hs
+  main-is:        Main.hs
   hs-source-dirs: agora-scripts
-  other-modules:  Options
+  other-modules:
+    Codec.Serialise.Orphans
+    Data.Cache.Cached
+    ScriptExport.API
+    ScriptExport.Options
+    ScriptExport.Types
+
   build-depends:
     , agora
+    , cache
+    , clock
+    , containers
     , gitrev
+    , hashable
+    , http-types
     , optparse-applicative
+    , prettyprinter
+    , servant
+    , servant-server
+    , wai
+    , wai-cors
+    , warp
 
 executable agora-purescript-bridge
   import:         lang, deps, exe-opts

agora/Agora/Aeson/Orphans.hs

@@ -20,6 +20,7 @@ import Data.Text.Encoding qualified as T
 
 import PlutusLedgerApi.V1 qualified as Plutus
 import PlutusLedgerApi.V1.Bytes qualified as Plutus
+import PlutusLedgerApi.V1.Scripts qualified as Plutus
 import PlutusLedgerApi.V1.Value qualified as Plutus
 
 --------------------------------------------------------------------------------
@@ -109,6 +110,24 @@ deriving via
   instance
     (Aeson.FromJSON Plutus.ValidatorHash)
 
+deriving via
+  (AsBase16Bytes Plutus.ScriptHash)
+  instance
+    (Aeson.ToJSON Plutus.ScriptHash)
+deriving via
+  (AsBase16Bytes Plutus.ScriptHash)
+  instance
+    (Aeson.FromJSON Plutus.ScriptHash)
+
+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

agora/Agora/ScriptInfo.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 {- |
 Module     : Agora.ScriptInfo
 Maintainer : emi@haskell.fyi
@@ -7,8 +9,7 @@ Exportable script bundles for off-chain consumption.
 -}
 module Agora.ScriptInfo (
   -- * Types
-  PolicyInfo (..),
+  ScriptInfo (..),
-  ValidatorInfo (..),
 
   -- * Introduction functions
   mkValidatorInfo,
@@ -16,84 +17,71 @@ module Agora.ScriptInfo (
 ) where
 
 import Agora.Aeson.Orphans ()
+import Cardano.Binary qualified as CBOR
+import Codec.Serialise qualified as Codec
 import Data.Aeson qualified as Aeson
+import Data.ByteString.Base16 qualified as Base16
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Short qualified as SBS
+import Data.Text (Text)
 import GHC.Generics qualified as GHC
-import Plutarch.Api.V1 (PMintingPolicy, PValidator, mintingPolicySymbol, mkMintingPolicy, mkValidator, validatorHash)
+import Plutarch.Api.V1 (PMintingPolicy, PValidator, mkMintingPolicy, mkValidator, scriptHash)
-import PlutusLedgerApi.V1 (MintingPolicy, Validator, ValidatorHash)
+import PlutusLedgerApi.V1 (
-import PlutusLedgerApi.V1.Value (CurrencySymbol)
+  MintingPolicy (getMintingPolicy),
+  Script,
+  Validator (getValidator),
+ )
+import PlutusLedgerApi.V1.Scripts (ScriptHash)
 
 {- | Bundle containing a 'Validator' and its hash.
 
-     @since 0.1.0
+     @since 0.2.0
 -}
-data ValidatorInfo = ValidatorInfo
+data ScriptInfo = ScriptInfo
-  { script :: Validator
+  { cborHex :: Text
-  -- ^ The validator script.
+  -- ^ The validator script encoded as cbor hex.
-  , hash :: ValidatorHash
+  , rawHex :: Text
+  -- ^ The validator script encoded as raw hex.
+  , hash :: ScriptHash
   -- ^ Hash of the validator.
   }
   deriving stock
-    ( -- | @since 0.1.0
+    ( -- | @since 0.2.0
       Show
-    , -- | @since 0.1.0
+    , -- | @since 0.2.0
       Eq
-    , -- | @since 0.1.0
+    , -- | @since 0.2.0
       GHC.Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
+    ( -- | @since 0.2.0
       Aeson.ToJSON
-    , -- | @since 0.1.0
+    , -- | @since 0.2.0
       Aeson.FromJSON
     )
 
-{- | Create a 'ValidatorInfo' given a Plutarch term.
+mkScriptInfo :: Script -> ScriptInfo
+mkScriptInfo script =
+  let scriptRaw = LBS.toStrict $ Codec.serialise script
+      scriptCBOR = CBOR.serialize' $ SBS.toShort scriptRaw
+   in ScriptInfo
+        { cborHex = Base16.encodeBase16 scriptCBOR
+        , rawHex = Base16.encodeBase16 scriptRaw
+        , hash = scriptHash script
+        }
 
-     @since 0.1.0
+{- | Create a 'ScriptInfo' given a Plutarch term of a policy.
+
+     @since 0.2.0
 -}
-mkValidatorInfo :: ClosedTerm PValidator -> ValidatorInfo
+mkPolicyInfo :: ClosedTerm PMintingPolicy -> ScriptInfo
-mkValidatorInfo term =
-  ValidatorInfo
-    { script = validator
-    , hash = validatorHash validator
-    }
-  where
-    validator = mkValidator term
-
-{- | Bundle containing a 'MintingPolicy' and its symbol.
-
-     @since 0.1.0
--}
-data PolicyInfo = PolicyInfo
-  { policy :: MintingPolicy
-  -- ^ The minting policy.
-  , currencySymbol :: CurrencySymbol
-  -- ^ The symbol given by the minting policy.
-  }
-  deriving stock
-    ( -- | @since 0.1.0
-      Show
-    , -- | @since 0.1.0
-      Eq
-    , -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
-    ( -- | @since 0.1.0
-      Aeson.ToJSON
-    , -- | @since 0.1.0
-      Aeson.FromJSON
-    )
-
-{- | Create a 'PolicyInfo' given a Plutarch term.
-
-     @since 0.1.0
--}
-mkPolicyInfo :: ClosedTerm PMintingPolicy -> PolicyInfo
 mkPolicyInfo term =
-  PolicyInfo
+  mkScriptInfo (getMintingPolicy $ mkMintingPolicy term)
-    { policy = policy
+
-    , currencySymbol = mintingPolicySymbol policy
+{- | Create a 'ScriptInfo' given a Plutarch term of a validator.
-    }
+
-  where
+     @since 0.2.0
-    policy = mkMintingPolicy term
+-}
+mkValidatorInfo :: ClosedTerm PValidator -> ScriptInfo
+mkValidatorInfo term =
+  mkScriptInfo (getValidator $ mkValidator term)

flake.nix

@@ -140,11 +140,15 @@
       );
 
       applyDep = pkgs: o:
-        let h = myhackage pkgs.system o.compiler-nix-name; in
+        let
-        (plutarch.applyPlutarchDep pkgs o) // {
+          h = myhackage pkgs.system o.compiler-nix-name;
-          modules = haskellModules ++ [ h.module ] ++ (o.modules or [ ]);
+          o' = (plutarch.applyPlutarchDep pkgs o);
-          extra-hackages = [ (import h.hackageNix) ] ++ (o.extra-hackages or [ ]);
+        in
-          extra-hackage-tarballs = { _xNJUd_plutarch-hackage = h.hackageTarball; } // (o.extra-hackage-tarballs or { });
+        o' // rec {
+          modules = haskellModules ++ [ h.module ] ++ (o'.modules or [ ]);
+          extra-hackages = [ (import h.hackageNix) ] ++ (o'.extra-hackages or [ ]);
+          extra-hackage-tarballs = { _xNJUd_plutarch-hackage = h.hackageTarball; };
+          cabalProjectLocal = (o'.cabalProjectLocal or "") + "  , cache >= 0.1.3.0";
         };
 
       projectForGhc = compiler-nix-name: system: