Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Valentin Reis
argotest
Commits
0bc48edd
Commit
0bc48edd
authored
Jan 11, 2019
by
Valentin Reis
Browse files
[refactor] power experiment refactor.
parent
78474c1a
Pipeline
#4918
failed with stage
in 4 seconds
Changes
10
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
argo/argo.cabal
View file @
0bc48edd
...
...
@@ -15,3 +15,18 @@ library
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
ghc-options:
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wmissing-home-modules
-Widentities
-Wredundant-constraints
-Wcpp-undef
-Wmissing-export-li
-fwarn-tabs
-fwarn-unused-imports
-fwarn-missing-signatures
-fwarn-name-shadowing
-fwarn-incomplete-patternssts
-fprint-potential-instances
argo/src/Argo.hs
View file @
0bc48edd
{-|
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
.
Args
,
module
Argo
.
Utils
)
where
...
...
argo/src/Argo/Args.hs
View file @
0bc48edd
...
...
@@ -11,14 +11,12 @@ import Data.Text as T
import
Turtle
hiding
(
option
)
import
Prelude
hiding
(
FilePath
)
import
System.Process
hiding
(
shell
)
data
OutputFiles
=
OutputFiles
FilePath
FilePath
data
StackArgs
=
StackArgs
{
verbosity
::
Verbosity
,
app
::
AppName
,
args
::
AppArg
s
,
args
::
[
AppArg
]
,
containerName
::
ContainerName
,
workingDirectory
::
WorkingDirectory
,
manifestDir
::
ManifestDir
...
...
@@ -27,11 +25,13 @@ data StackArgs = StackArgs
,
cmdrun
::
ProcessBehavior
,
cmdlisten
::
ProcessBehavior
,
cmdlistenprogress
::
ProcessBehavior
,
cmdlistenperformance
::
ProcessBehavior
,
cmdlistenpower
::
ProcessBehavior
}
{-data OutputFiles = OutputFiles FilePath FilePath-}
data
Verbosity
=
Normal
|
Verbose
deriving
(
Show
,
Read
,
Eq
)
newtype
AppArg
s
=
AppArg
s
[
Text
]
deriving
(
Show
,
Read
)
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
)
...
...
@@ -56,7 +56,7 @@ instance Default StackArgs where
def
=
StackArgs
{
verbosity
=
Normal
,
app
=
AppName
"ls"
,
args
=
AppArgs
[]
,
args
=
[]
,
containerName
=
ContainerName
"testContainer"
,
workingDirectory
=
WorkingDirectory
"_output"
,
manifestDir
=
ManifestDir
"manifests"
...
...
@@ -65,83 +65,95 @@ instance Default StackArgs where
,
cmdrun
=
DontRun
,
cmdlisten
=
DontRun
,
cmdlistenprogress
=
DontRun
,
cmdlistenperformance
=
DontRun
,
cmdlistenpower
=
DontRun
}
parseExtendStackArgs
::
StackArgs
->
Parser
StackArgs
parseExtendStackArgs
StackArgs
{
..
}
=
do
parseExtendStackArgs
sa
=
do
verbosity
<-
flag
Normal
Verbose
(
long
"verbose"
<>
short
'v'
<>
help
"Enable verbose mode"
)
app
<-
strOption
(
long
"app
lication
"
(
long
"app"
<>
metavar
"APP"
<>
help
"Target application executable name. PATH is inherited."
<>
showDefault
<>
value
app
<>
value
(
app
sa
)
)
args
<-
many
(
argument
auto
(
metavar
"ARGS"
<>
help
"Application arguments."
))
containerName
<-
strOption
(
long
"container_name"
<>
metavar
"ARGO_CONTAINER_UUID"
<>
help
"Container name"
<>
showDefault
<>
value
containerName
<>
value
(
containerName
sa
)
)
workingDirectory
<-
strOption
(
long
"output_dir"
<>
metavar
"DIR"
<>
help
"Working directory."
<>
showDefault
<>
value
workingDirectory
<>
value
(
workingDirectory
sa
)
)
manifestDir
<-
strOption
(
long
"manifest_directory"
<>
metavar
"DIR"
<>
help
"Manifest lookup directory"
<>
showDefault
<>
value
manifestDir
<>
value
(
manifestDir
sa
)
)
manifestName
<-
strOption
(
long
"manifest_name"
<>
metavar
"FILENAME"
<>
help
"Manifest file basename (relative to --manifest_directory)"
<>
showDefault
<>
value
manifestName
<>
value
(
manifestName
sa
)
)
daemon
<-
behaviorOption
(
long
"daemon"
<>
metavar
"BEHAVIOR"
<>
help
"`daemon` behavior"
<>
showDefault
<>
value
daemon
<>
value
(
daemon
sa
)
)
cmdrun
<-
behaviorOption
(
long
"cmd_run"
<>
metavar
"BEHAVIOR"
<>
help
"`cmd run` behavior"
<>
showDefault
<>
value
cmdrun
<>
value
(
cmdrun
sa
)
)
cmdlisten
<-
behaviorOption
(
long
"cmd_listen"
<>
metavar
"BEHAVIOR"
<>
help
"`cmd listen` behavior"
<>
showDefault
<>
value
cmdlisten
<>
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
<>
value
(
cmdlistenprogress
sa
)
)
cmdlistenpower
<-
behaviorOption
(
long
"cmd_listen_power"
<>
metavar
"BEHAVIOR"
<>
help
"`cmd listen --filter power` behavior"
<>
showDefault
<>
value
cmdlistenpower
<>
value
(
cmdlistenpower
sa
)
)
pure
StackArgs
{
..
}
argo/src/Argo/Stack.hs
View file @
0bc48edd
...
...
@@ -16,32 +16,16 @@ import Turtle
import
Turtle.Shell
import
Prelude
hiding
(
FilePath
)
import
System.IO
(
withFile
)
import
Debug.Trace
import
Filesystem.Path
(
(
</>
)
)
import
Control.Concurrent.Async
import
Control.Monad.STM
(
atomically
,
orElse
)
import
System.Console.ANSI
import
System.Console.ANSI.Types
(
Color
)
import
Data.Text
as
T
hiding
(
empty
)
import
Data.Text.IO
as
Text
import
Argo.Utils
import
System.Process
as
P
hiding
(
shell
)
import
Options.Applicative
as
OA
import
Control.Monad.Extra
as
E
import
Control.Monad
as
CM
import
Control.Foldl
as
F
import
Data.Conduit
import
Data.Conduit.Process
import
Data.ByteString.Char8
as
C8
hiding
(
empty
)
import
Control.Exception.Base
import
Data.Maybe
import
Control.Foldl
as
Fold
import
Text.Show.Pretty
...
...
@@ -55,10 +39,10 @@ cleanLeftovers (WorkingDirectory wd) = do
checkFsAttributes
::
FilePath
->
Shell
()
checkFsAttributes
workingDirectory
=
do
let
x
=
case
toText
workingDirectory
of
Left
x
->
x
Right
x
->
x
let
findmnt
=
inproc
"findmnt"
[
"-T"
,
x
,
"-o"
,
"OPTIONS"
]
empty
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
\"
"
)
...
...
@@ -66,8 +50,8 @@ checkFsAttributes workingDirectory = do
prepareDaemon
::
StdOutLog
->
StdErrLog
->
Maybe
TestText
->
Shell
Instrumentation
prepareDaemon
(
StdOutLog
out
)
(
StdErrLog
err
)
test
=
do
myWhich
"daemon"
prepareDaemon
out
stdErr
test
=
do
_
<-
myWhich
"daemon"
confPath
<-
myWhich
"argo_nodeos_config"
let
confPath'
=
"./argo_nodeos_config"
cp
confPath
confPath'
...
...
@@ -82,32 +66,26 @@ prepareDaemon (StdOutLog out) (StdErrLog err) test = do
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"
[]
)
(
StdOutLog
out
)
(
StdErrLog
err
)
test
return
$
Instrumentation
(
P
.
proc
"daemon"
[]
)
out
stdErr
test
where
nodeOsFailure
(
ExitFailure
n
,
_
,
_
)
=
do
nodeOsFailure
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
(
"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
(
isClean
::
IO
Bool
)
=
liftIO
(
Turtle
.
Shell
.
fold
(
grep
(
has
"CONTAINER"
)
showConfig
)
Fold
.
length
)
>>=
(
\
x
->
return
$
x
>
5
)
verboseShell'
(
format
(
fp
%
" --clean_config=kill_content:true"
)
argo_nodeos_config
)
empty
>>=
\
case
e
@
(
ExitFailure
n
,
out
,
err
)
->
do
when
(
remainingRetries
==
0
)
$
nodeOsFailure
e
(
ExitFailure
n
,
_
,
_
)
->
do
when
(
remainingRetries
==
0
)
$
nodeOsFailure
n
printWarning
(
"the argo_nodeos_config call failed with exit code "
<>
repr
n
...
...
@@ -119,10 +97,10 @@ prepareDaemon (StdOutLog out) (StdErrLog err) test = do
(
remainingRetries
-
1
)
(
ExitSuccess
,
_
,
_
)
->
do
printInfo
"Cleaned the argo config.
\n
"
l
<-
liftIO
$
Turtle
.
Shell
.
fold
l
en
<-
liftIO
$
Turtle
.
Shell
.
fold
(
grep
(
has
"CONTAINER"
)
showConfig
)
Fold
.
length
if
l
>
0
if
l
en
>
0
then
do
printWarning
"the argo_nodeos_config call did not remove containers,
\
...
...
@@ -138,20 +116,21 @@ prepareDaemon (StdOutLog out) (StdErrLog err) test = do
cmdRunI
::
AppName
->
AppArg
s
->
[
AppArg
]
->
ContainerName
->
ManifestDir
->
ManifestName
->
ProcessBehavior
->
Maybe
(
StackI
,
Instrumentation
)
cmdRunI
(
AppName
app
)
(
AppArgs
args
)
(
ContainerName
cn
)
(
ManifestDir
md
)
(
ManifestName
mn
)
pb
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
args
++
fmap
(
T
.
unpack
.
argToText
)
args
)
pb
where
argToText
(
AppArg
a
)
=
a
cmdListenI
::
ContainerName
->
ProcessBehavior
->
Maybe
(
StackI
,
Instrumentation
)
...
...
@@ -167,6 +146,15 @@ cmdListenProgressI (ContainerName cn) pb =
(
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
=
...
...
@@ -179,28 +167,34 @@ data StackOutput =
FoundMessage
|
Died
StackI
ExitCode
data
StackI
=
Daemon
|
Run
|
Listen
|
Progress
|
Power
deriving
(
Show
)
data
StackI
=
Daemon
|
Run
|
Listen
|
Progress
|
Power
|
Performance
deriving
(
Show
)
runStack
::
StackArgs
->
Shell
StackOutput
runStack
a
@
StackArgs
{
..
}
=
do
CM
.
mapM_
cleanSocket
[
"/tmp/nrm-downstream-in"
,
"/tmp/nrm-upstream-in"
,
"/tmp/nrm-upstream-event"
]
runStack
StackArgs
{
..
}
=
do
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
_
<-
Turtle
.
shell
(
format
(
"rm -rf "
%
fp
)
wd
)
Turtle
.
empty
mktree
wd
checkFsAttributes
wd
cd
wd
iDaemon
<-
case
daemon
of
DontRun
->
return
Nothing
JustRun
out
e
rr
->
(
\
x
->
Just
(
Daemon
,
x
))
<$>
prepareDaemon
out
e
rr
Nothing
SucceedTestOnMessage
t
out
e
rr
->
(
\
x
->
Just
(
Daemon
,
x
))
<$>
prepareDaemon
out
e
rr
(
Just
t
)
JustRun
stdOut
stdE
rr
->
(
\
i
->
Just
(
Daemon
,
i
))
<$>
prepareDaemon
stdOut
stdE
rr
Nothing
SucceedTestOnMessage
t
stdOut
stdE
rr
->
(
\
i
->
Just
(
Daemon
,
i
))
<$>
prepareDaemon
stdOut
stdE
rr
(
Just
t
)
let
milist
=
[
iDaemon
,
cmdRunI
app
args
containerName
manifestDir
manifestName
cmdrun
,
cmdListenI
containerName
cmdlisten
,
cmdListenPerformanceI
containerName
cmdlistenperformance
,
cmdListenProgressI
containerName
cmdlistenprogress
,
cmdListenPowerI
containerName
cmdlistenpower
]
...
...
@@ -213,7 +207,7 @@ runStack a@StackArgs {..} = do
else
liftIO
$
pPrint
(
fmap
fst
ilist
)
asyncs
<-
liftIO
$
mapM
tupleToAsync
ilist
liftIO
$
kbInstallHandler
$
CM
.
mapM_
cancel
asyncs
_
<-
liftIO
$
kbInstallHandler
$
CM
.
mapM_
cancel
asyncs
when
(
verbosity
==
Verbose
)
$
printInfo
"Processes started.
\n
"
...
...
@@ -231,7 +225,7 @@ runStack a@StackArgs {..} = do
return
$
case
snd
out
of
(
_
,
Left
PatternMatched
)
->
FoundMessage
(
stacki
,
Right
(
e
,
_
,
_
)
)
->
Died
stacki
e
(
stacki
,
Right
(
e
rrmsg
,
_
,
_
)
)
->
Died
stacki
e
rrmsg
where
tupleToAsync
::
(
StackI
,
Instrumentation
)
...
...
argo/src/Argo/Utils.hs
View file @
0bc48edd
{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
FlexibleInstances, TypeOperators
, RecordWildCards
#-}
FlexibleInstances, TypeOperators #-}
module
Argo.Utils
where
...
...
@@ -22,7 +22,7 @@ import Data.Text as T
-- | Miscellaneous printing utilities
colorShell
::
Color
->
Shell
()
->
Shell
()
colorShell
color
s
=
setC
color
*>
s
*>
setC
White
colorShell
color
s
he
=
setC
color
*>
s
he
*>
setC
White
where
setC
c
=
liftIO
$
setSGR
[
SetColor
Foreground
Dull
c
]
printInfo
::
Text
->
Shell
()
...
...
@@ -42,11 +42,13 @@ printTest = colorShell Green . printf ("RUNNING TEST: " % s % "\n")
dieRed
str
=
colorShell
Red
(
printf
(
"Failure: "
%
s
)
str
)
>>
exit
(
ExitFailure
1
)
myWhich
::
FilePath
->
Shell
FilePath
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
myWhichMaybe
::
FilePath
->
Shell
(
Maybe
FilePath
)
myWhichMaybe
str
=
which
str
>>=
\
case
(
Just
p
)
->
printInfo
(
format
(
"Found "
%
fp
%
" at "
%
fp
%
"
\n
"
)
str
p
)
>>
return
(
Just
p
)
...
...
@@ -65,7 +67,7 @@ sudoRemoveFile printer desc filePath = do
Turtle
.
empty
>>=
\
case
ExitSuccess
->
colorShell
Green
$
printf
" Successfully removed.
\n
"
ExitFailure
n
->
if
useSudo
ExitFailure
_
->
if
useSudo
then
printer
$
format
(
"Failed to remove stale "
%
s
%
", even with sudo."
)
desc
...
...
@@ -76,13 +78,15 @@ sudoRemoveFile printer desc filePath = do
go
True
verboseShell
::
Text
->
Shell
Line
->
Shell
ExitCode
verboseShell
command
i
nput
=
printCommand
command
>>
shell
command
i
nput
verboseShell
command
i
=
printCommand
command
>>
shell
command
i
verboseShell'
::
Text
->
Shell
Line
->
Shell
(
ExitCode
,
Text
,
Text
)
verboseShell'
command
i
nput
=
printCommand
command
>>
shellStrictWithErr
command
i
nput
verboseShell'
command
i
=
printCommand
command
>>
shellStrictWithErr
command
i
cleanSocket
::
FilePath
->
Shell
()
cleanSocket
=
sudoRemoveFile
printError
"socket"
cleanLog
::
FilePath
->
Shell
()
cleanLog
=
sudoRemoveFile
printWarning
"log folder"
kbInstallHandler
::
IO
()
->
IO
Handler
...
...
@@ -99,13 +103,13 @@ data Instrumentation = Instrumentation
deriving
(
Show
)
runI
::
Instrumentation
->
IO
(
Either
PatternMatched
(
ExitCode
,
()
,
()
))
runI
(
Instrumentation
c
p
outlog
@
(
StdOutLog
out
)
errlog
@
(
StdErrLog
e
rr
)
t
)
=
try
(
reroutedDaemon
c
p
)
runI
(
Instrumentation
c
rProc
(
StdOutLog
stdOut
)
(
StdErrLog
stdE
rr
)
t
)
=
try
(
reroutedDaemon
c
rProc
)
where
reroutedDaemon
process
=
withSinkFile
(
T
.
unpack
o
ut
)
withSinkFile
(
T
.
unpack
stdO
ut
)
$
\
outSink
->
withSinkFile
(
T
.
unpack
e
rr
)
$
\
errSink
->
sourceProcessWithStreams
withSinkFile
(
T
.
unpack
stdE
rr
)
$
\
errSink
->
sourceProcessWithStreams
process
mempty
(
makeMatcher
t
.|
outSink
)
...
...
@@ -125,7 +129,7 @@ runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try
_
->
return
()
processBehaviorToI
::
CreateProcess
->
ProcessBehavior
->
Maybe
Instrumentation
processBehaviorToI
c
p
=
\
case
processBehaviorToI
c
rProc
=
\
case
DontRun
->
Nothing
JustRun
out
e
rr
->
Just
$
Instrumentation
c
p
out
e
rr
Nothing
SucceedTestOnMessage
t
out
e
rr
->
Just
$
Instrumentation
c
p
out
e
rr
(
Just
t
)
JustRun
stdOut
stdE
rr
->
Just
$
Instrumentation
c
rProc
stdOut
stdE
rr
Nothing
SucceedTestOnMessage
t
stdOut
stdE
rr
->
Just
$
Instrumentation
c
rProc
stdOut
stdE
rr
(
Just
t
)
argotk/argotk.cabal
View file @
0bc48edd
...
...
@@ -19,4 +19,18 @@ executable argotk
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
ghc-options:
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wmissing-home-modules
-Widentities
-Wredundant-constraints
-Wcpp-undef
-Wmissing-export-li
-fwarn-tabs
-fwarn-unused-imports
-fwarn-missing-signatures
-fwarn-name-shadowing
-fwarn-incomplete-patternssts
-fprint-potential-instances
argotk/argotk.hs
View file @
0bc48edd
...
...
@@ -71,26 +71,27 @@ configureTest = \case
,
isTest
=
IsTest
False
}
DaemonAndApp
->
TestSpec
{
stackArgsUpdate
=
\
sa
->
sa
{
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
,
cmdlistenprogress
=
JustRun
(
StdOutLog
"progress.csv"
)
(
StdErrLog
"progress.log"
)
,
cmdlistenpower
=
JustRun
(
StdOutLog
"power.csv"
)
(
StdErrLog
"power.log"
)
}
{
stackArgsUpdate
=
\
sa
->
sa
{
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
}
,
description
=
"Set up and start daemon, run a command in a container."
,
isTest
=
IsTest
False
}
CsvLogs
->
TestSpec
{
stackArgsUpdate
=
\
sa
->
sa
{
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
}
{
stackArgsUpdate
=
\
sa
->
sa
{
manifestName
=
"perfwrap.json"
,
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
,
cmdlistenperformance
=
JustRun
(
StdOutLog
"performance.csv"
)
(
StdErrLog
"performance.log"
)
,
cmdlistenpower
=
JustRun
(
StdOutLog
"power.csv"
)
(
StdErrLog
"power.log"
)
}
,
description
=
"Set up and start daemon, run a command in a container."
,
isTest
=
IsTest
False
}
TestHello
->
TestSpec
{
stackArgsUpdate
=
\
sa
->
sa
{
app
=
AppName
"echo"
,
args
=
AppArg
s
[
msg
]
,
args
=
[
AppArg
msg
]
,
daemon
=
daemonBehavior
,
cmdrun
=
SucceedTestOnMessage
(
TestText
msg
)
(
StdOutLog
"monitored-cmdrun-out.log"
)
...
...
@@ -103,7 +104,7 @@ configureTest = \case
TestListen
->
TestSpec
{
stackArgsUpdate
=
\
sa
->
sa
{
app
=
AppName
"sleep"
,
args
=
AppArg
s
[
"15"
]
,
args
=
[
AppArg
"15"
]
,
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
,
cmdlisten
=
listentestBehavior
(
TestText
","
)
...
...
@@ -116,7 +117,7 @@ configureTest = \case
{
stackArgsUpdate
=
\
sa
->
sa
{
manifestName
=
"perfwrap.json"
,
app
=
AppName
"sleep"
,
args
=
AppArg
s
[
"15"
]
,
args
=
[
AppArg
"15"
]
,
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
,
cmdlisten
=
listentestBehavior
(
TestText
"performance"
)
...
...
@@ -129,7 +130,7 @@ configureTest = \case
TestPower
->
TestSpec
{
stackArgsUpdate
=
\
sa
->
sa
{
app
=
AppName
"sleep"
,
args
=
AppArg
s
[
"15"
]
,
args
=
[
AppArg
"15"
]
,
daemon
=
daemonBehavior
,
cmdrun
=
runBehavior
,
cmdlisten
=
listentestBehavior
(
TestText
"power"
)
...
...
default.nix
View file @
0bc48edd
{
argopkgs-src
?
let
hostPkgs
=
import
<
nixpkgs
>
{};
pinnedVersion
=
hostPkgs
.
lib
.
importJSON
./pin.json
;
in
hostPkgs
.
fetchgit
{
inherit
(
pinnedVersion
)
url
rev
sha256
;
},
argopkgs-src
?
../argopkgs
,
#
let
#
hostPkgs = import <nixpkgs> {};
#
pinnedVersion = hostPkgs.lib.importJSON ./pin.json;
#
in
#
hostPkgs.fetchgit {
#
inherit (pinnedVersion) url rev sha256;
#
},
pkgs
?
import
argopkgs-src
{},
nrm-src
?
pkgs
.
nodelevel
.
nrm
.
src
,
containers-src
?
pkgs
.
nodelevel
.
containers
.
src
,
...
...
@@ -44,11 +44,10 @@ let
in
rec
{
nrm
=
pkgs
.
nodelevel
.
nrm
.
overrideAttrs
(
old
:
{
src
=
nrm-src
;
});
nrm
=
(
pkgs
.
nodelevel
.
nrm
.
overrideAttrs
(
old
:
{
src
=
nrm-src
;
})
)
.
override
{}
;
libnrm
=
pkgs
.
nodelevel
.
libnrm
.
overrideAttrs
(
old
:
{
src
=
libnrm-src
;
});
containers
=
pkgs
.
nodelevel
.
containers
.
overrideAttrs
(
old
:
{
src
=
containers-src
;
});
amg
=
pkgs
.
applications
.
nrm
.
amg
;
amg
=
pkgs
.
applications
.
nrm
.
amg
.
override
{
libnrm
=
libnrm
;};
inherit
(
hpkgs
)
argo
argotk
;
...
...
@@ -96,6 +95,7 @@ in rec
pkgs
.
utillinux
containers
amg
pkgs
.
mpich2
nrm
];
inherit
shellHook
;
...
...
package.nix
0 → 100644
View file @
0bc48edd
let
ghcOpts
=
[
"-Wall"
"-Wincomplete-uni-patterns"
"-Wincomplete-record-updates"
"-Wmissing-home-modules"
"-Widentities"
"-Wredundant-constraints"
"-Wcpp-undef"
#"-fwarn-missing-export-li"
"-fwarn-tabs"
"-fwarn-unused-imports"
"-fwarn-missing-signatures"
"-fwarn-name-shadowing"