Argotest.hs

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

module Argotest 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 System.Posix.Signals

data StackArgs = StackArgs
  { dargs                :: Text        --"Daemon arguments. Properly quote this."
  , app                  :: Text        --"Target application call, sh+path valid"
  , 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\""
    , manifest = "manifests/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"
    }

colorShell :: Color -> Shell ()-> Shell ()
colorShell color s = setC color *> s *> setC White
  where setC c = liftIO $ setSGR [SetColor Foreground Dull c]

printInfo    :: Text -> Shell ()
printError   :: Text -> Shell ()
printWarning :: Text -> Shell ()
printInfo    = printf ("Info:"%s)
printWarning = colorShell Yellow . printf ("Warning:"%s)
printError   = colorShell Red . printf ("Error:"%s)

myWhich str = which str >>= \case
  (Just p) -> printInfo ( format ("Found "%fp%" at "%fp%"\n") str p ) >> return p
  Nothing -> die $ format ("Argo `"%fp%"` not in $PATH.") str

sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
sudoRemoveFile printer desc filePath = do
  foundSocket <- testfile filePath
  when foundSocket $ go False
  printInfo $ format ("OK: "%s%" "%fp%"\n") desc filePath
  where go useSudo = do
          printer $ format ("found stale " %s%" at "%fp%".. ") desc filePath
          shell (format ((if useSudo then "sudo " else "")%"rm -f "%fp) filePath) empty >>= \case
            ExitSuccess   -> colorShell Green $ printf " Successfully removed.\n"
            ExitFailure n -> if useSudo
                             then printer $ format ("Failed to remove stale "%s%", even with sudo.") desc
                             else do
                                printer $ format ("Failed to remove stale "%s%". Trying sudo..\n") desc
                                go True

cleanSocket = sudoRemoveFile printError "socket"
cleanLog    = sudoRemoveFile printWarning "log file"

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

prepareDaemonShell :: Text -> FilePath -> FilePath -> FilePath -> Shell (Shell ())
prepareDaemonShell dargs daemon_out daemon_err nrm_log = do
  confPath      <- myWhich "argo_nodeos_config"
  daemonPath    <- myWhich "daemon"
  tempDirPath   <- mktempdir "/tmp" "argo-expe"
  let confPath' = tempDirPath </> "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 printInfo "Contents of argo_nodeos_config_exit_message: \n"
                        view $ cat  ["./argo_nodeos_config_exit_message"]
                        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 $ sh $ inshell (format (fp%" "%s%" --nrm_log="%fp%" >"%fp%" 2>"%fp) daemonPath dargs nrm_log daemon_out daemon_err) empty