content: {-# LANGUAGE RecordWildCards #-}
  
  module Main
         ( main
         ) where
  
  import           Universum
  
  import           Control.Exception.Safe (handle)
  import           Data.Maybe (fromMaybe)
  import           Formatting (sformat, shown, (%))
  import qualified Network.Transport.TCP as TCP (TCPAddr (..))
  import qualified System.IO.Temp as Temp
  
  import           Ntp.Client (NtpConfiguration)
  
  import           Pos.Chain.Genesis as Genesis (Config (..), ConfigurationError)
  import           Pos.Chain.Txp (TxpConfiguration)
  import           Pos.Chain.Update (updateConfiguration)
  import qualified Pos.Client.CLI as CLI
  import           Pos.Context (NodeContext (..))
  import           Pos.DB.DB (initNodeDBs)
  import           Pos.DB.Txp (txpGlobalSettings)
  import           Pos.Infra.Diffusion.Types (Diffusion, hoistDiffusion)
  import           Pos.Infra.Network.Types (NetworkConfig (..), Topology (..),
                       topologyDequeuePolicy, topologyEnqueuePolicy,
                       topologyFailurePolicy)
  import           Pos.Launcher (HasConfigurations, NodeParams (..),
                       NodeResources (..), WalletConfiguration,
                       bracketNodeResources, loggerBracket, lpConsoleLog,
                       runNode, runRealMode, withConfigurations)
  import           Pos.Util (logException)
  import           Pos.Util.CompileInfo (HasCompileInfo, withCompileInfo)
  import           Pos.Util.Config (ConfigurationException (..))
  import           Pos.Util.Trace (fromTypeclassWlog, noTrace)
  import           Pos.Util.UserSecret (usVss)
  import           Pos.Util.Wlog (LoggerName, logInfo)
  import           Pos.WorkMode (EmptyMempoolExt, RealMode)
  
  import           AuxxOptions (AuxxAction (..), AuxxOptions (..),
                       AuxxStartMode (..), getAuxxOptions)
  import           Mode (AuxxContext (..), AuxxMode, realModeToAuxx)
  import           Plugin (auxxPlugin, rawExec)
  import           Repl (PrintAction, WithCommandAction (..), withAuxxRepl)
  
  loggerName :: LoggerName
  loggerName = "auxx"
  
  -- 'NodeParams' obtained using 'CLI.getNodeParams' are not perfect for
  -- Auxx, so we need to adapt them slightly.
  correctNodeParams :: AuxxOptions -> NodeParams -> IO (NodeParams, Bool)
  correctNodeParams AuxxOptions {..} np = do
      (dbPath, isTempDbUsed) <- case npDbPathM np of
          Nothing -> do
              tempDir <- Temp.getCanonicalTemporaryDirectory
              dbPath <- Temp.createTempDirectory tempDir "nodedb"
              logInfo $ sformat ("Temporary db created: "%shown) dbPath
              return (dbPath, True)
          Just dbPath -> do
              logInfo $ sformat ("Supplied db used: "%shown) dbPath
              return (dbPath, False)
      let np' = np
              { npNetworkConfig = networkConfig
              , npRebuildDb = npRebuildDb np || isTempDbUsed
              , npDbPathM = Just dbPath }
      return (np', isTempDbUsed)
    where
      topology = TopologyAuxx aoPeers
      networkConfig =
          NetworkConfig
          { ncDefaultPort = 3000
          , ncSelfName = Nothing
          , ncEnqueuePolicy = topologyEnqueuePolicy topology
          , ncDequeuePolicy = topologyDequeuePolicy topology
          , ncFailurePolicy = topologyFailurePolicy topology
          , ncTopology = topology
          , ncTcpAddr = TCP.Unaddressable
          }
  
  runNodeWithSinglePlugin ::
         (HasConfigurations, HasCompileInfo)
      => Genesis.Config
      -> TxpConfiguration
      -> NodeResources EmptyMempoolExt
      -> (Diffusion AuxxMode -> AuxxMode ())
      -> Diffusion AuxxMode -> AuxxMode ()
  runNodeWithSinglePlugin genesisConfig txpConfig nr plugin =
      runNode genesisConfig txpConfig nr [ ("runNodeWithSinglePlugin", plugin) ]
  
  action :: HasCompileInfo => AuxxOptions -> Either WithCommandAction Text -> IO ()
  action opts@AuxxOptions {..} command = do
      let pa = either printAction (const putText) command
      case aoStartMode of
          Automatic
              ->
                  handle @_ @ConfigurationException (\_ -> runWithoutNode pa)
                . handle @_ @ConfigurationError (\_ -> runWithoutNode pa)
                $ withConfigurations noTrace
                                     Nothing
                                     cnaDumpGenesisDataPath
                                     cnaDumpConfiguration
                                     conf
                                     (runWithConfig pa)
          Light
              -> runWithoutNode pa
          _   -> withConfigurations noTrace
                                    Nothing
                                    cnaDumpGenesisDataPath
                                    cnaDumpConfiguration
                                    conf
                                    (runWithConfig pa)
    where
      runWithoutNode :: PrintAction IO -> IO ()
      runWithoutNode printAction = printAction "Mode: light" >> rawExec Nothing Nothing Nothing opts Nothing command
  
      runWithConfig
          :: HasConfigurations
          => PrintAction IO
          -> Genesis.Config
          -> WalletConfiguration
          -> TxpConfiguration
          -> NtpConfiguration
          -> IO ()
      runWithConfig printAction genesisConfig _walletConfig txpConfig _ntpConfig = do
          printAction "Mode: with-config"
          (nodeParams, tempDbUsed) <- (correctNodeParams opts . fst) =<< CLI.getNodeParams
              fromTypeclassWlog
              loggerName
              cArgs
              nArgs
              (configGeneratedSecrets genesisConfig)
  
          let toRealMode :: AuxxMode a -> RealMode EmptyMempoolExt a
              toRealMode auxxAction = do
                  realModeContext <- ask
                  let auxxContext =
                          AuxxContext
                          { acRealModeContext = realModeContext
                          , acTempDbUsed = tempDbUsed }
                  lift $ runReaderT auxxAction auxxContext
              vssSK = fromMaybe (error "no user secret given")
                                (npUserSecret nodeParams ^. usVss)
              sscParams = CLI.gtSscParams cArgs vssSK (npBehaviorConfig nodeParams)
  
          bracketNodeResources genesisConfig
                               nodeParams
                               sscParams
                               (txpGlobalSettings genesisConfig txpConfig)
                               (initNodeDBs genesisConfig) $ \nr ->
              let NodeContext {..} = nrContext nr
                  modifier = if aoStartMode == WithNode
                             then runNodeWithSinglePlugin genesisConfig txpConfig nr
                             else identity
                  auxxModeAction = modifier (auxxPlugin genesisConfig txpConfig opts command)
               in runRealMode updateConfiguration genesisConfig txpConfig nr $ \diffusion ->
                      toRealMode (auxxModeAction (hoistDiffusion realModeToAuxx toRealMode diffusion))
  
      cArgs@CLI.CommonNodeArgs {..} = aoCommonNodeArgs
      conf = CLI.configurationOptions (CLI.commonArgs cArgs)
      nArgs =
          CLI.NodeArgs
              { behaviorConfigPath = Nothing
              }
  
  main :: IO ()
  main = withCompileInfo $ do
      opts <- getAuxxOptions
      let disableConsoleLog
              | Repl <- aoAction opts =
                    -- Logging in the REPL disrupts the prompt,
                    -- so we disable it.
                    -- TODO: When LW-25 is resolved we also want
                    -- to be able to enable logging in REPL using
                    -- a Haskeline-compatible print action.
                    \lp -> lp { lpConsoleLog = Just False }
              | otherwise = identity
          loggingParams = disableConsoleLog $
              CLI.loggingParams loggerName (aoCommonNodeArgs opts)
      loggerBracket "auxx" loggingParams . logException "auxx" $ do
          let runAction a = action opts a
          case aoAction opts of
              Repl    -> withAuxxRepl $ \c -> runAction (Left c)
              Cmd cmd -> runAction (Right cmd)
  