{-# LANGUAGE ScopedTypeVariables,
  LambdaCase,
  RecordWildCards,
  OverloadedStrings,
  DataKinds,
  FlexibleInstances,
  TypeOperators,
  ApplicativeDo #-}

module Argo.Stack where

import           Data.Default
import           Turtle
import           Turtle.Shell
import           Prelude                 hiding ( FilePath )

import           System.IO                      ( withFile )
import           Debug.Trace
import           Filesystem.Path                ( (</>) )
import           Control.Concurrent.Async
import           System.Console.ANSI
import           System.Console.ANSI.Types      ( Color )
import           Data.Text                     as T
                                         hiding ( empty )
import           Data.Text.IO                  as Text
import           Argo.Utils
import           System.Process                as P
                                         hiding ( shell )
import           Options.Applicative           as OA
import           Control.Monad.Extra           as E
import           Control.Monad                 as CM
import           Control.Foldl                 as F
import           Data.Conduit
import           Data.Conduit.Process
import           Data.ByteString.Char8         as C8
                                         hiding ( empty )
import           Control.Exception.Base
import           Data.Maybe

data StackArgs = StackArgs
  { app                  :: Text
  , args                 :: [Text]
  , containerName        :: Text
  , workingDirectory     :: FilePath
  , manifestDir          :: FilePath
  , manifestName         :: FilePath
  , cmd_out              :: FilePath
  , cmd_err              :: FilePath
  , daemon_out           :: FilePath
  , daemon_err           :: FilePath
  , nrm_log              :: FilePath
  , messageDaemonOut     :: Maybe Text
  , messageDaemonErr     :: Maybe Text
  , messageCmdOut        :: Maybe Text
  , messageCmdErr        :: Maybe Text
  }

instance Default StackArgs where
  def = StackArgs
    { app = "echo"
    , args = ["foobar"]
    , containerName = "testContainer"
    , workingDirectory = "_output"
    , manifestDir = "manifests"
    , manifestName = "basic.json"
    , cmd_out = "cmd_out.log"
    , cmd_err = "cmd_err.log"
    , daemon_out = "daemon_out.log"
    , daemon_err = "daemon_err.log"
    , nrm_log = "nrm.log"
    , messageDaemonOut  = Nothing
    , messageDaemonErr  = Nothing
    , messageCmdOut = Nothing
    , messageCmdErr = Nothing
    }

parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs StackArgs {..} = do
  app <- strOption
    (  long "application"
    <> metavar "APP"
    <> help "Target application executable name. PATH is inherited."
    <> showDefault
    <> value app
    )
  containerName <- strOption
    (  long "container_name"
    <> metavar "ARGO_CONTAINER_UUID"
    <> help "Container name"
    <> showDefault
    <> value containerName
    )
  workingDirectory <- strOption
    (  long "output"
    <> metavar "FILE"
    <> help "Working directory."
    <> showDefault
    <> value workingDirectory
    )
  manifestDir <- strOption
    (  long "manifest_directory"
    <> metavar "FILE"
    <> help "Manifest lookup directory"
    <> showDefault
    <> value manifestDir
    )
  manifestName <- strOption
    (  long "manifest_name"
    <> metavar "FILE"
    <> help "Manifest basename"
    <> showDefault
    <> value manifestName
    )
  cmd_out <- strOption
    (  long "cmd_out"
    <> metavar "FILE"
    <> help "Output file, application stdout"
    <> showDefault
    <> value cmd_out
    )
  cmd_err <- strOption
    (  long "cmd_err"
    <> metavar "FILE"
    <> help "Output file, application stderr"
    <> showDefault
    <> value cmd_err
    )
  daemon_out <- strOption
    (  long "daemon_out"
    <> metavar "FILE"
    <> help "Output file, daemon stdout"
    <> showDefault
    <> value daemon_out
    )
  daemon_err <- strOption
    (  long "daemon_err"
    <> metavar "FILE"
    <> help "Output file, daemon stderr"
    <> showDefault
    <> value daemon_err
    )
  nrm_log <- strOption
    (  long "nrm_log"
    <> metavar "FILE"
    <> help "Output file, daemon log"
    <> showDefault
    <> value nrm_log
    )
  messageDaemonOut <- optional $ strOption
    (  long "message_daemon_stdout"
    <> metavar "STRING"
    <> help
         "The appearance of this character string in the daemon stdout \
            \ will be monitored during execution and the stack will be \
            \ killed when observing it, returning a successful exit code."
    <> showDefault
    <> maybe mempty value messageDaemonOut
    )
  messageDaemonErr <- optional $ strOption
    (  long "message_daemon_stdout"
    <> metavar "STRING"
    <> help
         "The appearance of this character string in the daemon stderr \
            \ will be monitored during execution and the stack will be \
            \ killed when observing it, returning a successful exit code."
    <> showDefault
    <> maybe mempty value messageDaemonErr
    )
  messageCmdOut <- optional $ strOption
    (  long "message_daemon_stdout"
    <> metavar "STRING"
    <> help
         "The appearance of this character string in the cmd stdout \
            \ will be monitored during execution and the stack will be \
            \ killed when observing it, returning a successful exit code."
    <> showDefault
    <> maybe mempty value messageCmdOut
    )
  messageCmdErr <- optional $ strOption
    (  long "message_daemon_stdout"
    <> metavar "STRING"
    <> help
         "The appearance of this character string in the cmd stderr \
            \ will be monitored during execution and the stack will be \
            \ killed when observing it, returning a successful exit code."
    <> showDefault
    <> maybe mempty value messageCmdErr
    )
  pure StackArgs {..}

cleanLeftoverProcesses :: Shell ()
cleanLeftoverProcesses = do
  printInfo "Cleaning leftover processes.\n"
  daemon <- myWhich "daemon"
  verboseShell (format ("pkill " % fp) daemon) empty
  cmd <- myWhich "cmd"
  void $ verboseShell (format ("pkill " % fp) cmd) empty
  daemon_wrapped <- myWhichMaybe ".daemon-wrapped"
  E.whenJust daemon_wrapped
             (\x -> void $ verboseShell "pkill .daemon-wrapped" empty)
  cmd_wrapped <- myWhichMaybe ".cmd-wrapped"
  void $ E.whenJust cmd_wrapped
                    (\x -> void $ verboseShell "pkill .cmd-wrapped" empty)

cleanLeftovers :: StackArgs -> Shell ()
cleanLeftovers StackArgs {..} = do
  cleanLeftoverProcesses
  printInfo "Cleaning leftover files.\n"
  CM.mapM_
    cleanLog
    [ workingDirectory </> daemon_out
    , workingDirectory </> daemon_err
    , workingDirectory </> cmd_out
    , workingDirectory </> cmd_err
    , workingDirectory </> nrm_log
    , workingDirectory </> ".argo_nodeos_config_exit_message"
    , workingDirectory </> "argo_nodeos_config"
    ]
  printInfo "Cleaning leftover sockets.\n"
  CM.mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]

