Skip to content

Commit

Permalink
CLI flags
Browse files Browse the repository at this point in the history
  • Loading branch information
@j-mueller
j-mueller committed Aug 11, 2020
1 parent fd4c323 commit 7824833
Show file tree
Hide file tree
Showing 4 changed files with 33 additions and 35 deletions.
55 changes: 33 additions & 22 deletions plutus-scb/app/Main.hs
View file
Expand Up @@ -16,6 +16,8 @@ module Main

import qualified Cardano.BM.Backend.EKGView
import Cardano.BM.Configuration (Configuration)
import qualified Cardano.BM.Configuration.Model as CM
import Cardano.BM.Data.Severity (Severity(..))
import Cardano.BM.Data.Trace (Trace)
import Cardano.BM.Data.Tracer (ToObject (..))
import Cardano.BM.Plugin (loadPlugin)
Expand All @@ -28,14 +30,13 @@ import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (Async, async, waitAny)
import Control.Concurrent.Availability (Availability, newToken, starting)
import Control.Lens.Indexed (itraverse_)
import Control.Monad (forever, void)
import Control.Monad (forever, void, when)
import Control.Monad.Freer (Eff, raise)
import Control.Monad.Freer.Error (handleError)
import Control.Monad.Freer.Extra.Log (LogMsg, logInfo)
import Control.Monad.Freer.Log (logError)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LogLevel (LevelDebug, LevelInfo), filterLogger,
runStdoutLoggingT)
import Control.Monad.Logger (runStdoutLoggingT)
import Control.Tracer (natTracer)
import qualified Data.Aeson as JSON
import Data.Bifunctor (Bifunctor (..))
Expand Down Expand Up @@ -68,14 +69,13 @@ import qualified Plutus.SCB.Core.ContractInstance as Instance
import Plutus.SCB.Events.Contract (ContractInstanceId (..), ContractInstanceState)
import Plutus.SCB.Types (Config (Config), ContractExe (..),
RequestProcessingConfig (..), SCBError,
chainIndexConfig, monitoringConfig, monitoringPort,
chainIndexConfig,
nodeServerConfig, requestProcessingConfig,
signingProcessConfig, walletServerConfig)
import Plutus.SCB.Utils (logErrorS, render)
import qualified Plutus.SCB.Webserver.Server as SCBServer
import qualified PSGenerator
import System.Exit (ExitCode (ExitFailure), exitSuccess, exitWith)
import qualified System.Remote.Monitoring as EKG

data Command
= Migrate
Expand Down Expand Up @@ -106,15 +106,30 @@ versionOption =
(Text.unpack gitRev)
(long "version" <> help "Show the version")

logLevelFlag :: Parser LogLevel
logLevelFlag :: Parser (Maybe Severity)
logLevelFlag =
flag
LevelInfo
LevelDebug
Nothing
(Just Debug)
(short 'v' <> long "verbose" <> help "Enable debugging output.")

commandLineParser :: Parser (LogLevel, FilePath, Maybe FilePath, Command)
commandLineParser = (,,,) <$> logLevelFlag <*> configFileParser <*> logConfigFileParser <*> commandParser
data EKGServer = YesEKGServer | NoEKGServer
deriving (Eq, Ord, Show)

ekgFlag :: Parser EKGServer
ekgFlag =
flag
NoEKGServer
YesEKGServer
(short 'e' <> long "ekg" <> help "Enable the EKG server")

commandLineParser :: Parser (Maybe Severity, FilePath, Maybe FilePath, EKGServer, Command)
commandLineParser =
(,,,,) <$> logLevelFlag
<*> configFileParser
<*> logConfigFileParser
<*> ekgFlag
<*> commandParser

