<commit_before>{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeSynonymInstances  #-}

import           Universum

import           Control.Concurrent (modifyMVar_)
import           Control.Concurrent.Async.Lifted.Safe (Async, async, cancel, poll, wait, waitAny,
                                                       withAsync, withAsyncWithUnmask)
import           Control.Exception.Safe (tryAny)
import           Control.Lens (makeLensesWith)
import           Data.Aeson (FromJSON, Value (Array, Bool, Object), genericParseJSON, withObject)
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.HashMap.Strict as HM
import           Data.List (isSuffixOf)
import           Data.Maybe (isNothing)
import qualified Data.Text as T (replace)
import qualified Data.Text.IO as T
import           Data.Time.Units (Second, convertUnit)
import           Data.Version (showVersion)
import qualified Data.Yaml as Y
import           Formatting (int, sformat, shown, stext, string, (%))
import qualified NeatInterpolation as Q (text)
import           Options.Applicative (Parser, execParser, footerDoc, fullDesc, header, help, helper,
                                      info, infoOption, long, metavar, progDesc, short, strOption)
import           Serokell.Aeson.Options (defaultOptions)
import           System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
import           System.Environment (getEnv, getExecutablePath)
import           System.Exit (ExitCode (..))
import           System.FilePath ((</>))
import qualified System.IO as IO
import           System.Process (ProcessHandle, waitForProcess)
import qualified System.Process as Process
import           System.Timeout (timeout)
import           System.Wlog (logError, logInfo, logNotice, logWarning)
import qualified System.Wlog as Log
import           Text.PrettyPrint.ANSI.Leijen (Doc)

#ifdef mingw32_HOST_OS
import qualified System.IO.Silently as Silently
#else
import           System.Posix.Signals (sigKILL, signalProcess)
import qualified System.Process.Internals as Process
#endif

-- Modules needed for system'
import           Control.Exception (handle, mask_, throwIO)
import           Foreign.C.Error (Errno (..), ePIPE)
import           GHC.IO.Exception (IOErrorType (..), IOException (..))

import           Paths_cardano_sl (version)
import           Pos.Client.CLI (readLoggerConfig)
import           Pos.Core (HasConfiguration, Timestamp (..))
import           Pos.DB.Block (dbGetSerBlockRealDefault, dbGetSerUndoRealDefault,
                               dbPutSerBlundRealDefault)
import           Pos.DB.Class (MonadDB (..), MonadDBRead (..))
import           Pos.DB.Rocks (NodeDBs, closeNodeDBs, dbDeleteDefault, dbGetDefault,
                               dbIterSourceDefault, dbPutDefault, dbWriteBatchDefault, openNodeDBs)
import           Pos.Launcher (HasConfigurations, withConfigurations)
import           Pos.Launcher.Configuration (ConfigurationOptions (..))
import           Pos.Reporting.Methods (compressLogs, retrieveLogFiles, sendReport)
import           Pos.ReportServer.Report (ReportType (..))
import           Pos.Update (installerHash)
import           Pos.Update.DB.Misc (affirmUpdateInstalled)
import           Pos.Util (HasLens (..), directory, postfixLFields, sleep)
import           Pos.Util.CompileInfo (HasCompileInfo, retrieveCompileTimeInfo, withCompileInfo)

data LauncherOptions = LO
    { loNodePath            :: !FilePath
    , loNodeArgs            :: ![Text]
    , loNodeDbPath          :: !FilePath
    , loNodeLogConfig       :: !(Maybe FilePath)
    , loNodeLogPath         :: !(Maybe FilePath)
    , loWalletPath          :: !(Maybe FilePath)
    , loWalletArgs          :: ![Text]
    , loWalletLogging       :: !Bool
    , loWalletLogPath       :: !(Maybe FilePath)
    , loUpdaterPath         :: !FilePath
    , loUpdaterArgs         :: ![Text]
    , loUpdateArchive       :: !(Maybe FilePath)
    , loUpdateWindowsRunner :: !(Maybe FilePath)
    , loNodeTimeoutSec      :: !Int
    , loReportServer        :: !(Maybe String)
    , loConfiguration       :: !ConfigurationOptions
    -- | Launcher logs will be written into this directory (as well as to
    -- console, except on Windows where we don't output anything to console
    -- because it crashes).
    , loLauncherLogsPrefix  :: !(Maybe FilePath)
    } deriving (Generic)

instance FromJSON LauncherOptions where
    parseJSON = withObject "LauncherOptions" $ \o ->
        genericParseJSON defaultOptions $ Object $
            -- This provides default values for some keys and
            -- allows not specifying them in the configuration
            -- file at all. @<>@ for hashmaps is left-biased,
            -- so it only adds new keys if there are aren't
            -- any yet.
            o <> HM.fromList
                [ ("walletLogging", Bool False)
                , ("nodeArgs",      Array mempty)
                , ("walletArgs",    Array mempty)
                , ("updaterArgs",   Array mempty)
                ]

-- | The concrete monad where everything happens
type M a = (HasConfigurations, HasCompileInfo) => Log.LoggerNameBox IO a

data Executable = EWallet | ENode | EUpdater

newtype ConfigPath = ConfigPath
    { unConfigPath :: FilePath
    }

data LauncherConfigParseError = LauncherConfigParseError !FilePath !(Y.ParseException)
    deriving (Show)

instance Exception LauncherConfigParseError

configPathParser :: Parser ConfigPath
configPathParser = do
    configPath <- strOption $
        short   'c' <>
        long    "config" <>
        help    "Path to the launcher configuration file." <>
        metavar "PATH"
    pure $ ConfigPath configPath

getLauncherOptions :: IO LauncherOptions
getLauncherOptions = do
    configPath <- unConfigPath <$> execParser programInfo
    decoded <- Y.decodeFileEither configPath
    case decoded of
        Left err -> do
#ifdef mingw32_HOST_OS
            logDir <- (</> "Daedalus\\Logs") <$> getEnv "APPDATA"
#else
            logDir <- (</> "Library/Application Support/Daedalus/Logs") <$> getEnv "HOME"
#endif
            writeFile (logDir </> "config-error.log") $
                sformat ("Failed to parse "%string%": "%shown) configPath err
            throwM $ LauncherConfigParseError configPath err
        Right op -> expandVars op
  where
    programInfo = info (helper <*> versionOption <*> configPathParser) $
        fullDesc <> progDesc ""
                 <> header "Tool to launch Cardano SL."
                 <> footerDoc usageExample

    versionOption = infoOption
        ("cardano-launcher-" <> showVersion version)
        (long "version" <> help "Show version.")

    -- Poor man's environment variable expansion.
    expandVars :: LauncherOptions -> IO LauncherOptions
#ifdef mingw32_HOST_OS
    expandVars lo@(LO {..}) = do
        -- %APPDATA%: nodeArgs, nodeDbPath,
        --     nodeLogPath, updaterPath,
        --     updateWindowsRunner, launcherLogsPrefix
        -- %DAEDALUS_DIR%: nodePath, walletPath
        appdata <- toText <$> getEnv "APPDATA"
        daedalusDir <- toText <$> getEnv "DAEDALUS_DIR"
        let replaceAppdata = replace "%APPDATA%" appdata
            replaceDaedalusDir = replace "%DAEDALUS_DIR%" daedalusDir
        pure lo
            { loNodeArgs            = map (T.replace "%APPDATA%" appdata) loNodeArgs
            , loNodeDbPath          = replaceAppdata loNodeDbPath
            , loNodeLogPath         = replaceAppdata <$> loNodeLogPath
            , loUpdaterPath         = replaceAppdata loUpdaterPath
            , loUpdateWindowsRunner = replaceAppdata <$> loUpdateWindowsRunner
            , loLauncherLogsPrefix  = replaceAppdata <$> loLauncherLogsPrefix
            , loNodePath            = replaceDaedalusDir loNodePath
            , loWalletPath          = replaceDaedalusDir <$> loWalletPath
            }
#else
    expandVars lo@(LO {..}) = do
        home <- toText <$> getEnv "HOME"
        let replaceHome = replace "$HOME" home
        pure lo
            { loNodeArgs           = map (T.replace "$HOME" home) loNodeArgs
            , loNodeDbPath         = replaceHome loNodeDbPath
            , loNodeLogPath        = replaceHome <$> loNodeLogPath
            , loUpdateArchive      = replaceHome <$> loUpdateArchive
            , loLauncherLogsPrefix = replaceHome <$> loLauncherLogsPrefix
            }
#endif
    replace :: Text -> Text -> FilePath -> FilePath
    replace from to = toString . T.replace from to . toText

usageExample :: Maybe Doc
usageExample = (Just . fromString @Doc . toString @Text) [Q.text|
Command example:

  stack exec -- cardano-launcher --config launcher-config.yaml

See tools/src/launcher/launcher-config.yaml for
an example of the config file.|]

data LauncherModeContext = LauncherModeContext { lmcNodeDBs :: NodeDBs }

makeLensesWith postfixLFields ''LauncherModeContext

type LauncherMode = ReaderT LauncherModeContext IO
<commit_msg>[CSL-1918] Add CLI parameter for %DAEDALUS_DIR%<commit_after>{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeSynonymInstances  #-}

import           Universum

import           Control.Concurrent (modifyMVar_)
import           Control.Concurrent.Async.Lifted.Safe (Async, async, cancel, poll, wait, waitAny,
                                                       withAsync, withAsyncWithUnmask)
import           Control.Exception.Safe (tryAny)
import           Control.Lens (makeLensesWith)
import           Data.Aeson (FromJSON, Value (Array, Bool, Object), genericParseJSON, withObject)
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.HashMap.Strict as HM
import           Data.List (isSuffixOf)
import           Data.Maybe (isNothing)
import qualified Data.Text as T (replace)
import qualified Data.Text.IO as T
import           Data.Time.Units (Second, convertUnit)
import           Data.Version (showVersion)
import qualified Data.Yaml as Y
import           Formatting (int, sformat, shown, stext, string, (%))
import qualified NeatInterpolation as Q (text)
import           Options.Applicative (Parser, execParser, footerDoc, fullDesc, header, help, helper,
                                      info, infoOption, long, metavar, progDesc, short, strOption)
import           Serokell.Aeson.Options (defaultOptions)
import           System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
import           System.Environment (getEnv, getEnvironment, getExecutablePath, lookupEnv)
import           System.Exit (ExitCode (..))
import           System.FilePath ((</>))
import qualified System.IO as IO
import           System.Process (ProcessHandle, waitForProcess)
import qualified System.Process as Process
import           System.Timeout (timeout)
import           System.Wlog (logError, logInfo, logNotice, logWarning)
import qualified System.Wlog as Log
import           Text.PrettyPrint.ANSI.Leijen (Doc)

#ifdef mingw32_HOST_OS
import qualified System.IO.Silently as Silently
#else
import           System.Posix.Signals (sigKILL, signalProcess)
import qualified System.Process.Internals as Process
#endif

-- Modules needed for system'
import           Control.Exception (handle, mask_, throwIO)
import           Foreign.C.Error (Errno (..), ePIPE)
import           GHC.IO.Exception (IOErrorType (..), IOException (..))

import           Paths_cardano_sl (version)
import           Pos.Client.CLI (readLoggerConfig)
import           Pos.Core (HasConfiguration, Timestamp (..))
import           Pos.DB.Block (dbGetSerBlockRealDefault, dbGetSerUndoRealDefault,
                               dbPutSerBlundRealDefault)
import           Pos.DB.Class (MonadDB (..), MonadDBRead (..))
import           Pos.DB.Rocks (NodeDBs, closeNodeDBs, dbDeleteDefault, dbGetDefault,
                               dbIterSourceDefault, dbPutDefault, dbWriteBatchDefault, openNodeDBs)
import           Pos.Launcher (HasConfigurations, withConfigurations)
import           Pos.Launcher.Configuration (ConfigurationOptions (..))
import           Pos.Reporting.Methods (compressLogs, retrieveLogFiles, sendReport)
import           Pos.ReportServer.Report (ReportType (..))
import           Pos.Update (installerHash)
import           Pos.Update.DB.Misc (affirmUpdateInstalled)
import           Pos.Util (HasLens (..), directory, postfixLFields, sleep)
import           Pos.Util.CompileInfo (HasCompileInfo, retrieveCompileTimeInfo, withCompileInfo)

data LauncherOptions = LO
    { loNodePath            :: !FilePath
    , loNodeArgs            :: ![Text]
    , loNodeDbPath          :: !FilePath
    , loNodeLogConfig       :: !(Maybe FilePath)
    , loNodeLogPath         :: !(Maybe FilePath)
    , loWalletPath          :: !(Maybe FilePath)
    , loWalletArgs          :: ![Text]
    , loWalletLogging       :: !Bool
    , loWalletLogPath       :: !(Maybe FilePath)
    , loUpdaterPath         :: !FilePath
    , loUpdaterArgs         :: ![Text]
    , loUpdateArchive       :: !(Maybe FilePath)
    , loUpdateWindowsRunner :: !(Maybe FilePath)
    , loNodeTimeoutSec      :: !Int
    , loReportServer        :: !(Maybe String)
    , loConfiguration       :: !ConfigurationOptions
    -- | Launcher logs will be written into this directory (as well as to
    -- console, except on Windows where we don't output anything to console
    -- because it crashes).
    , loLauncherLogsPrefix  :: !(Maybe FilePath)
    } deriving (Generic)

instance FromJSON LauncherOptions where
    parseJSON = withObject "LauncherOptions" $ \o ->
        genericParseJSON defaultOptions $ Object $
            -- This provides default values for some keys and
            -- allows not specifying them in the configuration
            -- file at all. @<>@ for hashmaps is left-biased,
            -- so it only adds new keys if there are aren't
            -- any yet.
            o <> HM.fromList
                [ ("walletLogging", Bool False)
                , ("nodeArgs",      Array mempty)
                , ("walletArgs",    Array mempty)
                , ("updaterArgs",   Array mempty)
                ]

-- | The concrete monad where everything happens
type M a = (HasConfigurations, HasCompileInfo) => Log.LoggerNameBox IO a

data Executable = EWallet | ENode | EUpdater

data LauncherArgs = LauncherArgs
    { configPath  :: !FilePath
    , daedalusDir :: !(Maybe FilePath)
    }

data LauncherConfigParseError = LauncherConfigParseError !FilePath !(Y.ParseException)
    deriving (Show)

instance Exception LauncherConfigParseError

launcherArgsParser :: Parser LauncherArgs
launcherArgsParser = do
    configPath <- strOption $
        short   'c' <>
        long    "config" <>
        help    "Path to the launcher configuration file." <>
        metavar "PATH"
    daedalusDir <- optional $ strOption $
        long    "daedalus-dir" <>
        help    "Path to Daedalus installation directory." <>
        metavar "PATH"
    pure $ LauncherArgs {..}

getLauncherOptions :: IO LauncherOptions
getLauncherOptions = do
    LauncherArgs {..} <- execParser programInfo
    decoded <- Y.decodeFileEither configPath
    case decoded of
        Left err -> do
            -- Since at this point we have failed to parse the config,
            -- the only option is to hardcode where to leave the error log.
#ifdef mingw32_HOST_OS
            logDir <- (</> "Daedalus\\Logs") <$> getEnv "APPDATA"
#else
            logDir <- (</> "Library/Application Support/Daedalus/Logs") <$> getEnv "HOME"
#endif
            createDirectoryIfMissing True logDir
            writeFile (logDir </> "config-error.log") $
                sformat ("Failed to parse "%string%": "%shown) configPath err
            throwM $ LauncherConfigParseError configPath err
        Right op -> expandVars daedalusDir op
  where
    programInfo = info (helper <*> versionOption <*> launcherArgsParser) $
        fullDesc <> progDesc ""
                 <> header "Tool to launch Cardano SL."
                 <> footerDoc usageExample

    versionOption = infoOption
        ("cardano-launcher-" <> showVersion version)
        (long "version" <> help "Show version.")

    -- Poor man's environment variable expansion.
    expandVars :: Maybe FilePath -> LauncherOptions -> IO LauncherOptions
#ifdef mingw32_HOST_OS
    expandVars daedalusDirArg lo@(LO {..}) = do
        -- %APPDATA%: nodeArgs, nodeDbPath,
        --     nodeLogPath, updaterPath,
        --     updateWindowsRunner, launcherLogsPrefix
        -- %DAEDALUS_DIR%: nodePath, walletPath
        appdata <- toText <$> getEnv "APPDATA"
        daedalusDirEnv <- toText <<$>> lookupEnv "DAEDALUS_DIR"
        case daedalusDirEnv <|> daedalusDirArg of
            Nothing -> do
                fullEnv <- getEnvironment
                throwM $ sformat ("%DAEDALUS_DIR% is not in the environment "%
                    "and was not provided as a command line argument.\n"%
                    "Complete dump of the environment follows:\n"%stext) (show fullEnv)
            Just daedalusDir -> do
                let replaceAppdata = replace "%APPDATA%" appdata
                    replaceDaedalusDir = replace "%DAEDALUS_DIR%" daedalusDir
                pure lo
                    { loNodeArgs            = map (T.replace "%APPDATA%" appdata) loNodeArgs
                    , loNodeDbPath          = replaceAppdata loNodeDbPath
                    , loNodeLogPath         = replaceAppdata <$> loNodeLogPath
                    , loUpdaterPath         = replaceAppdata loUpdaterPath
                    , loUpdateWindowsRunner = replaceAppdata <$> loUpdateWindowsRunner
                    , loLauncherLogsPrefix  = replaceAppdata <$> loLauncherLogsPrefix
                    , loNodePath            = replaceDaedalusDir loNodePath
                    , loWalletPath          = replaceDaedalusDir <$> loWalletPath
                    }
#else
    expandVars _ lo@(LO {..}) = do
        home <- toText <$> getEnv "HOME"
        let replaceHome = replace "$HOME" home
        pure lo
            { loNodeArgs           = map (T.replace "$HOME" home) loNodeArgs
            , loNodeDbPath         = replaceHome loNodeDbPath
            , loNodeLogPath        = replaceHome <$> loNodeLogPath
            , loUpdateArchive      = replaceHome <$> loUpdateArchive
            , loLauncherLogsPrefix = replaceHome <$> loLauncherLogsPrefix
            }
#endif
    replace :: Text -> Text -> FilePath -> FilePath
    replace from to = toString . T.replace from to . toText

usageExample :: Maybe Doc
usageExample = (Just . fromString @Doc . toString @Text) [Q.text|
Command example:

  stack exec -- cardano-launcher --config launcher-config.yaml

See tools/src/launcher/launcher-config.yaml for
an example of the config file.|]

data LauncherModeContext = LauncherModeContext { lmcNodeDBs :: NodeDBs }

makeLensesWith postfixLFields ''LauncherModeContext

type LauncherMode = ReaderT LauncherModeContext IO

{'fraction_non_alphanumeric': 0.09130016701250063, 'fraction_numerical': 0.0008097575788248393, 'mean_word_length': 2.317105925801578, 'pattern_counts': {'":': 2, '<': 82, '<?xml version=': 0, '>': 83, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1523393', 'n_tokens_mistral': 5575, 'n_tokens_neox': 5407, 'n_words': 1467}