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

Fix refactor bugs

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