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

module Argo.Stack where

import           Data.Default
import           Turtle
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 Text
                                         hiding ( empty )
import           Data.Text.IO                  as Text
import           Argo.Utils
import System.Process as P hiding (shell)

data StackArgs = StackArgs
  { dargs                :: [Text]      --"Daemon arguments. Properly quote this."
  , app                  :: Text        --"Target application call, sh+path valid"
  , workingDirectory     :: FilePath    --"Working directory."
  , manifest             :: FilePath    --"Input file, manifest."
  , cmd_out              :: FilePath    --"Output file, application stdout"
  , cmd_err              :: FilePath    --"Output file, application stderr"
  , daemon_out           :: FilePath    --"Output file, daemon stdout"
  , daemon_err           :: FilePath    --"Output file, daemon stderr"
  , nrm_log              :: FilePath    --"Output file, daemon log"
  , time_file            :: FilePath  } --"Output file, application runtime"

instance Default StackArgs where
  def = StackArgs
    { dargs = []
    , app = "echo \"HelloWorld\""
    , workingDirectory = "./."
    , manifest = "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"
    , time_file = "time.log"
    }

-- | override the output directory of the stack.
outputDir :: FilePath -> StackArgs -> StackArgs
outputDir dir sa = sa { workingDirectory = dir }

cleanLeftovers
  :: FilePath
  -> FilePath
  -> FilePath
  -> FilePath
  -> FilePath
  -> FilePath
  -> FilePath
  -> Shell ()
cleanLeftovers wd daemon_out daemon_err cmd_out cmd_err time_file nrm_log = do
  printInfo "Cleaning leftovers..\n"
  mapM_
    cleanLog
    [ wd </> daemon_out
    , wd </> daemon_err
    , wd </> cmd_out
    , wd </> cmd_err
    , wd </> time_file
    , wd </> nrm_log
    , wd </> ".argo_nodeos_config_exit_message"
    ]
  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]

prepareDaemonShell
  :: FilePath -> [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ())
prepareDaemonShell wd dargs daemon_out daemon_err nrm_log = do
  mktree wd
  cd wd
  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"
  shell (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)
  shell (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)

  --Cleaning the config, running the daemon
  shell (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)
  printInfo $ format
    ( "Running the daemon, main log at "
    % fp
    % ", stdout at "
    % fp
    % ", stderr at "
    % fp
    % "\n"
    )
    nrm_log
    daemon_out
    daemon_err
  export "ARGO_NODEOS_CONFIG" (format fp confPath')
  return $ twoWayPrint daemon_out daemon_err $ inprocWithErr
    "daemon"
    (dargs ++ ["--nrm_log", Text.pack $ encodeString nrm_log])
    empty

-- | See at the bottom of this file for discussion of this function. (1)
cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()
cmdShell manifest app cmd_out cmd_err = do
  shell
      (format ("cmd run -u toto " % fp % "  " % s % " > " % fp % " 2>" % fp)
              manifest
              app
              cmd_out
              cmd_err
      )
      empty
    >>= \case
          ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
          ExitFailure n -> die
            (  "cmd failed with exit code "
            <> repr n
            <> " . The application logs are at "
            <> repr cmd_out
            <> " "
            <> repr cmd_err
            )

twoWayPrint :: FilePath -> FilePath -> Shell (Either Line Line) -> IO ()
twoWayPrint outPath errPath s = sh $ do
  handleOut <- using (writeonly outPath)
  handleErr <- using (writeonly errPath)
  s >>= \case
    Left  out -> liftIO $ Text.hPutStrLn handleOut (lineToText out)
    Right err -> liftIO $ Text.hPutStrLn handleErr (lineToText err)

runSimpleStack :: StackArgs -> IO ()
runSimpleStack a@StackArgs {..} = sh $ do
  cleanLeftovers workingDirectory
                 daemon_out
                 daemon_err
                 cmd_out
                 cmd_err
                 time_file
                 nrm_log
  daemonShell <- prepareDaemonShell workingDirectory
                                    dargs
                                    daemon_out
                                    daemon_err
                                    nrm_log
  liftIO $ withAsync daemonShell $ \daemon -> do
    kbInstallHandler $ cancel daemon
    withAsync (time $ sh $ cmdShell manifest app cmd_out cmd_err) $ \cmd -> do
      kbInstallHandler $ cancel daemon >> cancel cmd
      waitEitherCancel daemon cmd >>= \case
        Left  _      -> die "Daemon died."
        Right (_, t) -> writeTextFile time_file (repr t)

-- | (1)
--
-- | This version fucks up the environment variables. issue at
-- https://github.com/Gabriel439/Haskell-Turtle-Library/issues/338
{-cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()-}
{-cmdShell manifest app cmd_out cmd_err = do-}
  {-manifestArg <- case toText manifest of-}
    {-Left m -> printWarning (format ("Manifest path malformed: " % fp) manifest)-}
      {->> return m-}
    {-Right m -> return m-}
  {-printInfo $ format-}
    {-("Running cmd. Stdout at " % fp % ", stderr at " % fp % "\n")-}
    {-cmd_out-}
    {-cmd_err-}
  {-liftIO $ twoWayPrint cmd_out cmd_err $ inprocWithErr-}
    {-"cmd"-}
    {-["run", "-u", "toto", manifestArg, app]-}
    {-empty-}

-- | Even this one fucks up, streamWithErr really cleans this `env` attribute.

  {-manifestArg <- case toText manifest of-}
    {-Left m -> printWarning (format ("Manifest path malformed: " % fp) manifest)-}
      {->> return m-}
    {-Right m -> return m-}
  {-printInfo $ format-}
    {-("Running cmd. Stdout at " % fp % ", stderr at " % fp % "\n")-}
    {-cmd_out-}
    {-cmd_err-}
  {-theEnv' <- liftIO $ Turtle.env-}
  {-let theEnv = Prelude.map (\(x,y)-> (Text.unpack x,Text.unpack y)) theEnv'-}
  {-void $ liftIO $  twoWayPrint cmd_out cmd_err $ streamWithErr ((P.proc (unpack "cmd") (Prelude.map unpack ["run", "-u", "toto", manifestArg, app])) {P.env=Just theEnv}) empty-}