prepareDaemon
  :: StackArgs -> Shell (IO (Either PatternMatched (ExitCode, (), ())))
prepareDaemon StackArgs {..} = do
  mktree workingDirectory
  cd workingDirectory
  myWhich "daemon"
  confPath <- myWhich "argo_nodeos_config"
  let confPath' = "./argo_nodeos_config"
  cp confPath confPath'
  printInfo $ format ("Copied the configurator to " % fp % "\n") confPath'
  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
  verboseShell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
    ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root.\n"
    ExitFailure n ->
      die ("Failed to set argo_nodeos_config permissions " <> repr n)
  verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
    ExitSuccess   -> printInfo "Set the suid bit.\n"
    ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
  verboseShell (format (fp % " --clean_config=kill_content:true") confPath')
               empty
    >>= \case
          ExitSuccess   -> printInfo "Cleaned the argo config.\n"
          ExitFailure n -> do
            printError
              ("argo_nodeos_config failed with exit code :" <> repr n <> "\n")
            testfile ".argo_nodeos_config_exit_message" >>= \case
              True -> do
                printInfo "Contents of .argo_nodeos_config_exit_message: \n"
                view $ input "./argo_nodeos_config_exit_message"
              False -> die ("Clean config failed with exit code " <> repr n)
  export "ARGO_NODEOS_CONFIG" (format fp confPath')
  makeInstrumentedProcess $ Instrumentation
    { process    = P.proc "daemon" ["--nrm_log", encodeString nrm_log]
    , stdOutFile = daemon_out
    , stdErrFile = daemon_err
    , messageOut = messageDaemonOut
    , messageErr = messageDaemonErr
    }

prepareCmdRun
  :: StackArgs -> Shell (IO (Either PatternMatched (ExitCode, (), ())))
prepareCmdRun StackArgs {..} = makeInstrumentedProcess $ Instrumentation
  { process    = P.proc "cmd"
    $  [ "run"
       , "-u"
       , T.unpack containerName
       , encodeString $ manifestDir </> manifestName
       , T.unpack app
       ]
    ++ fmap T.unpack args
  , stdOutFile = cmd_out
  , stdErrFile = cmd_err
  , messageOut = messageCmdOut
  , messageErr = messageCmdErr
  }

data StackOutput = FoundMessage | DaemonDied | CmdDied
runSimpleStack :: StackArgs -> Shell StackOutput
runSimpleStack a@StackArgs {..} = do
  cleanLeftovers a
  instrumentedDaemon <- prepareDaemon a
  instrumentedCmd    <- prepareCmdRun a
  printInfo "Running the daemon."
  liftIO $ withAsync instrumentedDaemon $ \daemon -> do
    kbInstallHandler $ cancel daemon
    sh $ printInfo "Running cmd run."
    withAsync instrumentedCmd $ \cmd -> do
      kbInstallHandler $ cancel daemon >> cancel cmd
      waitEitherCancel daemon cmd >>= \case
        Left  (Left  PatternMatched) -> return FoundMessage
        Left  (Right _             ) -> return DaemonDied
        Right (Left  PatternMatched) -> return FoundMessage
        Right (Right _             ) -> return CmdDied