Commit 7477ba06 authored by Valentin Reis's avatar Valentin Reis

Initial commit

parents
Pipeline #5023 failed with stage
in 0 seconds
#### integration testing
Integration tests that validate the argo stack, leveraging the 'argopkgs'
repository. The intended usage is to override (some of) the source(s) with WIP
version(s), as part of development or continuous integration.
### Usage (tl;dr, I already have nix on my machine.)
```bash
nix-shell -E '
(import( builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/argotest.git;
ref="master";
}) {
#nrm-src = /path/to/nrm
#libnrm-src = /path/to/nrm
#containers-src = /path/to/nrm
}).test' --run "argotk.hs TestHello"
```
### Usage (in three parts)
- [**1**] Get Nix: `curl https://nixos.org/nix/install | sh`
- [**2**] Use the `test` attribute of the argotest' nix attribute set to enter a
test environment. For example, we can run default tests on the
"argopkgs-pinned" version of argo components using:
```bash
nix-shell -E '
let
argotest-src =
builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/argotest.git;
ref="master";
};
argotest = import argotest-src {};
in
argotest.test'
```
This environment has all the necessary Argo components in its PATH. The
argotest function has various arguments, defined in the default.nix file at the
rooto of this repository. They all have default values. For a more involved
example, let's get a custom test environment.
Here, we'll use an environment that uses a local `nrm` source, the master
`libnrm` branch and a specific revision of the `containers` branch. We'l'l use
the master `argotest` branch for that:
```nix
nix-shell -E '{ argotest ? (builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/argotest.git;
ref="master";})
}:
(import argotest {
nrm-src = /path/to/nrm;
libnrm-src = builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/libnrm.git;
ref="master"; };
containers-src = builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/containers.git;
ref="fancy-branch-name";
rev="commit-revisions-string";
};
}).test' --run 'argotk.hs TestHello'
```
- [**3**] The `test`environment contains the `argotk.hs` tool, which runs various
operations on the argo stack:
Commands list:
```{.bash}
argotk.hs --help
```
Output:
```{.txt pipe="sh"}
root/argotk/argotk.hs --help
```
Detailed help:
```{.bash}
argotk.hs TestHello --help
```
Output:
```{.txt pipe="sh"}
root/argotk/argotk.hs TestHello --help
```
#### Misc
Alternatively, one can use the `--run` option to run a test directly:
```bash
nix-shell -E '
(import( builtins.fetchGit {
url = https://xgitlab.cels.anl.gov/argo/argotest.git;
ref="master";
}) {}).test' --run "argotk.hs TestHello"
```
#### WARNINGS
There are a few things one has to be aware of using this workflow:
- Builds may fail if the local source repositories are dirty with old build files.
- Without using the `rev` argument, the `builtins.fetchGit` nix command
prefetches and buffers its output, with an expiration time that ranges ten
minutes by default. Use a local checkout if you need to modify some of these
sources on the fly.
### Hacking
- edit `.README.md` in place of README.md.
- the ./shake.hs build file takes care of a few things for the development
workflow (readme and completion generation).
.argo_nodeos_config_exit_message
_output
result
.shake
*.log
*/build
*/new-build
*/dist
*/new-dist
*/result
_output
*/_output
stages:
- test
locally-sourced-tests.test:
stage: test
script:
- nix-shell -A test --run "argotk.hs tests"
except:
- /^wip\/.*/
- /^WIP\/.*/
artifacts:
when: always
paths:
- _output/*.log
- _output/.argo_nodeos_config_exit_message
tags:
- integration
all-test-provenances.test:
stage: test
script:
- nix-build -A test-list
except:
- /^wip\/.*/
- /^WIP\/.*/
artifacts:
when: always
paths:
- result
tags:
- integration
# Revision history for argo
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.
Copyright (c) 2018 Valentin Reis
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
This diff is collapsed.
{
"fetch": {
"args": {
"fetchSubmodules": false,
"rev": "a7e6a1136bf87d4e3ba51749c7f142f310536796",
"sha256": "1l6i4lq2zh1hj7zwywvckskfp3lrw06bn8x2h9ip8rq4lby88s5x",
"url": "https://xgitlab.cels.anl.gov/argo/argopkgs.git"
},
"fn": "fetchgit"
},
"rev": "refs/heads/master",
"type": "fetchgit",
"url": "https://xgitlab.cels.anl.gov/argo/argopkgs.git"
}
\ No newline at end of file
name: argotk
version: 0.1.0.0
license: MIT
license-file: LICENSE
author: Valentin Reis
maintainer: fre@freux.fr
build-type: Simple
extra-source-files: ChangeLog.md
cabal-version: >=1.10
executable argotk
main-is: argotk.hs
-- other-modules:
-- other-extensions:
build-depends: base, shake, turtle, data-default, async, unix, text, optparse-applicative, foldl, ansi-terminal, conduit, process, unliftio-core, conduit-extra, bytestring, system-filepath, pretty-show
hs-source-dirs: src
default-language: Haskell2010
ghc-options:
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wmissing-home-modules
-Widentities
-Wredundant-constraints
-Wcpp-undef
-fwarn-tabs
-fwarn-unused-imports
-fwarn-missing-signatures
-fwarn-name-shadowing
-fprint-potential-instances
-Wmissing-export-list
-fwarn-incomplete-patterns
_argotk.hs()
{
local CMDLINE
local IFS=$'\n'
CMDLINE=(--bash-completion-index $COMP_CWORD)
for arg in ${COMP_WORDS[@]}; do
CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)
done
COMPREPLY=( $(argotk.hs "${CMDLINE[@]}") )
}
complete -o filenames -F _argotk.hs argotk.hs
{
hostPkgs ? import <nixpkgs> {},
pkgs ? import (hostPkgs.nix-update-source.fetch ./argopkgs.json).src {},
}:
let
filterHdevTools = builtins.filterSource (path: type: baseNameOf path != ".hdevtools.sock");
hpkgs = pkgs.haskellPackages.override {
overrides = self: super: rec {
argotk = self.callCabal2nix "argotk" (filterHdevTools ./.) {};
};
};
devInputs = with hpkgs; with pkgs; [
sysstat
];
devHPackages = with hpkgs; [
cabal-install
apply-refact
hdevtools
hindent
hlint
shake
brittany
ghcid
];
in rec
{
inherit(hpkgs) argotk;
hack = hpkgs.shellFor {
packages = p: with p; [ argotk ];
withHoogle = true;
buildInputs = devInputs ++ devHPackages;
};
}
#! /usr/bin/env runhaskell
import Development.Shake
import Development.Shake.FilePath
import Control.Monad
main = shakeArgs shakeOptions $ do
phony "clean" $ do
removeFilesAfter "completion" ["//*"]
removeFilesAfter "." ["README.md"]
want ["README.md", "completion/argotk.sh"]
"completion/*.sh"
%> \out -> mkCompletionRule out "bash" $ takeFileName out -<.> "hs"
"README.md" %> \out -> do
let template = ".README.md"
need [template , "argotk/argotk.hs" , "argo/src/Argo/Stack.hs"]
(Stdout panpipe) <- cmd "which panpipe"
cmd_ "pandoc --filter"
[take (length panpipe - 1) panpipe, template, "-o", out]
where
mkCompletionAction str sn =
(sn, cmd ("argotk/" ++ sn) ["--" ++ str ++ "-completion-script", sn])
mkCompletionRule out str fn = do
let (needed, cplA) = mkCompletionAction str fn
(Stdout cplScript) <- cplA
liftIO $ writeFile out cplScript
{-|
Module : Argo
Description : The holt core package
Copyright : (c) Valentin Reis, 2018
License : MIT
Maintainer : fre@freux.fr
-}
module Argo
( module Argo.Stack
, module Argo.Args
, module Argo.Utils
)
where
import Argo.Stack
import Argo.Utils
import Argo.Args
{-# 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 hiding ( option )
import Prelude hiding ( FilePath )
data StackArgs = StackArgs
{ verbosity :: Verbosity
, app :: AppName
, args :: [AppArg]
, containerName :: ContainerName
, workingDirectory :: WorkingDirectory
, manifestDir :: ManifestDir
, manifestName :: ManifestName
, daemon :: ProcessBehavior
, cmdrun :: ProcessBehavior
, cmdlisten :: ProcessBehavior
, cmdlistenprogress :: ProcessBehavior
, cmdlistenperformance :: ProcessBehavior
, cmdlistenpower :: ProcessBehavior
} deriving (Show)
{-data OutputFiles = OutputFiles FilePath FilePath-}
data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
newtype AppArg = AppArg Text deriving (IsString, 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)
data ProcessBehavior =
Test TestText StdOutLog StdErrLog
| JustRun StdOutLog StdErrLog
| DontRun deriving (Show,Read)
newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
data TestText = TestText TextBehaviorStdout TextBehaviorStderr deriving (Show, Read)
newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior deriving (Show, Read)
newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior deriving (Show, Read)
data TextBehavior =
WaitFor Text
| ExpectClean deriving (Show,Read)
behavior :: ReadM ProcessBehavior
behavior = read <$> readerAsk
behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
behaviorOption = option behavior
instance Default StackArgs where
def = StackArgs
{ verbosity = Normal
, app = AppName "ls"
, args = []
, containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output"
, manifestDir = ManifestDir "manifests"
, manifestName = ManifestName "basic.json"
, daemon = DontRun
, cmdrun = DontRun
, cmdlisten = DontRun
, cmdlistenprogress = DontRun
, cmdlistenperformance = DontRun
, cmdlistenpower = DontRun
}
parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs sa = do
verbosity <- flag
Normal
Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode")
app <- strOption
( long "app"
<> metavar "APP"
<> help "Target application executable name. PATH is inherited."
<> showDefault
<> value (app sa)
)
containerName <- strOption
( long "container_name"
<> metavar "ARGO_CONTAINER_UUID"
<> help "Container name"
<> showDefault
<> value (containerName sa)
)
workingDirectory <- strOption
( long "output_dir"
<> metavar "DIR"
<> help "Working directory."
<> showDefault
<> value (workingDirectory sa)
)
manifestDir <- strOption
( long "manifest_directory"
<> metavar "DIR"
<> help "Manifest lookup directory"
<> showDefault
<> value (manifestDir sa)
)
manifestName <- strOption
( long "manifest_name"
<> metavar "FILENAME"
<> help "Manifest file basename (relative to --manifest_directory)"
<> showDefault
<> value (manifestName sa)
)
daemon <- behaviorOption
( long "daemon"
<> metavar "BEHAVIOR"
<> help "`daemon` behavior"
<> showDefault
<> value (daemon sa)
)
cmdrun <- behaviorOption
( long "cmd_run"
<> metavar "BEHAVIOR"
<> help "`cmd run` behavior"
<> showDefault
<> value (cmdrun sa)
)
cmdlisten <- behaviorOption
( long "cmd_listen"
<> metavar "BEHAVIOR"
<> help "`cmd listen` behavior"
<> showDefault
<> value (cmdlisten sa)
)
cmdlistenperformance <- behaviorOption
( long "cmd_listen_performance"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter performance` behavior"
<> showDefault
<> value (cmdlistenperformance sa)
)
cmdlistenprogress <- behaviorOption
( long "cmd_listen_progress"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter progress` behavior"
<> showDefault
<> value (cmdlistenprogress sa)
)
cmdlistenpower <- behaviorOption
( long "cmd_listen_power"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter power` behavior"
<> showDefault
<> value (cmdlistenpower sa)
)
args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
<|> pure (args sa)
pure StackArgs {..}
{-# LANGUAGE
TupleSections,
LambdaCase,
RecordWildCards,
OverloadedStrings #-}
module Argo.Stack where
import Argo.Args
import Turtle
import Turtle.Shell
import Prelude hiding ( FilePath )
import Filesystem.Path ( (</>) )
import Control.Concurrent.Async
import Data.Text as T
hiding ( empty )
import Argo.Utils
import System.Process as P
hiding ( shell )
import Control.Monad as CM
import Data.Maybe
import Control.Foldl as Fold
import Text.Show.Pretty
cleanLeftovers :: WorkingDirectory -> Shell ()
cleanLeftovers (WorkingDirectory wd) = do
printInfo "Cleaning working(output) directory."
cleanLog wd
printInfo "Cleaning sockets."
CM.mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
checkFsAttributes :: FilePath -> Shell ()
checkFsAttributes workingDirectory = do
let dir = case toText workingDirectory of
Left di -> di
Right di -> di
let findmnt = inproc "findmnt" ["-T", dir, "-o", "OPTIONS"] empty
b <- liftIO $ Turtle.Shell.fold (grep (has "nosuid") findmnt) Fold.length
when (b > 0) $ dieRed $ format
("The output directory, " % fp % ", must not mounted with \"nosuid\"")
workingDirectory
prepareDaemon
:: StdOutLog -> StdErrLog -> Maybe TestText -> Shell Instrumentation
prepareDaemon out stdErr test = do
_ <- myWhich "daemon"
confPath <- myWhich "argo_nodeos_config"
let confPath' = "./argo_nodeos_config"
cp confPath confPath'
printInfo $ format ("Copied the configurator to " % fp) confPath'
printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config"
verboseShell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root."
ExitFailure n ->
die ("Failed to set argo_nodeos_config permissions " <> repr n)
verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
ExitSuccess -> printInfo "Set the suid bit."
ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
cleanContainers confPath' 1 2
export "ARGO_NODEOS_CONFIG" (format fp confPath')
return $ Instrumentation (P.proc "daemon" []) out stdErr test
where
nodeOsFailure n = do
printError ("argo_nodeos_config failed with exit code :" <> repr n)
testfile ".argo_nodeos_config_exit_message" >>= \case
True -> do
printInfo "Contents of .argo_nodeos_config_exit_message: "
view $ input ".argo_nodeos_config_exit_message"
False -> die ("argo_nodeos_config failed with exit code " <> repr n)
cleanContainers :: FilePath -> NominalDiffTime -> Integer -> Shell ()
cleanContainers argo_nodeos_config retryTime remainingRetries = do
let showConfig =
inshell (format (fp % " --show_config") argo_nodeos_config) empty
verboseShell'
(format (fp % " --clean_config=kill_content:true") argo_nodeos_config)
empty
>>= \case
(ExitFailure n, _, _) -> do
when (remainingRetries == 0) $ nodeOsFailure n
printWarning
( "the argo_nodeos_config call failed with exit code "
<> repr n
<> ". Retrying.."
)
liftIO $ sleep (retryTime * 2)
cleanContainers argo_nodeos_config
(retryTime * 2)
(remainingRetries - 1)
(ExitSuccess, _, _) -> do
printInfo "Cleaned the argo config."
len <- liftIO $ Turtle.Shell.fold
(grep (has "CONTAINER") showConfig)
Fold.length
if len > 0
then do
printWarning
"the argo_nodeos_config call did not remove containers, \
\at least not fast enough. Retrying.."
liftIO $ sleep retryTime
cleanContainers argo_nodeos_config
(retryTime * 2)
(remainingRetries - 1)
else
printInfo
"argo_nodeos_config successfully cleaned the container \
\config."
cmdRunI
:: AppName
-> [AppArg]
-> ContainerName
-> ManifestDir
-> ManifestName
-> ProcessBehavior
-> Maybe (StackI, Instrumentation)
cmdRunI (AppName app) args (ContainerName cn) (ManifestDir md) (ManifestName mn) pb
= Just (Run, )
<*> processBehaviorToI
( P.proc "cmd"
$ ["run", "-u", T.unpack cn, encodeString $ md </> mn, T.unpack app]
++ fmap (T.unpack . argToText) args
)
pb
where argToText (AppArg a) = a
cmdListenI
:: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
cmdListenI (ContainerName cn) pb =
Just (Listen, )
<*> processBehaviorToI (P.proc "cmd" ["listen", "-u", T.unpack cn]) pb
cmdListenProgressI
:: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
cmdListenProgressI (ContainerName cn) pb =
Just (Progress, )
<*> processBehaviorToI
(P.proc "cmd" ["listen", "-u", T.unpack cn, "--filter", "progress"])
pb
cmdListenPerformanceI
:: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
cmdListenPerformanceI (ContainerName cn) pb =
Just (Performance, )
<*> processBehaviorToI
(P.proc "cmd" ["listen", "-u", T.unpack cn, "--filter", "performance"]
)
pb
cmdListenPowerI
:: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
cmdListenPowerI (ContainerName cn) pb =
Just (Power, )
<*> processBehaviorToI
(P.proc "cmd" ["listen", "-u", T.unpack cn, "--filter", "power"])
pb
data StackOutput =
FoundMessage Text
| FoundTracebacks Tracebacks
| Died StackI ExitCode TracebackScanOut TracebackScanErr Tracebacks deriving (Show)
type Tracebacks = [(StackI, Text, Text)]
newtype TracebackScanOut = TracebackScanOut TracebackScan deriving (Show)
newtype TracebackScanErr = TracebackScanErr TracebackScan deriving (Show)
data StackI = Daemon | Run | Listen | Progress | Power | Performance deriving (Eq)
instance Show StackI where
show = \case
Daemon -> "daemon"
Run -> "cmd run"
Listen -> "cmd listen -v"
Progress -> "cmd listen -f progress"
Power -> "cmd listen -f power"
Performance -> "cmd listen -f performance"
runStack :: StackArgs -> Shell StackOutput
runStack sa@StackArgs {..} = do
when (verbosity == Verbose) $ liftIO $ pPrint sa
CM.mapM_
cleanSocket
[ "/tmp/nrm-downstream-in"
, "/tmp/nrm-upstream-in"
, "/tmp/nrm-upstream-event"
]
let (WorkingDirectory wd) = workingDirectory
_ <- Turtle.shell (format ("rm -rf " % fp) wd) Turtle.empty
mktree wd
checkFsAttributes wd
cd wd
iDaemon <- case daemon of
DontRun -> return Nothing
JustRun stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing
Test t stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t)
let milist =
[ iDaemon
, cmdRunI app args containerName manifestDir manifestName cmdrun
, cmdListenI containerName cmdlisten
, cmdListenPerformanceI containerName cmdlistenperformance
, cmdListenProgressI containerName cmdlistenprogress
, cmdListenPowerI containerName cmdlistenpower
]
ilist = catMaybes milist
if verbosity == Verbose
then do
printInfo "Starting the following processes:"
liftIO $ pPrint ilist
else liftIO $ pPrint (fmap fst ilist)
asyncs <- liftIO $ mapM tupleToAsync ilist
_ <- liftIO $ kbInstallHandler $ CM.mapM_ cancel asyncs
when (verbosity == Verbose) $ printInfo "Processes started."
out <- liftIO $ waitAnyCancel asyncs
printInfo
( "Processes cancelled due to termination of: "
<> repr (fst $ snd out)
<> " with exit information: "
<> repr (snd $ snd out)
)
tracebackList <- procsWithTracebacks ilist
r <- case snd out of
(_, Left (PatternMatched line)) -> case tracebackList of
[] -> return $ FoundMessage line
t -> return $ FoundTracebacks t
(stacki, Right (errmsg, tracebackOut, tracebackErr)) -> return $ Died
stacki
errmsg
(TracebackScanOut tracebackOut)