GitLab maintenance scheduled for Tomorrow, 2019-09-24, from 12:00 to 13:00 CT - Services will be unavailable during this time.

Commit a0c7e701 authored by Valentin Reis's avatar Valentin Reis

Merge branch 'experiment-commands' into 'master'

Experiment commands

See merge request argo/argotest!14
parents a2b60e73 014360e9
Pipeline #4864 passed with stage
in 11 seconds
......@@ -112,34 +112,6 @@ There are a few things one has to be aware of using this workflow:
minutes by default. Use a local checkout if you need to modify some of these
sources on the fly.
### Example CI setup
``` {.yml}
integration.test:
stage: test
script:
- nix-shell -E '{ argotest ? (builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/argotest.git;
ref="master";})
}:
(import argotest { containers-src = ./. ; }).test' \
--run 'argotk.hs TestHello'
artifacts:
paths:
- argotest/_output/cmd_err.log
- argotest/_output/cmd_out.log
- argotest/_output/daemon_out.log
- argotest/_output/daemon_out.log
- argotest/_output/nrm.log
- argotest/_output/time.log
expire_in: 1 week
except:
- /^wip\/.*/
- /^WIP\/.*/
tags:
- integration
```
### Hacking
- edit `.README.md` in place of README.md.
......
......@@ -3,3 +3,10 @@ _output
result
.shake
*.log
*/build
*/new-build
*/dist
*/new-dist
*/result
_output
*/_output
......@@ -12,6 +12,6 @@ library
exposed-Modules: Argo.Stack
Argo.Utils
Argo.Args
build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm
build-depends: base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm, pretty-show
hs-source-dirs: src
default-language: Haskell2010
{-# LANGUAGE
OverloadedStrings,
ApplicativeDo,
RecordWildCards #-}
{-# LANGUAGE OverloadedStrings, ApplicativeDo, GeneralizedNewtypeDeriving, RecordWildCards #-}
module Argo.Args where
import Options.Applicative as OA
import Options.Applicative.Types
import Options.Applicative.Builder ( option )
import Data.Default
import Data.Text as T
hiding ( empty )
import Turtle
import Turtle hiding ( option )
import Prelude hiding ( FilePath )
import System.Process hiding ( shell )
data OutputFiles = OutputFiles FilePath FilePath
data StackArgs = StackArgs
{ app :: Text
, args :: [Text]
, containerName :: Text
, workingDirectory :: FilePath
, manifestDir :: FilePath
, manifestName :: FilePath
, cmd_run_out :: FilePath
, cmd_run_err :: FilePath
, cmd_listen_out :: FilePath
, cmd_listen_err :: FilePath
, daemon_out :: FilePath
, daemon_err :: FilePath
, nrm_log :: FilePath
, messageDaemonOut :: Maybe Text
, messageDaemonErr :: Maybe Text
, messageCmdRunOut :: Maybe Text
, messageCmdRunErr :: Maybe Text
, messageCmdListenOut :: Maybe Text
, messageCmdListenErr :: Maybe Text
{ verbosity :: Verbosity
, app :: AppName
, args :: AppArgs
, containerName :: ContainerName
, workingDirectory :: WorkingDirectory
, manifestDir :: ManifestDir
, manifestName :: ManifestName
, daemon :: ProcessBehavior
, cmdrun :: ProcessBehavior
, cmdlisten :: ProcessBehavior
, cmdlistenprogress :: ProcessBehavior
, cmdlistenpower :: ProcessBehavior
}
data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
newtype AppArgs = AppArgs [Text] deriving (Show, Read)
newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
newtype ManifestDir = ManifestDir FilePath deriving (IsString, Show)
newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
newtype TestText = TestText Text deriving (Show, Read)
data ProcessBehavior =
SucceedTestOnMessage TestText StdOutLog StdErrLog
| JustRun StdOutLog StdErrLog
| DontRun deriving (Show,Read)
behavior :: ReadM ProcessBehavior
behavior = read <$> readerAsk
behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
behaviorOption = option behavior
instance Default StackArgs where
def = StackArgs
{ app = "echo"
, args = ["foobar"]
, containerName = "testContainer"
, workingDirectory = "_output"
, manifestDir = "manifests"
, manifestName = "basic.json"
, cmd_run_out = "cmd_run_out.log"
, cmd_run_err = "cmd_run_err.log"
, cmd_listen_out = "cmd_listen_out.log"
, cmd_listen_err = "cmd_listen_err.log"
, daemon_out = "daemon_out.log"
, daemon_err = "daemon_err.log"
, nrm_log = "nrm.log"
, messageDaemonOut = Nothing
, messageDaemonErr = Nothing
, messageCmdRunOut = Nothing
, messageCmdRunErr = Nothing
, messageCmdListenOut = Nothing
, messageCmdListenErr = Nothing
{ verbosity = Verbose
, app = AppName "ls"
, args = AppArgs []
, containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output"
, manifestDir = ManifestDir "manifests"
, manifestName = ManifestName "basic.json"
, daemon = DontRun
, cmdrun = DontRun
, cmdlisten = DontRun
, cmdlistenprogress = DontRun
, cmdlistenpower = DontRun
}
parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs StackArgs {..} = do
verbosity <- flag
Normal
Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode")
app <- strOption
( long "application"
<> metavar "APP"
......@@ -97,113 +109,39 @@ parseExtendStackArgs StackArgs {..} = do
<> showDefault
<> value manifestName
)
cmd_run_out <- strOption
( long "cmd_run_out"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), \"cmd run\" stdout"
<> showDefault
<> value cmd_run_out
)
cmd_run_err <- strOption
( long "cmd_run_err"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), \"cmd run\" stderr"
<> showDefault
<> value cmd_run_err
)
cmd_listen_out <- strOption
( long "cmd_listen_out"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), \"cmd listen\" stdout"
<> showDefault
<> value cmd_listen_out
)
cmd_listen_err <- strOption
( long "cmd_listen_err"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), \"cmd listen\" stderr"
<> showDefault
<> value cmd_listen_err
)
daemon_out <- strOption
( long "daemon_out"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), daemon stdout"
<> showDefault
<> value daemon_out
)
daemon_err <- strOption
( long "daemon_err"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), daemon stderr"
<> showDefault
<> value daemon_err
)
nrm_log <- strOption
( long "nrm_log"
<> metavar "FILENAME"
<> help "Output file (relative to --output_dir), daemon log"
<> showDefault
<> value nrm_log
)
messageDaemonOut <- optional $ strOption
( long "message_daemon_stdout"
<> metavar "STRING"
<> help
"The appearance of this character string in the daemon stdout \
\ will be monitored during execution. When observed, the \
\ stack will be killed and a return code of 0 will be returned."
<> showDefault
<> maybe mempty value messageDaemonOut
)
messageDaemonErr <- optional $ strOption
( long "message_daemon_stderr"
<> metavar "STRING"
<> help
"The appearance of this character string in the daemon stdout \
\ will be monitored during execution. When observed, the \
\ stack will be killed and a return code of 0 will be returned."
daemon <- behaviorOption
( long "daemon"
<> metavar "BEHAVIOR"
<> help "`daemon` behavior"
<> showDefault
<> maybe mempty value messageDaemonErr
<> value daemon
)
messageCmdRunOut <- optional $ strOption
( long "message_cmd_run_stdout"
<> metavar "STRING"
<> help
"The appearance of this character string in the cmd run stdout \
\ will be monitored during execution. When observed, the \
\ stack will be killed and a return code of 0 will be returned."
cmdrun <- behaviorOption
( long "cmd_run"
<> metavar "BEHAVIOR"
<> help "`cmd run` behavior"
<> showDefault
<> maybe mempty value messageCmdRunOut
<> value cmdrun
)
messageCmdRunErr <- optional $ strOption
( long "message_cmd_run_stderr"
<> metavar "STRING"
<> help
"The appearance of this character string in the cmd run stdout \
\ will be monitored during execution. When observed, the \
\ stack will be killed and a return code of 0 will be returned."
cmdlisten <- behaviorOption
( long "cmd_listen"
<> metavar "BEHAVIOR"
<> help "`cmd listen` behavior"
<> showDefault
<> maybe mempty value messageCmdRunErr
<> value cmdlisten
)
messageCmdListenOut <- optional $ strOption
( long "message_cmd_listen_stdout"
<> metavar "STRING"
<> help
"The appearance of this character string in the cmd listen stdout \
\ will be monitored during execution. When observed, the \
\ stack will be killed and a return code of 0 will be returned."
cmdlistenprogress <- behaviorOption
( long "cmd_listen_progress"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter progress` behavior"
<> showDefault
<> maybe mempty value messageCmdListenOut
<> value cmdlistenprogress
)
messageCmdListenErr <- optional $ strOption
( long "message_cmd_listen_stderr"
<> metavar "STRING"
<> help
"The appearance of this character string in the cmd listen stdout \
\ will be monitored during execution. When observed, the \
\ stack will be killed and a return code of 0 will be returned."
cmdlistenpower <- behaviorOption
( long "cmd_listen_power"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter power` behavior"
<> showDefault
<> maybe mempty value messageCmdListenErr
<> value cmdlistenpower
)
pure StackArgs {..}
This diff is collapsed.
......@@ -3,6 +3,7 @@
module Argo.Utils where
import Argo.Args
import Turtle
import Prelude hiding ( FilePath )
import System.Console.ANSI
......@@ -37,7 +38,7 @@ printCommand = printf ("Running: " % s % "\n")
printWarning = colorShell Yellow . printf ("Warning: " % s)
printError = colorShell Red . printf ("Error: " % s)
printSuccess = colorShell Green . printf ("Success: " % s)
printTest = colorShell Green . printf ("RUNNING TEST: " % s%"\n")
printTest = colorShell Green . printf ("RUNNING TEST: " % s % "\n")
dieRed str =
colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1)
......@@ -60,7 +61,7 @@ sudoRemoveFile printer desc filePath = do
go useSudo = do
printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath
shell
(format ((if useSudo then "sudo " else "") % "rm -f " % fp) filePath)
(format ((if useSudo then "sudo " else "") % "rm -rf " % fp) filePath)
Turtle.empty
>>= \case
ExitSuccess -> colorShell Green $ printf " Successfully removed.\n"
......@@ -82,36 +83,36 @@ verboseShell' command input =
printCommand command >> shellStrictWithErr command input
cleanSocket = sudoRemoveFile printError "socket"
cleanLog = sudoRemoveFile printWarning "log file"
cleanLog = sudoRemoveFile printWarning "log folder"
kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
data PatternMatched = PatternMatched deriving (Show, Typeable)
instance Exception PatternMatched
data Instrumentation = Instrumentation
{ process :: CreateProcess
, stdOutFile :: FilePath
, stdErrFile :: FilePath
, messageOut :: Maybe Text
, messageErr :: Maybe Text } deriving (Show)
CreateProcess
StdOutLog
StdErrLog
(Maybe TestText)
deriving (Show)
runI :: Instrumentation -> IO (Either PatternMatched (ExitCode, (), ()))
runI Instrumentation {..} = try (reroutedDaemon process)
runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try
(reroutedDaemon cp)
where
reroutedDaemon process =
withSinkFile (encodeString stdOutFile) $ \outSink ->
withSinkFile (encodeString stdErrFile)
$ \errSink -> sourceProcessWithStreams
withSinkFile (T.unpack out)
$ \outSink ->
withSinkFile (T.unpack err) $ \errSink -> sourceProcessWithStreams
process
mempty
(makeMatcher messageOut .| outSink)
(makeMatcher messageErr .| errSink)
(makeMatcher t .| outSink)
(makeMatcher t .| errSink)
makeMatcher maybeMessage = case maybeMessage of
Just msg -> untilMatch msg
Nothing -> awaitForever yield
Just (TestText msg) -> untilMatch msg
Nothing -> awaitForever yield
untilMatch :: Text -> ConduitT ByteString ByteString IO ()
untilMatch message = do
inb <- await
......@@ -122,3 +123,9 @@ runI Instrumentation {..} = try (reroutedDaemon process)
yield b
untilMatch message
_ -> return ()
processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation
processBehaviorToI cp = \case
DontRun -> Nothing
JustRun out err -> Just $ Instrumentation cp out err Nothing
SucceedTestOnMessage t out err -> Just $ Instrumentation cp out err (Just t)
......@@ -16,7 +16,7 @@ executable argotk
main-is: argotk.hs
-- other-modules:
-- other-extensions:
build-depends: base, shake
build-depends: base, shake, argo, turtle, data-default, async, unix, text, optparse-applicative, foldl, ansi-terminal
--hs-source-dirs: src
default-language: Haskell2010
GHC-Options: -Wall
This diff is collapsed.
......@@ -18,6 +18,7 @@ let
hpkgs = pkgs.haskellPackages.override {
overrides = self: super: rec {
argo = self.callCabal2nix "argo" (filterHdevTools ./argo) {};
argotk = self.callCabal2nix "argotk" (filterHdevTools ./argotk) {};
};
};
......@@ -49,17 +50,23 @@ in rec
amg = pkgs.applications.nrm.amg;
inherit(hpkgs) argo;
inherit(hpkgs) argo argotk;
dev-lib = hpkgs.shellFor {
hack-argo = hpkgs.shellFor {
packages = p: with p; [ argo ];
withHoogle = true;
buildInputs = devInputs ++ devHPackages;
};
hack-argotk = hpkgs.shellFor {
packages = p: with p; [ argotk ];
withHoogle = true;
buildInputs = devInputs ++ devHPackages;
};
manifests = ./manifests;
argotk = pkgs.stdenv.mkDerivation rec {
argotkp = pkgs.stdenv.mkDerivation rec {
name = "env";
env = pkgs.buildEnv { name = name; paths = buildInputs ++ propagatedBuildInputs; };
src = filterHdevTools ./argotk;
......@@ -84,7 +91,7 @@ in rec
name = "env";
env = pkgs.buildEnv { name = name; paths = buildInputs; };
buildInputs = [
argotk
argotkp
pkgs.coreutils
pkgs.utillinux
containers
......
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