GitLab maintenance scheduled for Tomorrow, 2020-08-11, from 17:00 to 18:00 CT - Services will be unavailable during this time.

Argotest.hs 6.22 KB
Newer Older
Valentin Reis's avatar
Valentin Reis committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
{-# LANGUAGE
    RecordWildCards
  , LambdaCase
  , OverloadedStrings
  , DataKinds
  , DeriveGeneric
  , FlexibleInstances
  , OverloadedStrings
  , 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 Args w = Args
--  { dargs                :: w ::: Text     <?> "Daemon arguments. Properly quote this."
--  , app                  :: w ::: FilePath <?> "Input file, target application script"
--  , manifest             :: w ::: FilePath <?> "Input file, manifest."
--  , app_out              :: w ::: FilePath <?> "Output file, application stdout"
--  , app_err              :: w ::: FilePath <?> "Output file, application stderr"
--  , daemon_out           :: w ::: FilePath <?> "Output file, daemon stdout"
--  , daemon_err           :: w ::: FilePath <?> "Output file, daemon stderr"
--  , log_progress         :: w ::: FilePath <?> "Output file, daemon progress log"
--  , log_hardwareprogress :: w ::: FilePath <?> "Output file, daemon hardware progress log"
--  , log_power            :: w ::: FilePath <?> "Output file, daemon power log"
--  , time_file            :: w ::: FilePath <?> "Output file, application runtime" } deriving (Generic)
--instance ParseRecord (Args Wrapped)


data StackArgs = StackArgs
  { dargs                :: Text
  , app                  :: FilePath
  , manifest             :: FilePath
  , cmd_out              :: FilePath
  , cmd_err              :: FilePath
  , daemon_out           :: FilePath
  , daemon_err           :: FilePath
49
  , nrm_log              :: FilePath
Valentin Reis's avatar
Valentin Reis committed
50 51 52 53 54
  , time_file            :: FilePath  }

instance Default StackArgs where
  def = StackArgs
    { dargs = ""
55
    , app = "echo \"Dummy app: Hello world!\""
Valentin Reis's avatar
Valentin Reis committed
56
    , manifest = "manifests/basic.json"
57 58 59 60
    , cmd_out = "cmd_out.log"
    , cmd_err = "cmd_err.log"
    , daemon_out = "daemon_out.log"
    , daemon_err = "daemon_err.log"
61
    , nrm_log = "nrm.log"
62
    , time_file = "time.log"
Valentin Reis's avatar
Valentin Reis committed
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
    }

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    str = printf ("Info:"%s) str
printWarning str = colorShell Yellow $ printf ("Warning:"%s) str
printError   str = colorShell Red $ printf ("Error:"%s) str

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 ("using "%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"

argoTest :: StackArgs -> IO ()
argoTest StackArgs{..} = sh $ do
  --Cleaning
102
  mapM_ cleanLog [daemon_out, daemon_err, cmd_out, cmd_err, time_file, nrm_log]
Valentin Reis's avatar
Valentin Reis committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]

  --Retrieving binaries,setting suid bits and perms
  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 "Running the daemon.\n"
  export "ARGO_NODEOS_CONFIG" (format fp confPath')
128 129
  let daemon = inshell (format (fp%" "%s%" --nrm_log="%fp%" >"%fp%" 2>"%fp)
                          daemonPath dargs nrm_log daemon_out daemon_err) empty
Valentin Reis's avatar
Valentin Reis committed
130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
  daemonAsync <- fork $ sh $ daemon
  printInfo "Daemon is running.\n"
  let handler = do
                sh $ printInfo "Interrupted. Killing daemon..."
                cancel daemonAsync
                sh $ colorShell Green $ printf "Killed daemon.\n"
  liftIO $ installHandler keyboardSignal (Catch handler) Nothing

  --Running the app
  printInfo "Launching the application through cmd.\n"
  (_,t) <- time $
    shell (format ("cmd run -u toto "%fp%"  "%fp%" > "%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 )
  liftIO $ writeTextFile time_file (repr t)

  --Cleanup
  printInfo "Killing the daemon.\n"
  liftIO $ cancel daemonAsync
  printInfo "Daemon killed.\n"