Merge branch 'refactor-argotk-cherrypicked' into 'master'

Heavily reafoctored the test repository for the test workflow

See merge request argo/argotest!11

.Makefile

-#This makefile only contains development workflow rules.
-.PHONY: all
-all: generate-completions README.md
-
-.PHONY: generate-completions
-generate-completions: completions/zsh/_argotk.hs completions/bash/argotk.sh
-
-completions/zsh/_argotk.hs: argotk.hs default.nix
-	bash -c './argotk.hs --zsh-completion-script ./argotk.hs > completions/zsh/_argotk.hs'
-
-completions/bash/argotk.sh: argotk.hs default.nix
-	bash -c './argotk.hs --bash-completion-script ./argotk.hs > completions/bash/argotk.sh'
-
-README.md: .README.md argotk.hs default.nix
-	pandoc --filter `which panpipe` .README.md -o README.md
-
-README.html: README.md
-	pandoc README.md -o README.html
-
-.PHONY:clean
-clean:
-	rm README.html

.README.md

@@ -34,12 +34,45 @@ integration.test:
     - integration
 ```
 
-Standalone usage: example with the nrm source in `../`.
+Standalone usage: example with the nrm source in `../`, provision the dependencies using:
+
 ```{.bash}
 nix-shell -A test --arg nrm-src ../nrm
-nix-shell $ ./argotk.hs --help
+```
+
+Then use the tool:
+
+```{.bash}
+./argotk.hs --help
 ```
 Output:
 ```{.txt pipe="sh"}
 root/argotk.hs --help
 ```
+
+```{.bash}
+./argotk.hs helloworld --help
+```
+```{.txt pipe="sh"}
+root/argotk.hs helloworld --help
+```
+
+```{.bash}
+./argotk.hs application --help
+```
+```{.txt pipe="sh"}
+root/argotk.hs application --help
+```
+
+```{.bash}
+./argotk.hs daemon --help
+```
+```{.txt pipe="sh"}
+root/argotk.hs daemon --help
+```
+
+##### 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).

.gitignore

 .argo_nodeos_config_exit_message
+result
+.shake
 *.log

.gitlab-ci.yml

@@ -4,17 +4,19 @@ stages:
 integration.test:
   stage: test
   script:
-    - nix-shell -A test --run "./argotk.hs helloworld"
+    - nix-shell -A test --run "argotk.hs helloworld"
   except:
     - /^wip\/.*/
     - /^WIP\/.*/
   artifacts:
-    when: on_failure
+    when: always
     paths:
-      - cmd_out.log
-      - cmd_err.log
-      - daemon_out.log
-      - daemon_err.log
-      - time.log
+      - _output/cmd_out.log
+      - _output/cmd_err.log
+      - _output/daemon_out.log
+      - _output/daemon_err.log
+      - _output/nrm_log.log
+      - _output/time.log
+      - _output/.argo_nodeos_config_exit_message
   tags:
     - integration

README.md

@@ -20,12 +20,12 @@ integration.test:
     - nix-shell -A test --run "./argotk.hs helloworld" --arg nrm-src ../.
   artifacts:
     paths:
-      - argotest/cmd_err.log
-      - argotest/cmd_out.log
-      - argotest/daemon_out.log
-      - argotest/daemon_out.log
-      - argotest/nrm.log
-      - argotest/time.log
+      - 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\/.*/
@@ -34,11 +34,17 @@ integration.test:
     - integration
 ```
 
-Standalone usage: example with the nrm source in `../`.
+Standalone usage: example with the nrm source in `../`, provision the
+dependencies using:
 
 ``` {.bash}
 nix-shell -A test --arg nrm-src ../nrm
-nix-shell $ ./argotk.hs --help
+```
+
+Then use the tool:
+
+``` {.bash}
+./argotk.hs --help
 ```
 
 Output:
@@ -56,6 +62,38 @@ Available commands:
                            with properly cleaned sockets, logfiles.
   application              Setup stack and run an arbitrary command in a
                            container.
