Commit 09b37e85 authored by Valentin Reis's avatar Valentin Reis

Fix refactor bugs

parent e98124d9
Pipeline #6119 passed with stages
in 2 minutes and 14 seconds
......@@ -13,11 +13,16 @@ module Argo.Args
)
where
import Argo.Types
import Argo.Types ( ProcessBehavior
, Verbosity(..)
, StackArgs(..)
)
import Options.Applicative as OA
import Options.Applicative.Types
import Options.Applicative.Builder ( option )
import Turtle hiding ( option )
import Options.Applicative.Types ( Parser
, ReadM
, readerAsk
)
import Prelude hiding ( FilePath )
behavior :: ReadM ProcessBehavior
......
......@@ -30,9 +30,9 @@ module Argo.Stack
)
where
import Protolude
import qualified Prelude ( show )
import Argo.Types
import qualified Prelude ( show )
import Protolude
import Data.Coerce ( coerce )
......@@ -41,9 +41,7 @@ import Data.Foldable ( for_ )
import Data.Text as T
hiding ( empty )
import Data.Traversable ( for )
{-import System.Process as P-}
{-hiding ( shell )-}
import Text.Show.Pretty
import System.Directory
import System.Process.Typed ( readProcessStdout_
, runProcess_
, runProcess
......@@ -51,7 +49,7 @@ import System.Process.Typed ( readProcessStdout_
, shell
, setEnv
)
import System.Directory
import Text.Show.Pretty
cleanLeftovers :: WorkingDirectory -> IO ()
cleanLeftovers (WorkingDirectory wd) = do
......@@ -73,12 +71,13 @@ prepareDaemon
-> Maybe TestText
-> Verbosity
-> PowerCap
-> [(EnvVar, Text)]
-> IO Instrumentation
prepareDaemon out stdErr test v powercap = do
prepareDaemon out stdErr test v powercap vars = do
let confPath' = "/tmp/argo_nodeos_config"
cleanContainers confPath'
return $ Instrumentation
( setEnv [("ARGO_NODEOS_CONFIG", toS confPath')]
( setEnv ((castArg <$> vars) ++ [("ARGO_NODEOS_CONFIG", toS confPath')])
$ proc "daemon"
$ toS
<$> ["--nrm_log", "./nrm_log"]
......@@ -89,6 +88,7 @@ prepareDaemon out stdErr test v powercap = do
stdErr
test
where
castArg (EnvVar varname, y) = (toS varname, toS y)
nodeOsFailure n = do
printError $ "argo_nodeos_config failed with exit code :" <> show n
doesFileExist ".argo_nodeos_config_exit_message" >>= \case
......@@ -121,7 +121,7 @@ cmdRunI (AppName app) args (ContainerName cn) (ShareDir md) (ManifestName mn) va
pp =
proc "cmd"
$ toS
<$> ["run", "-u", cn, md <> "manifests" <> "/" <> mn, app]
<$> ["run", "-u", cn, md <> "/manifests/" <> mn, app]
++ fmap argToText args
cmdListenI
......@@ -180,13 +180,12 @@ runStack sa@StackArgs {..} = do
when (powercap /= None) $ do
user <- readProcessStdout_ (proc "whoami" [])
for_ ([0, 1]::[Int]) $ \x ->
for_ ([0, 1] :: [Int]) $ \x ->
chownPowercapFiles (toS user)
$ "/sys/devices/virtual/powercap/intel-rapl/intel-rapl:"
<> show x
cleanLeftovers workingDirectory
runProcess (proc "mkdir" ["-p", toS wd]) >>= \case
ExitFailure _ -> die $ "couldn't create " <> wd
ExitSuccess -> return ()
......@@ -195,10 +194,10 @@ runStack sa@StackArgs {..} = do
DontRun -> return Nothing
JustRun stdOut stdErr ->
(\i -> Just (Daemon, i))
<$> prepareDaemon stdOut stdErr Nothing verbosity powercap
<$> prepareDaemon stdOut stdErr Nothing verbosity powercap vars
Test t stdOut stdErr ->
(\i -> Just (Daemon, i))
<$> prepareDaemon stdOut stdErr (Just t) Verbose powercap
<$> prepareDaemon stdOut stdErr (Just t) Verbose powercap vars
let milist :: [Maybe (StackI, Instrumentation)]
milist =
......
......@@ -181,13 +181,17 @@ untilMatch msg sawTraceback = await >>= \case
Nothing -> return Clean
configureConduits
:: WorkingDirectory -> ProcessConfig () () ()
:: WorkingDirectory
-> ProcessConfig () () ()
-> ProcessConfig
()
(ConduitM () ByteString IO ())
(ConduitM () ByteString IO ())
configureConduits (WorkingDirectory wd) p =
setStdout createSource $ setStderr createSource $ setStdin closed $ setWorkingDir (toS wd) p
setStdout createSource
$ setStderr createSource
$ setStdin closed
$ setWorkingDir (toS wd) p
withConduitSinks
:: Text
......@@ -206,19 +210,27 @@ withSinkFileNoBuffering filepath inner =
run $ inner $ sinkHandle h
runI
:: WorkingDirectory -> Instrumentation
:: WorkingDirectory
-> Instrumentation
-> IO (Either MonitoringResult (ExitCode, TracebackScan, TracebackScan))
runI workDir (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
try $ withConduitSinks stdOut stdErr $ \outSink errSink ->
withProcess (configureConduits workDir crProc) $ \p ->
withAsyncConduitsOnProcess p outSink outTest errSink errTest waitEither
>>= \case
Left Clean -> (, Clean, Clean) <$> waitExitCode p
Right Clean -> (, Clean, Clean) <$> waitExitCode p
Right WarningTraceback ->
(, Clean, WarningTraceback) <$> waitExitCode p
Left WarningTraceback ->
(, WarningTraceback, Clean) <$> waitExitCode p
runI workDir@(WorkingDirectory wd) (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t)
= try
$ withConduitSinks (wd <> "/" <> stdOut) (wd <> "/" <> stdErr)
$ \outSink errSink ->
withProcess (configureConduits workDir crProc) $ \p ->
withAsyncConduitsOnProcess p
outSink
outTest
errSink
errTest
waitEither
>>= \case
Left Clean -> (, Clean, Clean) <$> waitExitCode p
Right Clean -> (, Clean, Clean) <$> waitExitCode p
Right WarningTraceback ->
(, Clean, WarningTraceback) <$> waitExitCode p
Left WarningTraceback ->
(, WarningTraceback, Clean) <$> waitExitCode p
where
outTest :: Maybe TextBehavior
errTest :: Maybe TextBehavior
......@@ -227,7 +239,6 @@ runI workDir (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
(Just tOut, Just tErr)
Nothing -> (Nothing, Nothing)
processBehaviorToI
:: ProcessConfig () () () -> ProcessBehavior -> Maybe Instrumentation
processBehaviorToI crProc = \case
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment