{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.RTView.Config
    ( prepareConfigAndParams
    ) where

import           Cardano.Prelude
import           Prelude (String)

#if !defined(mingw32_HOST_OS)
import           Control.Monad (forM_)
#endif
import           Data.List (nub, nubBy)
import           Data.Maybe (fromJust)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.IO as TIO
import           Data.Yaml (ParseException, decodeFileEither, encodeFile)
import           System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleIntensity (..),
                                      ConsoleLayer (..), SGR (..), setSGR)
import           System.Directory (XdgDirectory (..), createDirectoryIfMissing, doesFileExist,
                                   getTemporaryDirectory, getXdgDirectory)
#if !defined(mingw32_HOST_OS)
import           System.Directory (listDirectory, removeFile)
#endif

import           System.FilePath ((</>))
#if defined(mingw32_HOST_OS)
import           System.FilePath (dropDrive)
#else
import           System.FilePath (takeDirectory)
#endif
import qualified System.Exit as Ex
import           System.IO (hFlush)
import           Text.Read (readMaybe)

import           Cardano.BM.Configuration (Configuration, getAcceptAt, setup)
import qualified Cardano.BM.Configuration.Model as CM
import           Cardano.BM.Data.BackendKind (BackendKind (..))
import           Cardano.BM.Data.Configuration (RemoteAddr (..), RemoteAddrNamed (..))
import           Cardano.BM.Data.Output (ScribeDefinition (..), ScribeFormat (..),
                                         ScribeKind (..), ScribePrivacy (..))
import           Cardano.BM.Data.Severity (Severity (..))

import           Cardano.RTView.CLI (RTViewParams (..), defaultRTViewParams, defaultRTVPort,
                                     defaultRTVStatic)

-- | There are few possible ways how we can prepare RTView configuration:
--   1. By running interactive dialog with the user. If `--config` CLI-option
--      isn't provided, the user will answer few questions and actual configuration
--      will be prepared based on these answers.
--   2. By providing configuration explicitly. If `--config`, `--static` and `--port`
--      options are provided, these values will be used (interactive dialog will be skipped).
--   3. By using the last used configuration. If the user already launched
--      `cardano-rt-view` previously, the configuration was stored in
--      user's local directory (different for each supported platform),
--      and by default that configuration will be used again.
prepareConfigAndParams
  :: RTViewParams
  -> IO (Configuration, RTViewParams, [RemoteAddrNamed])
prepareConfigAndParams :: RTViewParams -> IO (Configuration, RTViewParams, [RemoteAddrNamed])
prepareConfigAndParams RTViewParams
params' = do
  (Configuration
config, RTViewParams
params) <-
    if RTViewParams -> Bool
configFileIsProvided RTViewParams
params'
      then do
        Configuration
configFromFile <- FilePath -> IO Configuration
readConfigFile (FilePath -> IO Configuration) -> FilePath -> IO Configuration
forall a b. (a -> b) -> a -> b
$ RTViewParams -> FilePath
rtvConfig RTViewParams
params'
        (Configuration, RTViewParams) -> IO (Configuration, RTViewParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration
configFromFile, RTViewParams
params')
      else
        IO (Maybe (Configuration, RTViewParams))
checkIfPreviousConfigExists IO (Maybe (Configuration, RTViewParams))
-> (Maybe (Configuration, RTViewParams)
    -> IO (Configuration, RTViewParams))
-> IO (Configuration, RTViewParams)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just (Configuration
prevConfig, RTViewParams
prevParams) -> do
            Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Magenta ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              Text -> IO ()
TIO.putStr Text
"Saved configuration file is found. Do you want to use it? <Y/N>: "
            Configuration -> RTViewParams -> IO (Configuration, RTViewParams)
askAboutPrevConfig Configuration
prevConfig RTViewParams
prevParams
          Maybe (Configuration, RTViewParams)
Nothing ->
            IO (Configuration, RTViewParams)
startDialogToPrepareConfig
  [RemoteAddrNamed]
acceptors <- Configuration -> IO [RemoteAddrNamed]
checkIfTraceAcceptorIsDefined Configuration
config
  [RemoteAddrNamed] -> IO ()
makeSureTraceAcceptorsAreUnique [RemoteAddrNamed]
acceptors
  -- To prevent TraceAcceptorPipeError "Network.Socket.bind: resource busy...
  [RemoteAddrNamed] -> IO ()
rmPipesIfNeeded [RemoteAddrNamed]
acceptors
  -- Configuration and parameters look good, save it for next sessions.
  Configuration -> IO ()
saveConfigurationForNextSessions Configuration
config
  RTViewParams -> IO ()
saveRTViewParamsForNextSessions RTViewParams
params
  (Configuration, RTViewParams, [RemoteAddrNamed])
-> IO (Configuration, RTViewParams, [RemoteAddrNamed])
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration
config, RTViewParams
params, [RemoteAddrNamed]
acceptors)

configFileIsProvided :: RTViewParams -> Bool
configFileIsProvided :: RTViewParams -> Bool
configFileIsProvided RTViewParams
params = Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ RTViewParams -> FilePath
rtvConfig RTViewParams
params

