diff --git a/src/lib/Wst/Cli.hs b/src/lib/Wst/Cli.hs index a2a8629..608342f 100644 --- a/src/lib/Wst/Cli.hs +++ b/src/lib/Wst/Cli.hs @@ -1,8 +1,19 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} module Wst.Cli(runMain) where +import Blammo.Logging.Simple (Message ((:#)), MonadLogger, MonadLoggerIO, + WithLogger (..), logError, logInfo, logWarn, + runLoggerLoggingT) +import Control.Monad.Except (ExceptT, MonadError, runExceptT) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT) +import Data.String (IsString (..)) import Options.Applicative (customExecParser, disambiguate, helper, idm, info, prefs, showHelpOnEmpty, showHelpOnError) -import Wst.Cli.Command (Command, parseCommand) +import Wst.Cli.Command (Command (..), parseCommand) +import Wst.Cli.RuntimeEnv (RuntimeEnv) +import Wst.Cli.RuntimeEnv qualified as RuntimeEnv runMain :: IO () runMain = do @@ -13,5 +24,22 @@ runMain = do runCommand :: Command -> IO () runCommand com = do - putStrLn "runCommand" - print com + env <- RuntimeEnv.loadEnv + result <- runWstApp env $ case com of + Deploy -> logInfo "Deploy" + Manage txIn com -> logInfo "Manage" + case result of + Left err -> runLoggerLoggingT env $ logError (fromString $ show err) + Right a -> pure a + +data AppError = AppError + deriving stock Show + +newtype WstApp a = WstApp { unWstApp :: ReaderT RuntimeEnv (ExceptT AppError IO) a } + deriving newtype (Monad, Applicative, Functor, MonadIO, MonadReader RuntimeEnv, MonadError AppError) + deriving + (MonadLogger, MonadLoggerIO) + via (WithLogger RuntimeEnv (ExceptT AppError IO)) + +runWstApp :: RuntimeEnv -> WstApp a -> IO (Either AppError a) +runWstApp env WstApp{unWstApp} = runExceptT (runReaderT unWstApp env) diff --git a/src/lib/Wst/Cli/Command.hs b/src/lib/Wst/Cli/Command.hs index 35ce3ac..811862b 100644 --- a/src/lib/Wst/Cli/Command.hs +++ b/src/lib/Wst/Cli/Command.hs @@ -32,6 +32,7 @@ data Command = -- | Commands that require a deployed system data ManageCommand = Status + | StartServer deriving stock Show parseDeploy :: Mod CommandFields Command @@ -63,7 +64,6 @@ txInReader = eitherReader $ \str -> do (txId, txIx) <- case break ((==) '.') str of (txId, _:txIx) -> Right (txId, txIx) _ -> Left "Expected ." - -- 8c728a68fed42fe4893fb84ee2c6276a25e642d9892962af3234f952ea641993 when (length txId /= 64) $ Left "Expected tx ID with 64 characters" ix <- case readMaybe @Word txIx of Nothing -> Left "Expected tx index" diff --git a/src/lib/Wst/Cli/RuntimeEnv.hs b/src/lib/Wst/Cli/RuntimeEnv.hs new file mode 100644 index 0000000..51e7464 --- /dev/null +++ b/src/lib/Wst/Cli/RuntimeEnv.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TemplateHaskell #-} +{-| Data that we need when running the CLI +-} +module Wst.Cli.RuntimeEnv( + RuntimeEnv(..), + loadEnv, +) where + +import Blammo.Logging (Logger) +import Blammo.Logging.Logger (HasLogger (..), newLogger) +import Blammo.Logging.LogSettings.Env qualified as LogSettingsEnv +import Blockfrost.Auth (mkProject) +import Blockfrost.Client.Auth qualified as Blockfrost +import Control.Lens (makeLensesFor) +import Data.Text qualified as Text +import System.Environment qualified + +data RuntimeEnv + = RuntimeEnv + { envLogger :: Logger + , envBlockfrost :: Blockfrost.Project + + } + +makeLensesFor + [ ("envLogger", "logger") + , ("envBlockfrostProject", "blockfrostProject") + ] + 'RuntimeEnv + +instance HasLogger RuntimeEnv where + loggerL = logger + +-- | Load the 'RuntimeEnv' from environment variables +loadEnv :: IO RuntimeEnv +loadEnv = + RuntimeEnv + <$> (LogSettingsEnv.parse >>= newLogger) + <*> fmap (mkProject . Text.pack) (System.Environment.getEnv "WST_BLOCKFROST_TOKEN") diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 3607c1c..702133b 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -70,6 +70,7 @@ library Types.Constants Wst.Cli Wst.Cli.Command + Wst.Cli.RuntimeEnv Wst.Client Wst.Offchain Wst.Offchain.BuildTx.Blacklist @@ -90,8 +91,11 @@ library hs-source-dirs: lib build-depends: , aeson - , base >=4.14 && <4.20 + , base >=4.14 && <4.20 , base16-bytestring + , Blammo + , blockfrost-api + , blockfrost-client-core , bytestring , cardano-api , cardano-ledger-api