configFileParser :: Parser FilePath
configFileParser =
Expand Down Expand Up @@ -379,7 +394,6 @@ runCliCommand trace logConfig config serviceAvailability (ForkCommands commands)
forkCommand :: Command -> IO (Async ())
forkCommand subcommand = do
putStrLn $ "Starting: " <> show subcommand
-- asyncId <- async . void . runApp minLogLevel config . renderLogMessages . runCliCommand minLogLevel config serviceAvailability $ subcommand
let trace' = natTracer (\x -> TraceLoggerT $ \_ -> x) trace
asyncId <- async . void . runApp (mapSCBMsg trace) logConfig config . handleLogMsgTrace trace' . runCliCommand trace logConfig config serviceAvailability $ subcommand
putStrLn $ "Started: " <> show subcommand
Expand All @@ -398,11 +412,6 @@ runCliCommand _ _ _ _ ReportInstalledContracts = do
runCliCommand _ _ _ _ ReportActiveContracts = do
logInfo ActiveContractsMsg
instances <- Map.toAscList <$> Core.activeContracts @ContractExe
-- let format :: (ContractExe, Set ContractInstanceId) -> Doc a
-- format (contractExe, contractInstanceIds) =
-- vsep [ pretty contractExe
-- , indent 2 (vsep (pretty <$> Set.toList contractInstanceIds))
-- ]
traverse_ (\(e, s) -> (logInfo $ ContractInstance e (Set.toList s))) instances
runCliCommand _ _ _ _ ReportTxHistory = do
logInfo TransactionHistoryMsg
Expand All @@ -414,7 +423,6 @@ runCliCommand _ _ _ _ (ReportContractHistory uuid) = do
contracts <- Core.activeContractHistory @ContractExe (ContractInstanceId uuid)
itraverse_ (\i -> logContract i) contracts
where
-- logContract :: Int -> ContractInstanceState ContractExe -> App ()
logContract index contract = logInfo $ ContractHistoryItem index contract
runCliCommand _ _ _ _ (ProcessContractInbox uuid) = do
logInfo ProcessInboxMsg
Expand All @@ -430,28 +438,31 @@ runCliCommand _ _ _ _ PSGenerator {_outputDir} =

main :: IO ()
main = do
(minLogLevel, configPath, logConfigPath, cmd) <-
(minLogLevel, configPath, logConfigPath, ekg, cmd) <-
customExecParser
(prefs $ disambiguate <> showHelpOnEmpty <> showHelpOnError)
(info (helper <*> versionOption <*> commandLineParser) idm)
config <- liftIO $ decodeFileThrow configPath
-- FIXME: Set log level here (if provided)

logConfig <- maybe defaultConfig loadConfig logConfigPath
_ <- case minLogLevel of
Nothing -> pure ()
Just ll -> CM.setMinSeverity logConfig ll
(trace :: Trace IO AppMsg, switchboard) <- setupTrace_ logConfig "pab"
let trace' = natTracer (\x -> TraceLoggerT $ \_ -> x) trace

-- enable EKG backend
Cardano.BM.Backend.EKGView.plugin logConfig trace switchboard >>= loadPlugin switchboard
when (ekg == YesEKGServer) $ do
Cardano.BM.Backend.EKGView.plugin logConfig trace switchboard >>= loadPlugin switchboard

traverse_ (EKG.forkServer "localhost") (monitoringPort <$> monitoringConfig config)
serviceAvailability <- newToken
result <-
runApp (mapSCBMsg trace) logConfig config $ handleLogMsgTrace trace' $ do
logInfo $ RunningCommand cmd
runCliCommand trace logConfig config serviceAvailability cmd
case result of
Left err -> do
runStdoutLoggingT $ filterLogger (\_ logLevel -> logLevel >= minLogLevel) $ logErrorS err
runStdoutLoggingT $ logErrorS err
exitWith (ExitFailure 1)
Right _ -> exitSuccess

Expand Down
4 changes: 0 additions & 4 deletions plutus-scb/plutus-scb.yaml.sample
View file
Expand Up @@ -34,7 +34,3 @@ signingProcessConfig:
spWallet:
getWallet: 1

# Optional EKG Server Config
# ----
# monitoringConfig:
# monitoringPort: 8090
1 change: 0 additions & 1 deletion plutus-scb/src/Plutus/SCB/App.hs
View file
Expand Up @@ -112,7 +112,6 @@ type AppBackend m =
, LogMsg UnStringifyJSONLog
, LogMsg (CoreMsg ContractExe)
, LogObserve (LogMessage Text.Text)
-- , LogMsg Text.Text
, Reader Connection
, Reader Env
, m
Expand Down
8 changes: 0 additions & 8 deletions plutus-scb/src/Plutus/SCB/Types.hs
View file
Expand Up @@ -88,7 +88,6 @@ data Config =
, scbWebserverConfig :: WebserverConfig
, chainIndexConfig :: ChainIndex.ChainIndexConfig
, signingProcessConfig :: SigningProcess.SigningProcessConfig
, monitoringConfig :: Maybe MonitoringConfig
, requestProcessingConfig :: RequestProcessingConfig
}
deriving (Show, Eq, Generic, FromJSON)
Expand All @@ -100,13 +99,6 @@ newtype RequestProcessingConfig =
deriving (Show, Eq, Generic)
deriving anyclass (FromJSON)

newtype MonitoringConfig =
MonitoringConfig
{ monitoringPort :: Int
}
deriving (Show, Eq, Generic)
deriving anyclass (FromJSON)

data WebserverConfig =
WebserverConfig
{ baseUrl :: BaseUrl
Expand Down

0 comments on commit 7824833

Please sign in to comment.