-- | Reads the program's configuration file (path is passed via '--config' CLI option).
readConfigFile :: FilePath -> IO Configuration
readConfigFile :: FilePath -> IO Configuration
readConfigFile FilePath
pathToConfig = FilePath -> IO Configuration
setup FilePath
pathToConfig IO Configuration
-> (IOException -> IO Configuration) -> IO Configuration
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO Configuration
exceptHandler
 where
  exceptHandler :: IOException -> IO Configuration
  exceptHandler :: IOException -> IO Configuration
exceptHandler IOException
e =
    FilePath -> IO Configuration
forall a. FilePath -> IO a
Ex.die (FilePath -> IO Configuration) -> FilePath -> IO Configuration
forall a b. (a -> b) -> a -> b
$ FilePath
"Exception while reading configuration "
             FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
pathToConfig
             FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", exception: "
             FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> IOException -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show IOException
e

readRTViewParamsFile :: FilePath -> IO RTViewParams
readRTViewParamsFile :: FilePath -> IO RTViewParams
readRTViewParamsFile FilePath
pathToParams =
  FilePath -> IO (Either ParseException RTViewParams)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
pathToParams IO (Either ParseException RTViewParams)
-> (Either ParseException RTViewParams -> IO RTViewParams)
-> IO RTViewParams
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (ParseException
e :: ParseException) -> FilePath -> IO RTViewParams
forall a. FilePath -> IO a
Ex.die (FilePath -> IO RTViewParams) -> FilePath -> IO RTViewParams
forall a b. (a -> b) -> a -> b
$ FilePath
"Exception while reading RTView parameters "
                                         FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
pathToParams FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", exception: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseException -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show ParseException
e
    Right (RTViewParams
params :: RTViewParams) -> RTViewParams -> IO RTViewParams
forall (m :: * -> *) a. Monad m => a -> m a
return RTViewParams
params

-- | If `cardano-rt-view` already was used on this computer,
--   the configuration was saved in user's local directory, which
--   differs on different platforms.
savedConfigurationFile :: IO FilePath
savedConfigurationFile :: IO FilePath
savedConfigurationFile = do
  -- For configuration files. It uses the XDG_CONFIG_HOME environment variable.
  -- On non-Windows systems, the default is ~/.config.
  -- On Windows, the default is %APPDATA% (e.g. C:/Users/<user>/AppData/Roaming).
  FilePath
dir <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
""
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"rt-view.yaml"

savedRTViewParamsFile :: IO FilePath
savedRTViewParamsFile :: IO FilePath
savedRTViewParamsFile = do
  FilePath
dir <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
""
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"rt-view-params.yaml"

checkIfPreviousConfigExists :: IO (Maybe (Configuration, RTViewParams))
checkIfPreviousConfigExists :: IO (Maybe (Configuration, RTViewParams))
checkIfPreviousConfigExists = do
  Bool
configExists <- IO FilePath
savedConfigurationFile IO FilePath -> (FilePath -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO Bool
doesFileExist
  Bool
paramsExist  <- IO FilePath
savedRTViewParamsFile IO FilePath -> (FilePath -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO Bool
doesFileExist
  if Bool
configExists Bool -> Bool -> Bool
&& Bool
paramsExist
    then do
      Configuration
config <- IO FilePath
savedConfigurationFile IO FilePath -> (FilePath -> IO Configuration) -> IO Configuration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO Configuration
readConfigFile
      RTViewParams
params <- IO FilePath
savedRTViewParamsFile IO FilePath -> (FilePath -> IO RTViewParams) -> IO RTViewParams
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO RTViewParams
readRTViewParamsFile
      Maybe (Configuration, RTViewParams)
-> IO (Maybe (Configuration, RTViewParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Configuration, RTViewParams)
 -> IO (Maybe (Configuration, RTViewParams)))
-> Maybe (Configuration, RTViewParams)
-> IO (Maybe (Configuration, RTViewParams))
forall a b. (a -> b) -> a -> b
$ (Configuration, RTViewParams)
-> Maybe (Configuration, RTViewParams)
forall a. a -> Maybe a
Just (Configuration
config, RTViewParams
params)
    else
      Maybe (Configuration, RTViewParams)
-> IO (Maybe (Configuration, RTViewParams))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Configuration, RTViewParams)
forall a. Maybe a
Nothing

askAboutPrevConfig
  :: Configuration
  -> RTViewParams
  -> IO (Configuration, RTViewParams)
askAboutPrevConfig :: Configuration -> RTViewParams -> IO (Configuration, RTViewParams)
askAboutPrevConfig Configuration
savedConfig RTViewParams
savedParams =
  IO Text
TIO.getLine IO Text
-> (Text -> IO (Configuration, RTViewParams))
-> IO (Configuration, RTViewParams)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"Y" -> (Configuration, RTViewParams) -> IO (Configuration, RTViewParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration
savedConfig, RTViewParams
savedParams)
    Text
"y" -> (Configuration, RTViewParams) -> IO (Configuration, RTViewParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration
savedConfig, RTViewParams
savedParams)
    Text
""  -> (Configuration, RTViewParams) -> IO (Configuration, RTViewParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration
savedConfig, RTViewParams
savedParams)
    Text
"N" -> IO (Configuration, RTViewParams)
startDialogToPrepareConfig
    Text
"n" -> IO (Configuration, RTViewParams)
startDialogToPrepareConfig
    Text
_   -> do
      Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
TIO.putStr Text
"Sorry? <Y>es or <N>o? "
      Configuration -> RTViewParams -> IO (Configuration, RTViewParams)
askAboutPrevConfig Configuration
savedConfig RTViewParams
savedParams

startDialogToPrepareConfig :: IO (Configuration, RTViewParams)
startDialogToPrepareConfig :: IO (Configuration, RTViewParams)
startDialogToPrepareConfig = do
  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Magenta ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    Text -> IO ()
TIO.putStrLn Text
"Let's configure RTView..."

  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Green ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"How many nodes will you connect (1 - "
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
maximumNode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", default is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
defaultNodesNumber Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): "
  Int