-  helloworld               Setup stack and check that hello world app sends
-                           message back to cmd.
+  helloworld               Test 1: Setup stack and check that hello world app
+                           sends message back to cmd.
+```
+
+``` {.bash}
+./argotk.hs helloworld --help
+```
+
+``` {.txt}
+Usage: argotk.hs helloworld 
+  Test 1: Setup stack and check that hello world app sends message back to cmd.
+
+Available options:
+  -h,--help                Show this help text
 ```
+
+``` {.bash}
+./argotk.hs application --help
+```
+
+``` {.txt}
+Usage: argotk.hs application COMMAND
+  Setup stack and run an arbitrary command in a container.
+
+Available options:
+  COMMAND                  Application to run inside the container
+  -h,--help                Show this help text
+```
+
+##### 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).

argotest/ChangeLog.md → argo/ChangeLog.md

-# Revision history for argotest
+# Revision history for argo
 
 ## 0.1.0.0 -- YYYY-mm-dd
 

argotest/argotest.cabal → argo/argo.cabal

--- Initial argotest.cabal generated by cabal init.  For further
--- documentation, see http://haskell.org/cabal/users-guide/
-
-name:                argotest
+name:                argo
 version:             0.1.0.0
--- synopsis:
--- description:
 license:             MIT
 license-file:        LICENSE
 author:              Valentin Reis
 maintainer:          fre@freux.fr
--- copyright:
--- category:
 build-type:          Simple
 extra-source-files:  ChangeLog.md
 cabal-version:       >=1.10
 
 library
-  exposed-modules: Argotest
-  -- other-modules:
-  -- other-extensions:
+  exposed-Modules:     Argo.Stack
+                       Argo.Utils
   build-depends:       base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text
   hs-source-dirs:      src
   default-language:    Haskell2010

argo/src/Argo.hs

+module Argo
+  ( module Argo.Stack
+  , module Argo.Utils
+  )
+where
+
+import           Argo.Stack
+import           Argo.Utils

argo/src/Argo/Stack.hs

+{-# LANGUAGE ScopedTypeVariables, LambdaCase , RecordWildCards , OverloadedStrings ,
+  DataKinds , FlexibleInstances , TypeOperators #-}
+
+module Argo.Stack where
+
+import           Data.Default
+import           Turtle
+import           Prelude                 hiding ( FilePath )
+
+import           System.IO                      ( withFile )
+import           Debug.Trace
+import           Filesystem.Path                ( (</>) )
+import           Control.Concurrent.Async
+import           System.Console.ANSI 
+import           System.Console.ANSI.Types      ( Color )
+import           Data.Text                     as Text
+                                         hiding ( empty )
+import           Data.Text.IO                  as Text
+import           Argo.Utils
+import System.Process as P hiding (shell)
+
+data StackArgs = StackArgs
+  { dargs                :: [Text]      --"Daemon arguments. Properly quote this."
+  , app                  :: Text        --"Target application call, sh+path valid"
+  , workingDirectory     :: FilePath    --"Working directory."
+  , manifest             :: FilePath    --"Input file, manifest."
+  , cmd_out              :: FilePath    --"Output file, application stdout"
+  , cmd_err              :: FilePath    --"Output file, application stderr"
+  , daemon_out           :: FilePath    --"Output file, daemon stdout"
+  , daemon_err           :: FilePath    --"Output file, daemon stderr"
+  , nrm_log              :: FilePath    --"Output file, daemon log"
+  , time_file            :: FilePath  } --"Output file, application runtime"
+
+instance Default StackArgs where
+  def = StackArgs
+    { dargs = []
+    , app = "echo \"HelloWorld\""
+    , workingDirectory = "./."
+    , manifest = "basic.json"
+    , cmd_out = "cmd_out.log"
+    , cmd_err = "cmd_err.log"
+    , daemon_out = "daemon_out.log"
+    , daemon_err = "daemon_err.log"
+    , nrm_log = "nrm.log"
+    , time_file = "time.log"
+    }
+
+-- | override the output directory of the stack.
+outputDir :: FilePath -> StackArgs -> StackArgs
+outputDir dir sa = sa { workingDirectory = dir }
+
+cleanLeftovers
+  :: FilePath
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> Shell ()
+cleanLeftovers wd daemon_out daemon_err cmd_out cmd_err time_file nrm_log = do
+  printInfo "Cleaning leftovers..\n"
+  mapM_
+    cleanLog
+    [ wd </> daemon_out
+    , wd </> daemon_err
+    , wd </> cmd_out
+    , wd </> cmd_err
+    , wd </> time_file
+    , wd </> nrm_log
+    , wd </> ".argo_nodeos_config_exit_message"
+    ]
+  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
+
+prepareDaemonShell
+  :: FilePath -> [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ())
+prepareDaemonShell wd dargs daemon_out daemon_err nrm_log = do
+  mktree wd
+  cd wd
+  confPath <- myWhich "argo_nodeos_config"
+  myWhich "daemon"
+  tempDirPath <- mktempdir "/tmp" "argo-expe"
+  let confPath' = tempDirPath </> "argo_nodeos_config"
+  cp confPath confPath'
+  printInfo $ format ("Copied the configurator to " % fp % "\n") confPath'
+  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
+  shell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
+    ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root.\n"
+    ExitFailure n ->
+      die ("Failed to set argo_nodeos_config permissions " <> repr n)
+  shell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
+    ExitSuccess   -> printInfo "Set the suid bit.\n"
+    ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
+
+  --Cleaning the config, running the daemon
+  shell (format (fp % " --clean_config=kill_content:true") confPath') empty
+    >>= \case
+          ExitSuccess   -> printInfo "Cleaned the argo config.\n"
+          ExitFailure 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 ("Clean config failed with exit code " <> repr n)
+  printInfo $ format
+    ( "Running the daemon, main log at "
+    % fp
+    % ", stdout at "
+    % fp
+    % ", stderr at "
+    % fp
+    % "\n"
+    )
+    nrm_log
+    daemon_out
+    daemon_err
+  export "ARGO_NODEOS_CONFIG" (format fp confPath')
+  return $ twoWayPrint daemon_out daemon_err $ inprocWithErr
+    "daemon"
+    (dargs ++ ["--nrm_log", Text.pack $ encodeString nrm_log])
+    empty
+
+-- | See at the bottom of this file for discussion of this function. (1)
+cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()
+cmdShell manifest app cmd_out cmd_err = do
+  shell
+      (format ("cmd run -u toto " % fp % "  " % s % " > " % fp % " 2>" % fp)
+              manifest
+              app
+              cmd_out
+              cmd_err
+      )
+      empty
+    >>= \case
+          ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
+          ExitFailure n -> die
+            (  "cmd failed with exit code "
+            <> repr n
+            <> " . The application logs are at "
+            <> repr cmd_out
+            <> " "
+            <> repr cmd_err
+            )
+
+twoWayPrint :: FilePath -> FilePath -> Shell (Either Line Line) -> IO ()
+twoWayPrint outPath errPath s = sh $ do
+  handleOut <- using (writeonly outPath)
+  handleErr <- using (writeonly errPath)
+  s >>= \case
+    Left  out -> liftIO $ Text.hPutStrLn handleOut (lineToText out)
+    Right err -> liftIO $ Text.hPutStrLn handleErr (lineToText err)
+
+runSimpleStack :: StackArgs -> IO ()
+runSimpleStack a@StackArgs {..} = sh $ do
+  cleanLeftovers workingDirectory
+                 daemon_out
+                 daemon_err
+                 cmd_out
+                 cmd_err
+                 time_file
+                 nrm_log
+  daemonShell <- prepareDaemonShell workingDirectory
+                                    dargs
+                                    daemon_out
+                                    daemon_err
+                                    nrm_log
+  liftIO $ withAsync daemonShell $ \daemon -> do
+    kbInstallHandler $ cancel daemon
+    withAsync (time $ sh $ cmdShell manifest app cmd_out cmd_err) $ \cmd -> do
+      kbInstallHandler $ cancel daemon >> cancel cmd
+      waitEitherCancel daemon cmd >>= \case
+        Left  _      -> die "Daemon died."
+        Right (_, t) -> writeTextFile time_file (repr t)
+
+-- | (1)
+--
+-- | This version fucks up the environment variables. issue at
+-- https://github.com/Gabriel439/Haskell-Turtle-Library/issues/338
+{-cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()-}
+{-cmdShell manifest app cmd_out cmd_err = do-}
+  {-manifestArg <- case toText manifest of-}
+    {-Left m -> printWarning (format ("Manifest path malformed: " % fp) manifest)-}
+      {->> return m-}
+    {-Right m -> return m-}
+  {-printInfo $ format-}
+    {-("Running cmd. Stdout at " % fp % ", stderr at " % fp % "\n")-}
+    {-cmd_out-}
+    {-cmd_err-}
+  {-liftIO $ twoWayPrint cmd_out cmd_err $ inprocWithErr-}
+    {-"cmd"-}
+    {-["run", "-u", "toto", manifestArg, app]-}
+    {-empty-}
+
+-- | Even this one fucks up, streamWithErr really cleans this `env` attribute.
+
+  {-manifestArg <- case toText manifest of-}
+    {-Left m -> printWarning (format ("Manifest path malformed: " % fp) manifest)-}
+      {->> return m-}
+    {-Right m -> return m-}
+  {-printInfo $ format-}
+    {-("Running cmd. Stdout at " % fp % ", stderr at " % fp % "\n")-}
+    {-cmd_out-}
+    {-cmd_err-}
+  {-theEnv' <- liftIO $ Turtle.env-}
+  {-let theEnv = Prelude.map (\(x,y)-> (Text.unpack x,Text.unpack y)) theEnv'-}
+  {-void $ liftIO $  twoWayPrint cmd_out cmd_err $ streamWithErr ((P.proc (unpack "cmd") (Prelude.map unpack ["run", "-u", "toto", manifestArg, app])) {P.env=Just theEnv}) empty-}

argo/src/Argo/Utils.hs

+{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
+  FlexibleInstances, TypeOperators #-}
+
+module Argo.Utils where
+
+import           Turtle
+import           Prelude                 hiding ( FilePath )
+import           System.Console.ANSI
+import           System.Console.ANSI.Types      ( Color )
+import           System.Posix.Signals
+import           System.Process          hiding ( shell )
+
+-- | Miscellaneous printing utilities
+colorShell :: Color -> Shell () -> Shell ()
+colorShell color s = setC color *> s *> setC White
+  where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
+
+printInfo :: Text -> Shell ()
+printError :: Text -> Shell ()
+printWarning :: Text -> Shell ()
+printInfo = printf ("Info:" % s)
+printWarning = colorShell Yellow . printf ("Warning:" % s)
+printError = colorShell Red . printf ("Error:" % s)
+
+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
+
+sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
+sudoRemoveFile printer desc filePath = do
+  foundSocket <- testfile filePath
+  when foundSocket $ go False
+  printInfo $ format ("OK: " % s % " " % fp % "\n") desc filePath
+ where
+  go useSudo = do
+    printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath
+    shell
+        (format ((if useSudo then "sudo " else "") % "rm -f " % fp) filePath)
+        empty
+      >>= \case
+            ExitSuccess -> colorShell Green $ printf " Successfully removed.\n"
+            ExitFailure n -> if useSudo
+              then printer $ format
+                ("Failed to remove stale " % s % ", even with sudo.")
+                desc
+              else do
+                printer $ format
+                  ("Failed to remove stale " % s % ". Trying sudo..\n")
+                  desc
+                go True
+
+cleanSocket = sudoRemoveFile printError "socket"
+cleanLog = sudoRemoveFile printWarning "log file"
+
+kbInstallHandler :: IO () -> IO Handler
+kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
+

argotest/src/Argotest.hs

-{-# LANGUAGE
-   LambdaCase
- , OverloadedStrings
- , DataKinds
- , FlexibleInstances
- , TypeOperators #-}
-
-module Argotest where
-
-import Data.Default
-import Turtle
-import Prelude hiding (FilePath)
-
-import System.IO (withFile)
-import Debug.Trace
-import Filesystem.Path ((</>))
-import Control.Concurrent.Async
-import System.Console.ANSI
-import System.Console.ANSI.Types (Color)
-import System.Posix.Signals
-import System.Process hiding (shell)
-import Data.Text as Text hiding (empty)
-import Data.Text.IO as Text
-
-data StackArgs = StackArgs
-  { dargs                :: [Text]      --"Daemon arguments. Properly quote this."
-  , app                  :: Text        --"Target application call, sh+path valid"
-  , manifest             :: FilePath    --"Input file, manifest."
-  , cmd_out              :: FilePath    --"Output file, application stdout"
-  , cmd_err              :: FilePath    --"Output file, application stderr"
-  , daemon_out           :: FilePath    --"Output file, daemon stdout"
-  , daemon_err           :: FilePath    --"Output file, daemon stderr"
-  , nrm_log              :: FilePath    --"Output file, daemon log"
-  , time_file            :: FilePath  } --"Output file, application runtime"
-
-instance Default StackArgs where
-  def = StackArgs
-    { dargs = []
-    , app = "echo \"HelloWorld\""
-    , manifest = "basic.json"
-    , cmd_out = "cmd_out.log"
-    , cmd_err = "cmd_err.log"
-    , daemon_out = "daemon_out.log"
-    , daemon_err = "daemon_err.log"
-    , nrm_log = "nrm.log"
-    , time_file = "time.log"
-    }
-
-colorShell :: Color -> Shell ()-> Shell ()
-colorShell color s = setC color *> s *> setC White
-  where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
-
-printInfo    :: Text -> Shell ()
-printError   :: Text -> Shell ()
-printWarning :: Text -> Shell ()
-printInfo    = printf ("Info:"%s)
-printWarning = colorShell Yellow . printf ("Warning:"%s)
-printError   = colorShell Red . printf ("Error:"%s)
-
-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
-
-sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
-sudoRemoveFile printer desc filePath = do
-  foundSocket <- testfile filePath
-  when foundSocket $ go False
-  printInfo $ format ("OK: "%s%" "%fp%"\n") desc filePath
-  where go useSudo = do
-          printer $ format ("found stale " %s%" at "%fp%".. ") desc filePath
-          shell (format ((if useSudo then "sudo " else "")%"rm -f "%fp) filePath) empty >>= \case
-            ExitSuccess   -> colorShell Green $ printf " Successfully removed.\n"
-            ExitFailure n -> if useSudo
-                             then printer $ format ("Failed to remove stale "%s%", even with sudo.") desc
-                             else do
-                                printer $ format ("Failed to remove stale "%s%". Trying sudo..\n") desc
-                                go True
-
-cleanSocket = sudoRemoveFile printError "socket"
-cleanLog    = sudoRemoveFile printWarning "log file"
-
-cleanLeftovers :: FilePath -> FilePath -> FilePath ->
-  FilePath -> FilePath -> FilePath -> Shell ()
-cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log = do
-  printInfo "Cleaning leftovers..\n"
-  mapM_ cleanLog [daemon_out, daemon_err, cmd_out, cmd_err, time_file, nrm_log, ".argo_nodeos_config_exit_message"]
-  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
-
-prepareDaemonShell :: [Text] -> FilePath -> FilePath -> FilePath -> Shell (IO ())
-prepareDaemonShell dargs daemon_out daemon_err nrm_log = do
-  confPath      <- myWhich "argo_nodeos_config"
-  myWhich "daemon"
-  tempDirPath   <- mktempdir "/tmp" "argo-expe"
-  let confPath' = tempDirPath </> "argo_nodeos_config"
-  cp confPath confPath'
-  printInfo $ format ("Copied the configurator to "%fp%"\n") confPath'
-  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
-  shell (format ("sudo chown root:root "%fp) confPath') empty >>= \case
-    ExitSuccess   -> printInfo "Chowned argo_nodeos_config to root:root.\n"
-    ExitFailure n -> die ("Failed to set argo_nodeos_config permissions " <> repr n)
-  shell (format ("sudo chmod u+sw "%fp) confPath') empty >>= \case
-    ExitSuccess   -> printInfo "Set the suid bit.\n"
-    ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
-
-  --Cleaning the config, running the daemon
-  shell (format (fp%" --clean_config=kill_content:true") confPath') empty >>= \case
-    ExitSuccess   -> printInfo "Cleaned the argo config.\n"
-    ExitFailure 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 ("Clean config failed with exit code " <> repr n)
-  printInfo $ format ("Running the daemon, main log at "%fp%", stdout at "%fp%", stderr at "%fp%"\n") nrm_log daemon_out daemon_err
-  export "ARGO_NODEOS_CONFIG" (format fp confPath')
-  return $ twoWayPrint daemon_out daemon_err $ inprocWithErr "daemon"
-          (dargs ++ ["--nrm_log", Text.pack $ encodeString nrm_log])
-          empty
-
-twoWayPrint :: FilePath -> FilePath -> Shell (Either Line Line) -> IO ()
-twoWayPrint outPath errPath s = sh $ do
-    handleOut <- using (writeonly outPath)
-    handleErr <- using (writeonly errPath)
-    s >>= \case
-      Left out  -> liftIO $ Text.hPutStrLn handleOut (lineToText out)
-      Right err  -> liftIO $ Text.hPutStrLn handleOut (lineToText err)
-
-cmdShell :: FilePath -> Text -> FilePath -> FilePath -> Shell ()
-cmdShell manifest app cmd_out cmd_err =
-  shell (format ("cmd run -u toto "%fp%"  "%s%" > "%fp%" 2>"%fp) manifest app cmd_out cmd_err) empty >>= \case
-  ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
-  ExitFailure n -> die ("cmd failed with exit code " <> repr n <>
-    " . The application logs are at " <> repr cmd_out <> " " <> repr cmd_err )

argotk.hs

-#! /usr/bin/env runhaskell
-
-{-# LANGUAGE
-    OverloadedStrings
-  , LambdaCase
-  , RecordWildCards #-}
-
-import Argotest
-import Turtle
-import Data.Default
-import Control.Concurrent.Async
-import System.Environment
-import System.Console.ANSI
-import System.Console.ANSI.Types (Color)
-import Options.Applicative
-import System.Posix.Signals
-import Control.Monad
-import System.Environment.FindBin
-
-opts :: StackArgs -> Parser (IO ())
-opts sa = subparser
-  ( command "clean" (info (pure $ runClean sa)
-     (progDesc "Clean sockets, logfiles."))
- <> command "daemon"  (info (pure $ runDaemon sa)
-     (progDesc "Set up and launch the daemon in synchronous mode, \
-               \with properly cleaned sockets, logfiles."))
- <> command "application"  (info (runApp sa <$> argument str idm)
-     (progDesc "Setup stack and run an arbitrary command in a container."))
- <> command "helloworld"  (info (pure $ runHelloWorld sa )
-     (progDesc "Setup stack and check that hello world app sends \
-               \message back to cmd."))
- <> help "Type of action to run"
- )
-
-main :: IO ()
-main = do
-  manifests <- getEnv "MANIFESTS"
-  let sa = def { manifest = decodeString manifests </> manifest def}
-  join $ execParser (info (opts sa <**>helper) idm)
-
-runApp :: StackArgs -> Text -> IO ()
-runApp sa app = runSimpleStack $ sa {app = app}
-
-runHelloWorld :: StackArgs -> IO ()
-runHelloWorld a@StackArgs{..} = do
-  let passText = "HelloWorldFromApp"
-  let passPattern = text passText
-  runSimpleStack $ a {app = format ("echo "%s) passText}
-  readTextFile cmd_err >>= \x -> case match (has passPattern) x of
-    [] -> die ("Hello world app failed to run.")
-    _  -> sh $ printInfo "The hello world app executed properly in a \
-                         \container and its message was received by `cmd`.\n"
-
-runSimpleStack :: StackArgs -> IO ()
-runSimpleStack a@StackArgs{..} = sh $ do
-  cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log
-  daemonShell <- prepareDaemonShell dargs daemon_out daemon_err nrm_log
-  liftIO $ do
-    withAsync daemonShell $ \daemon -> do
-    let handler = do
-                  sh $ printInfo "Interrupted. Killing daemon..."
-                  cancel daemon
-                  sh $ colorShell Green $ printf "Killed daemon.\n"
-    liftIO $ installHandler keyboardSignal (Catch handler) Nothing
-    withAsync (time $ sh $ cmdShell manifest app cmd_out cmd_err ) $ \cmd -> do
-    let handler = do
-                  sh $ printInfo "Interrupted. Killing daemon..."
-                  cancel daemon
-                  sh $ colorShell Green $ printf "Killed daemon.\n"
-                  sh $ printInfo "Interrupted. Killing cmd..."
-                  cancel cmd
-                  sh $ colorShell Green $ printf "Killed cmd.\n"
-    liftIO $ installHandler keyboardSignal (Catch handler) Nothing
-    (waitEitherCancel daemon cmd >>= \case
-      Left _ -> die "Daemon died"
-      Right (_,t) -> writeTextFile time_file (repr t))
-
-runClean :: StackArgs -> IO ()
-runClean StackArgs{..} = sh $
-  cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log
-
-runDaemon :: StackArgs -> IO ()
-runDaemon StackArgs{..} = sh $ prepareDaemonShell dargs daemon_out daemon_err nrm_log >>= liftIO

argotk/argotk.cabal

+name:                argotk
+version:             0.1.0.0
+-- synopsis: