{-# 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 import System.Process hiding (shell) import Data.Text as Text hiding (empty) import Data.Text.IO as Text 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, ".argo_nodeos_config_exit_message"] mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"] prepareDaemonShell :: [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ()) prepareDaemonShell dargs daemon_out daemon_err nrm_log = do confPath <- myWhich "argo_nodeos_config" 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 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 --twoWayPrint l --case l of -- Left out -> output daemon_out $ return out -- Right err -> output daemon_err $ return 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 handleOut (lineToText err) cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell () cmdShell manifest app cmd_out cmd_err = 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 )