nodesNumber <- IO Int
askAboutNodesNumber
  Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
nodesNumber Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" nodes."

  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Green ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    let (Text
names :: Text, Text
nodes :: Text, Text
are :: Text, Text
oneAtATime :: Text)
          = if Int
nodesNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
              then (Text
"name",  Text
"node",  Text
"is",  Text
"")
              else (Text
"names", Text
"nodes", Text
"are", Text
", one at a time")
    Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Input the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
names Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nodes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (default " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
are Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \""
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
showDefaultNodesNames Int
nodesNumber Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oneAtATime Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
  [Text]
nodesNames <- Int -> IO [Text]
askAboutNodesNames Int
nodesNumber

  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Green ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Indicate the port for the web server (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
minimumPort
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
maximumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", default is "
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
defaultRTVPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): "
  Int
port <- IO Int
askAboutWebPort
  Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, the web-page will be available on http://"
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
defaultRTVHost Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
port
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", on the machine RTView will be launched on."

  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Green ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    Text -> IO ()
TIO.putStr Text
"Indicate how your nodes should be connected with RTView (pipes <P> or networking sockets <S>): "
  ([RemoteAddr]
remoteAddrs, FilePath
rtViewMachineHost) <- IO ConnectionWay
askAboutPipesAndSockets IO ConnectionWay
-> (ConnectionWay -> IO ([RemoteAddr], FilePath))
-> IO ([RemoteAddr], FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ConnectionWay
Pipe -> do
      FilePath
defDir <- IO FilePath
defaultPipesDir
      Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, pipes will be used. Indicate the directory for them, default is \""
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
defDir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\": "
      Handle -> IO ()
hFlush Handle
stdout
      [RemoteAddr]
addrs <- Int -> IO [RemoteAddr]
askAboutLocationForPipes Int
nodesNumber
      ([RemoteAddr], FilePath) -> IO ([RemoteAddr], FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteAddr]
addrs, FilePath
defaultRTVHost)
    ConnectionWay
Socket -> do
      Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, sockets will be used. Indicate the port base to listen for connections ("
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
minimumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
maximumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", default is "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
defaultFirstPortForSockets Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): "
      Handle -> IO ()
hFlush Handle
stdout
      [RemoteAddr]
addrsWithDefaultHost <- Int -> IO [RemoteAddr]
askAboutFirstPortForSockets Int
nodesNumber
      Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Now, indicate a host of machine RTView will be launched on (default is "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
defaultRTVHost Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): "
      Handle -> IO ()
hFlush Handle
stdout
      FilePath
host <- IO FilePath
askAboutRTViewMachineHost
      ([RemoteAddr], FilePath) -> IO ([RemoteAddr], FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteAddr]
addrsWithDefaultHost, FilePath
host)

  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Green ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Indicate the directory with static content for the web server, default is \""
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
defaultRTVStatic Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\": "
  FilePath
staticDir <- IO FilePath
askAboutStaticDir

  -- Form configuration and params based on user's input.
  Configuration
config <- IO Configuration
CM.empty
  Configuration -> Severity -> IO ()
CM.setMinSeverity Configuration
config Severity
Info
  Configuration -> [BackendKind] -> IO ()
CM.setSetupBackends Configuration
config [BackendKind
KatipBK, BackendKind
LogBufferBK, BackendKind
TraceAcceptorBK]
  Configuration -> [BackendKind] -> IO ()
CM.setDefaultBackends Configuration
config [BackendKind
KatipBK]
  Configuration -> [ScribeDefinition] -> IO ()
CM.setSetupScribes Configuration
config [ ScribeDefinition :: ScribeKind
-> ScribeFormat
-> Text
-> ScribePrivacy
-> Maybe RotationParameters
-> Severity
-> Severity
-> ScribeDefinition
ScribeDefinition
                              { scName :: Text
scName     = Text
"stdout"
                              , scKind :: ScribeKind
scKind     = ScribeKind
StdoutSK
                              , scFormat :: ScribeFormat
scFormat   = ScribeFormat
ScText
                              , scPrivacy :: ScribePrivacy
scPrivacy  = ScribePrivacy
ScPublic
                              , scMinSev :: Severity
scMinSev   = Severity
Notice
                              , scMaxSev :: Severity
scMaxSev   = Severity
forall a. Bounded a => a
maxBound
                              , scRotation :: Maybe RotationParameters
scRotation = Maybe RotationParameters
forall a. Maybe a
Nothing
                              }
                            ]
  Configuration -> [Text] -> IO ()
CM.setDefaultScribes Configuration
config [Text
"StdoutSK::stdout"]
  Configuration -> Text -> Maybe [BackendKind] -> IO ()
CM.setBackends Configuration
config Text
"cardano-rt-view.acceptor" ([BackendKind] -> Maybe [BackendKind]
forall a. a -> Maybe a
Just [ BackendKind
LogBufferBK
                                                         , Text -> BackendKind
UserDefinedBK Text
"ErrorBufferBK"
                                                         ])
  let remoteAddrsNamed :: [RemoteAddrNamed]
remoteAddrsNamed = ((Text, RemoteAddr) -> RemoteAddrNamed)
-> [(Text, RemoteAddr)] -> [RemoteAddrNamed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Text -> RemoteAddr -> RemoteAddrNamed)
-> (Text, RemoteAddr) -> RemoteAddrNamed
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> RemoteAddr -> RemoteAddrNamed
RemoteAddrNamed)
                             ([(Text, RemoteAddr)] -> [RemoteAddrNamed])
-> [(Text, RemoteAddr)] -> [RemoteAddrNamed]
forall a b. (a -> b) -> a -> b
$ [Text] -> [RemoteAddr] -> [(Text, RemoteAddr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
nodesNames [RemoteAddr]
remoteAddrs
  Configuration -> Maybe [RemoteAddrNamed] -> IO ()
CM.setAcceptAt Configuration
config ([RemoteAddrNamed] -> Maybe [RemoteAddrNamed]
forall a. a -> Maybe a
Just [RemoteAddrNamed]
remoteAddrsNamed)

  let params :: RTViewParams
params = RTViewParams
defaultRTViewParams { rtvPort :: Int
rtvPort = Int
port
                                   , rtvStatic :: FilePath
rtvStatic = FilePath
staticDir
                                   }
  -- Now show to the user the changes that should be done in node's configuration file.
  Configuration -> FilePath -> IO ()
showChangesInNodeConfiguration Configuration
config FilePath
rtViewMachineHost

  (Configuration, RTViewParams) -> IO (Configuration, RTViewParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration
config, RTViewParams
params)

defaultNodesNumber :: Int
defaultNodesNumber :: Int
defaultNodesNumber = Int
3

maximumNode :: Int
maximumNode :: Int
maximumNode = Int
99

defaultNodeNamePrefix :: Text
defaultNodeNamePrefix :: Text
defaultNodeNamePrefix = Text
"node-"

defaultNodesNames :: Int -> [Text]
defaultNodesNames :: Int -> [Text]
defaultNodesNames Int
nodesNum = (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Int
nNum -> Text
defaultNodeNamePrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
nNum) [Int
1 .. Int
nodesNum]

showDefaultNodesNames :: Int -> Text
showDefaultNodesNames :: Int -> Text
showDefaultNodesNames Int
nodesNumber =
  Text -> [Text] -> Text
T.intercalate Text
"\", \"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text]
defaultNodesNames Int
nodesNumber

defaultFirstPortForSockets :: Int
defaultFirstPortForSockets :: Int
defaultFirstPortForSockets = Int
3000

defaultRTVHost :: String
defaultRTVHost :: FilePath
defaultRTVHost = FilePath
"0.0.0.0"

minimumPort, maximumPort :: Int
minimumPort :: Int
minimumPort = Int
1024
maximumPort :: Int
maximumPort = Int
65535

defaultPipesDir :: IO FilePath
defaultPipesDir :: IO FilePath
defaultPipesDir = do
  FilePath
tmp0 <- IO FilePath
getTemporaryDirectory
  let tmp :: FilePath
tmp =
#if defined(mingw32_HOST_OS)
          "\\\\.\\pipe\\" ++ (T.unpack . T.replace "\\" "-" . T.pack) (dropDrive tmp0) ++ "_"
#else
          FilePath
tmp0 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/"
#endif
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"rt-view-pipes"

askAboutNodesNumber :: IO Int
askAboutNodesNumber :: IO Int
askAboutNodesNumber = do
  Text
nodesNumberRaw <- IO Text
TIO.getLine
  Int
nodesNumber <-
    if Text -> Bool
T.null Text
nodesNumberRaw
      then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
defaultNodesNumber
      else case FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
T.unpack Text
nodesNumberRaw) of
             Just (Int
n :: Int) -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
             Maybe Int
Nothing -> do
               Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 Text -> IO ()
TIO.putStr Text
"It's not a number, please input the number instead: "
               IO Int
askAboutNodesNumber
  if Int
nodesNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
nodesNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maximumNode
    then do
      Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Wrong number of nodes, please input the number from 1 to "
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
maximumNode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
      IO Int
askAboutNodesNumber
    else
      Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
nodesNumber

askAboutNodesNames :: Int -> IO [Text]
askAboutNodesNames :: Int -> IO [Text]
askAboutNodesNames Int
nodesNumber = Int -> IO [Text]
askNodeNames Int
1
 where
   askNodeNames :: Int -> IO [Text]
   askNodeNames :: Int -> IO [Text]
askNodeNames Int
i = do
     Text
aName <- Int -> IO Text
askNodeName Int
i
     if | Text -> Bool
T.null Text
aName Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
            Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, default " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nNames Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
showDefaultNodesNames Int
nodesNumber
                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" will be used."
            [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text]
defaultNodesNames Int
nodesNumber
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nodesNumber -> do
            let last :: Text
                last :: Text
last = if Int
nodesNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"last "
            Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
last Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"node has name \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"."
            [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
aName]
        | Bool
otherwise -> do
            Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, node " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has name \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aName
                         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\", input the next one: "
            Handle -> IO ()
hFlush Handle
stdout
            [Text]
names <- Int -> IO [Text]
askNodeNames (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ Text
aName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
names

   askNodeName :: Int -> IO Text
   askNodeName :: Int -> IO Text
askNodeName Int
i = do
    Text
aName <- IO Text
TIO.getLine
    if | Text -> Bool
T.null Text
aName Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
           Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       | Text -> Bool
T.null Text
aName Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 -> do
           Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Text -> IO ()
TIO.putStr Text
"Node's name cannot be empty, please input again: "
           Int -> IO Text
askNodeName Int
i
       | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
aName -> do
           Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Text -> IO ()
TIO.putStr Text
"Node's name cannot contain spaces, please input again: "
           Int -> IO Text
askNodeName Int
i
       | Bool
otherwise -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
aName

   nNames :: Text
   nNames :: Text
nNames = if Int
nodesNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"name" else Text
"names"

askAboutWebPort :: IO Int
askAboutWebPort :: IO Int
askAboutWebPort = do
  Text
portRaw <- IO Text
TIO.getLine
  Int
port <-
    if Text -> Bool
T.null Text
portRaw
      then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
defaultRTVPort
      else case FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
T.unpack Text
portRaw) of
             Just (Int
n :: Int) -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
             Maybe Int
Nothing -> do
               Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 Text -> IO ()
TIO.putStr Text
"It's not a number, please input the number instead: "
               IO Int
askAboutWebPort
  if Int
port Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minimumPort Bool -> Bool -> Bool
|| Int
port Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maximumPort
    then do
      Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Please choose the port between " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
minimumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and "
                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
maximumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
      IO Int
askAboutWebPort
    else
      Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
port

data ConnectionWay
  = Pipe
  | Socket

askAboutPipesAndSockets :: IO ConnectionWay
askAboutPipesAndSockets :: IO ConnectionWay
askAboutPipesAndSockets =
  IO Text
TIO.getLine IO Text -> (Text -> IO ConnectionWay) -> IO ConnectionWay
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"P" -> ConnectionWay -> IO ConnectionWay
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionWay
Pipe
    Text
"p" -> ConnectionWay -> IO ConnectionWay
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionWay
Pipe
    Text
""  -> ConnectionWay -> IO ConnectionWay
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionWay
Pipe
    Text
"S" -> ConnectionWay -> IO ConnectionWay
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionWay
Socket
    Text
"s" -> ConnectionWay -> IO ConnectionWay
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectionWay
Socket
    Text
_   -> do
      Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
TIO.putStr Text
"Sorry? <P>ipes or <S>ockets? "
      IO ConnectionWay
askAboutPipesAndSockets

askAboutLocationForPipes :: Int -> IO [RemoteAddr]
askAboutLocationForPipes :: Int -> IO [RemoteAddr]
askAboutLocationForPipes Int
nodesNumber = do
  Text
dir <- Text -> Text
T.strip (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
TIO.getLine
  if Text -> Bool
T.null Text
dir
    then do
      FilePath
defDir <- IO FilePath
defaultPipesDir
      Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, default directory \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
defDir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" will be used."
      FilePath -> IO ()
mkdir FilePath
defDir
      [RemoteAddr] -> IO [RemoteAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteAddr] -> IO [RemoteAddr])
-> [RemoteAddr] -> IO [RemoteAddr]
forall a b. (a -> b) -> a -> b
$ FilePath -> [RemoteAddr]
mkpipe FilePath
defDir
    else do
      Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, directory \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" will be used for the pipes."
      FilePath -> IO ()
mkdir (Text -> FilePath
T.unpack Text
dir)
      [RemoteAddr] -> IO [RemoteAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteAddr] -> IO [RemoteAddr])
-> [RemoteAddr] -> IO [RemoteAddr]
forall a b. (a -> b) -> a -> b
$ FilePath -> [RemoteAddr]
mkpipe (Text -> FilePath
T.unpack Text
dir)
 where
  mkdir :: FilePath -> IO ()
  prepname :: FilePath -> Text -> FilePath
#if defined(mingw32_HOST_OS)
  mkdir _ = pure ()
  prepname d n = d <> "_" <> T.unpack n
#else
  mkdir :: FilePath -> IO ()
mkdir = Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True
  prepname :: FilePath -> Text -> FilePath
prepname FilePath
d Text
n = FilePath
d FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack Text
n
#endif
  mkpipe :: FilePath -> [RemoteAddr]
  mkpipe :: FilePath -> [RemoteAddr]
mkpipe FilePath
d = (Text -> RemoteAddr) -> [Text] -> [RemoteAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (FilePath -> RemoteAddr
RemotePipe (FilePath -> RemoteAddr)
-> (Text -> FilePath) -> Text -> RemoteAddr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> Text -> FilePath
prepname FilePath
d) ([Text] -> [RemoteAddr]) -> [Text] -> [RemoteAddr]
forall a b. (a -> b) -> a -> b
$
                 Int -> [Text]
defaultNodesNames Int
nodesNumber

askAboutFirstPortForSockets :: Int -> IO [RemoteAddr]
askAboutFirstPortForSockets :: Int -> IO [RemoteAddr]
askAboutFirstPortForSockets Int
nodesNumber = do
  Int
firstPort <- IO Int
askAboutFirstPort
  let portsForAllNodes :: [Int]
portsForAllNodes = [Int
firstPort .. Int
firstPort Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nodesNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, these ports will be used to accept nodes' metrics: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
showPorts [Int]
portsForAllNodes
  [RemoteAddr] -> IO [RemoteAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RemoteAddr] -> IO [RemoteAddr])
-> [RemoteAddr] -> IO [RemoteAddr]
forall a b. (a -> b) -> a -> b
$ (Int -> RemoteAddr) -> [Int] -> [RemoteAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (FilePath -> FilePath -> RemoteAddr
RemoteSocket FilePath
defaultRTVHost (FilePath -> RemoteAddr) -> (Int -> FilePath) -> Int -> RemoteAddr
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show) [Int]
portsForAllNodes
 where
  showPorts :: [Int] -> Text
  showPorts :: [Int] -> Text
showPorts [Int]
ports = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show) [Int]
ports

askAboutFirstPort :: IO Int
askAboutFirstPort :: IO Int
askAboutFirstPort = do
  Text
portRaw <- IO Text
TIO.getLine
  Int
port <-
    if Text -> Bool
T.null Text
portRaw
      then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
defaultFirstPortForSockets
      else case FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
T.unpack Text
portRaw) of
             Just (Int
n :: Int) -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
             Maybe Int
Nothing -> do
               Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                 Text -> IO ()
TIO.putStr Text
"It's not a number, please input the number instead: "
               IO Int
askAboutFirstPort
  if Int
port Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minimumPort Bool -> Bool -> Bool
|| Int
port Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maximumPort
    then do
      Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Red ConsoleIntensity
NormalIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Please choose the port between " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
minimumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and "
                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
maximumPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
      IO Int
askAboutFirstPort
    else
      Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
port

askAboutRTViewMachineHost :: IO String
askAboutRTViewMachineHost :: IO FilePath
askAboutRTViewMachineHost = do
  Text
host <- Text -> Text
T.strip (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
TIO.getLine
  if Text -> Bool
T.null Text
host
    then do
      Text -> IO ()
TIO.putStrLn Text
"Ok, default host will be used."
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return  FilePath
defaultRTVHost
    else do
      Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, it is assumed that RTView will be launched on the host \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"."
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
host

askAboutStaticDir :: IO FilePath
askAboutStaticDir :: IO FilePath
askAboutStaticDir = do
  Text
dir <- Text -> Text
T.strip (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
TIO.getLine
  if Text -> Bool
T.null Text
dir
    then do
      Text -> IO ()
TIO.putStrLn Text
"Ok, default directory will be used."
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
defaultRTVStatic
    else do
      Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Ok, static content will be taken from directory \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"."
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
dir

showChangesInNodeConfiguration :: Configuration -> String -> IO ()
showChangesInNodeConfiguration :: Configuration -> FilePath -> IO ()
showChangesInNodeConfiguration Configuration
config FilePath
rtViewMachineHost = do
  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Magenta ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStrLn Text
""
    FilePath
aPath <- IO FilePath
savedConfigurationFile
    Text -> IO ()
TIO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Great, RTView is ready to run! Its configuration was saved at "
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
aPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Press <Enter> to continue..."
  IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Text
TIO.getLine
  Text -> IO ()
TIO.putStrLn Text
""
  Text -> IO ()
TIO.putStrLn Text
"Now you have to make the following changes in your node's configuration file:"
  Text -> IO ()
TIO.putStrLn Text
""
  IO ()
enableTraceForwarderBK
  IO ()
enableMetricsTracing
  IO ()
mapBackendsExamples
  IO ()
addTraceForwardTo
  Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Magenta ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
TIO.putStr Text
"After you are done, press <Enter> to run RTView..."
  IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Text
TIO.getLine
 where
  enableTraceForwarderBK :: IO ()
enableTraceForwarderBK = do
    Text -> IO ()
TIO.putStrLn Text
"1. Find setupBackends and add TraceForwarderBK in it:"
    Text -> IO ()
TIO.putStrLn Text
""
    Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Yellow ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> IO ()
TIO.putStrLn Text
"   setupBackends:"
      Text -> IO ()
TIO.putStrLn Text
"     - TraceForwarderBK"
    Text -> IO ()
TIO.putStrLn Text
""

  enableMetricsTracing :: IO ()
enableMetricsTracing = do
    Text -> IO ()
TIO.putStrLn Text
"2. Find TurnOnLogMetrics and set it to True:"
    Text -> IO ()
TIO.putStrLn Text
""
    Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Yellow ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Text -> IO ()
TIO.putStrLn Text
"   TurnOnLogMetrics: True"
    Text -> IO ()
TIO.putStrLn Text
""

  mapBackendsExamples :: IO ()
mapBackendsExamples = do
    Text -> IO ()
TIO.putStrLn Text
"3. Find options -> mapBackends and redirect required metrics to TraceForwarderBK, for example:"
    Text -> IO ()
TIO.putStrLn Text
""
    Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Yellow ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> IO ()
TIO.putStrLn Text
"   options:"
      Text -> IO ()
TIO.putStrLn Text
"     mapBackends:"
      Text -> IO ()
TIO.putStrLn Text
"       cardano.node.metrics:"
      Text -> IO ()
TIO.putStrLn Text
"         - TraceForwarderBK"
      Text -> IO ()
TIO.putStrLn Text
"       cardano.node.Forge.metrics:"
      Text -> IO ()
TIO.putStrLn Text
"         - TraceForwarderBK"
      Text -> IO ()
TIO.putStrLn Text
""
    Text -> IO ()
TIO.putStrLn Text
"   For more info about supported metrics please read the documentation."
    Text -> IO ()
TIO.putStrLn Text
""

  addTraceForwardTo :: IO ()
addTraceForwardTo = do
    [RemoteAddrNamed]
acceptors <- Maybe [RemoteAddrNamed] -> [RemoteAddrNamed]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [RemoteAddrNamed] -> [RemoteAddrNamed])
-> IO (Maybe [RemoteAddrNamed]) -> IO [RemoteAddrNamed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> IO (Maybe [RemoteAddrNamed])
CM.getAcceptAt Configuration
config
    let num :: Int
num = [RemoteAddrNamed] -> Int
forall a. HasLength a => a -> Int
length [RemoteAddrNamed]
acceptors
        (Text
nNodes :: Text, Text
sections :: Text, Text
its :: Text, Text
nFiles :: Text) =
          if Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
            then (Text
"1 node",             Text
"section",  Text
"its",   Text
"file")
            else (Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" nodes", Text
"sections", Text
"their", Text
"files")
    Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"4. Since you have "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nNodes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", add following traceForwardTo "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sections Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the root of "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
its Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" configuration "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nFiles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
    Text -> IO ()
TIO.putStrLn Text
""
    [RemoteAddrNamed] -> (RemoteAddrNamed -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RemoteAddrNamed]
acceptors ((RemoteAddrNamed -> IO ()) -> IO ())
-> (RemoteAddrNamed -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
_ RemoteAddr
addr) -> Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
Yellow ConsoleIntensity
BoldIntensity (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> IO ()
TIO.putStrLn       Text
"   traceForwardTo:"
      case RemoteAddr
addr of
        RemoteSocket FilePath
_ FilePath
port -> do
          Text -> IO ()
TIO.putStrLn   Text
"     tag: RemoteSocket"
          Text -> IO ()
TIO.putStrLn   Text
"     contents:"
          Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"       - \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
rtViewMachineHost Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
          Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"       - \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
port Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
        RemotePipe FilePath
path -> do
          Text -> IO ()
TIO.putStrLn   Text
"     tag: RemotePipe"
#if defined(mingw32_HOST_OS)
          -- We have to escape backslashes on Windows, to avoid an error in the configuration.
          TIO.putStrLn $ "     contents: \"" <> prepareForWindows (T.pack path) <> "\""
#else
          Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"     contents: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
#endif
      Text -> IO ()
TIO.putStrLn Text
""

#if defined(mingw32_HOST_OS)
  -- For example, default pipe path should be displayed like this
  --
  -- "\\\\.\\pipe\\Users-Dorin-AppData-Local-Temp-_rt-view-pipes_node-1"
  --
  -- instead of
  --
  -- "\\.\pipe\Users-Dorin-AppData-Local-Temp-_rt-view-pipes_node-1"
  prepareForWindows = T.concatMap (\c -> if c == '\\' then "\\\\" else T.singleton c)
#endif

rmPipesIfNeeded :: [RemoteAddrNamed] -> IO ()
#if defined(mingw32_HOST_OS)
rmPipesIfNeeded _ = pure ()
#else
rmPipesIfNeeded :: [RemoteAddrNamed] -> IO ()
rmPipesIfNeeded [RemoteAddrNamed]
acceptors = do
  let pipesDirs :: [FilePath]
pipesDirs = (RemoteAddrNamed -> FilePath) -> [RemoteAddrNamed] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RemoteAddrNamed -> FilePath
collectPipesDirs [RemoteAddrNamed]
acceptors
  [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
pipesDirs ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
dir ->
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [FilePath]
allFiles <- FilePath -> IO [FilePath]
listDirectory FilePath
dir
      let allPipes :: [FilePath]
allPipes = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
file -> Text
defaultNodeNamePrefix Text -> Text -> Bool
`T.isPrefixOf` FilePath -> Text
T.pack FilePath
file) [FilePath]
allFiles
      [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
allPipes ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
pipe -> FilePath -> IO ()
removeFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
pipe)
 where
  collectPipesDirs :: RemoteAddrNamed -> FilePath
collectPipesDirs (RemoteAddrNamed Text
_ (RemoteSocket FilePath
_ FilePath
_)) = FilePath
""
  collectPipesDirs (RemoteAddrNamed Text
_ (RemotePipe FilePath
path)) = FilePath -> FilePath
takeDirectory FilePath
path
#endif

saveConfigurationForNextSessions :: Configuration -> IO ()
saveConfigurationForNextSessions :: Configuration -> IO ()
saveConfigurationForNextSessions Configuration
config = do
  FilePath
path <- IO FilePath
savedConfigurationFile
  Configuration -> IO Representation
CM.toRepresentation Configuration
config IO Representation -> (Representation -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Representation -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile FilePath
path

saveRTViewParamsForNextSessions :: RTViewParams -> IO ()
saveRTViewParamsForNextSessions :: RTViewParams -> IO ()
saveRTViewParamsForNextSessions RTViewParams
params = do
  FilePath
path <- IO FilePath
savedRTViewParamsFile
  FilePath -> RTViewParams -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile FilePath
path RTViewParams
params

-- | RTView requires at least one |TraceAcceptor|.
checkIfTraceAcceptorIsDefined
  :: Configuration
  -> IO [RemoteAddrNamed]
checkIfTraceAcceptorIsDefined :: Configuration -> IO [RemoteAddrNamed]
checkIfTraceAcceptorIsDefined Configuration
config =
  Configuration -> IO (Maybe [RemoteAddrNamed])
getAcceptAt Configuration
config IO (Maybe [RemoteAddrNamed])
-> (Maybe [RemoteAddrNamed] -> IO [RemoteAddrNamed])
-> IO [RemoteAddrNamed]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just [RemoteAddrNamed]
acceptors -> [RemoteAddrNamed] -> IO [RemoteAddrNamed]
forall (m :: * -> *) a. Monad m => a -> m a
return [RemoteAddrNamed]
acceptors
    Maybe [RemoteAddrNamed]
Nothing -> FilePath -> IO [RemoteAddrNamed]
forall a. FilePath -> IO a
Ex.die FilePath
"No trace acceptors found in the configuration, please add at leas one."

-- | If configuration contains more than one trace acceptor,
--   check if they are unique, to avoid socket problems.
makeSureTraceAcceptorsAreUnique
  :: [RemoteAddrNamed]
  -> IO ()
makeSureTraceAcceptorsAreUnique :: [RemoteAddrNamed] -> IO ()
makeSureTraceAcceptorsAreUnique [RemoteAddrNamed]
acceptors = do
  IO ()
checkIfNodesNamesAreUnique
  IO ()
checkIfNetParametersAreUnique
 where
  checkIfNodesNamesAreUnique :: IO ()
checkIfNodesNamesAreUnique =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text] -> Int
forall a. HasLength a => a -> Int
length [Text]
names Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text] -> Int
forall a. HasLength a => a -> Int
length ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
names)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ()
forall a. FilePath -> IO a
Ex.die FilePath
"Nodes' names in trace acceptors must be unique!"

  checkIfNetParametersAreUnique :: IO ()
checkIfNetParametersAreUnique =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([RemoteAddr] -> Int
forall a. HasLength a => a -> Int
length [RemoteAddr]
addrs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [RemoteAddr] -> Int
forall a. HasLength a => a -> Int
length ((RemoteAddr -> RemoteAddr -> Bool) -> [RemoteAddr] -> [RemoteAddr]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy RemoteAddr -> RemoteAddr -> Bool
compareNetParams [RemoteAddr]
addrs)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ()
forall a. FilePath -> IO a
Ex.die FilePath
"Nodes' network parameters in trace acceptors must be unique!"

  compareNetParams :: RemoteAddr -> RemoteAddr -> Bool
compareNetParams (RemoteSocket FilePath
h1 FilePath
p1) (RemoteSocket FilePath
h2 FilePath
p2) = FilePath
h1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
h2 Bool -> Bool -> Bool
&& FilePath
p1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
p2
  compareNetParams (RemoteSocket FilePath
_ FilePath
_)   (RemotePipe FilePath
_)       = Bool
False
  compareNetParams (RemotePipe FilePath
_)       (RemoteSocket FilePath
_ FilePath
_)   = Bool
False
  compareNetParams (RemotePipe FilePath
p1)      (RemotePipe FilePath
p2)      = FilePath
p1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
p2

  names :: [Text]
names = [Text
name | RemoteAddrNamed Text
name RemoteAddr
_ <- [RemoteAddrNamed]
acceptors]
  addrs :: [RemoteAddr]
addrs = [RemoteAddr
addr | RemoteAddrNamed Text
_ RemoteAddr
addr <- [RemoteAddrNamed]
acceptors]

colorize :: Color -> ConsoleIntensity -> IO () -> IO ()
colorize :: Color -> ConsoleIntensity -> IO () -> IO ()
colorize Color
color ConsoleIntensity
intensity IO ()
action = do
  [SGR] -> IO ()
setSGR [ ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
intensity
         , ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
color
         ]
  IO ()
action
  [SGR] -> IO ()
setSGR [SGR
Reset]
  Handle -> IO ()
hFlush Handle
stdout -- Truly resets text color to default one.