Basic test version.

test.hs → Argotest.hs

-#! /usr/bin/env nix-shell
-#! nix-shell default.nix -i runhaskell -A test1
-
-{-# LANGUAGE RecordWildCards
+{-# LANGUAGE
+    RecordWildCards
   , LambdaCase
   , OverloadedStrings
   , DataKinds
@@ -10,11 +8,12 @@
   , OverloadedStrings
   , TypeOperators #-}
 
+module Argotest where
+
+import Data.Default
 import Turtle
 import Prelude hiding (FilePath)
 
-import Options.Applicative
-import Options.Generic
 import System.IO (withFile)
 import Debug.Trace
 import Filesystem.Path ((</>))
@@ -23,59 +22,91 @@ import System.Console.ANSI
 import System.Console.ANSI.Types (Color)
 import System.Posix.Signals
 
-printInfo    format = printf ("Info:"%format)
-printWarning format = colorShell Yellow . printf ("Warning:"%format)
-printError   format = colorShell Red    . printf ("Error:"%format)
+
+--data Args w = Args
+--  { dargs                :: w ::: Text     <?> "Daemon arguments. Properly quote this."
+--  , app                  :: w ::: FilePath <?> "Input file, target application script"
+--  , manifest             :: w ::: FilePath <?> "Input file, manifest."
+--  , app_out              :: w ::: FilePath <?> "Output file, application stdout"
+--  , app_err              :: w ::: FilePath <?> "Output file, application stderr"
+--  , daemon_out           :: w ::: FilePath <?> "Output file, daemon stdout"
+--  , daemon_err           :: w ::: FilePath <?> "Output file, daemon stderr"
+--  , log_progress         :: w ::: FilePath <?> "Output file, daemon progress log"
+--  , log_hardwareprogress :: w ::: FilePath <?> "Output file, daemon hardware progress log"
+--  , log_power            :: w ::: FilePath <?> "Output file, daemon power log"
+--  , time_file            :: w ::: FilePath <?> "Output file, application runtime" } deriving (Generic)
+--instance ParseRecord (Args Wrapped)
+
+
+data StackArgs = StackArgs
+  { dargs                :: Text
+  , app                  :: FilePath
+  , manifest             :: FilePath
+  , cmd_out              :: FilePath
+  , cmd_err              :: FilePath
+  , daemon_out           :: FilePath
+  , daemon_err           :: FilePath
+  , log_progress         :: FilePath
+  , log_hardwareprogress :: FilePath
+  , log_power            :: FilePath
+  , time_file            :: FilePath  }
+
+instance Default StackArgs where
+  def = StackArgs
+    { dargs = ""
+    , app = "echo Dummy app: Hello world!"
+    , manifest = "manifests/basic.json"
+    , cmd_out = "/tmp/cmd_out.log"
+    , cmd_err = "/tmp/cmd_err.log"
+    , daemon_out = "/tmp/daemon_out.log"
+    , daemon_err = "/tmp/daemon_err.log"
+    , log_progress = "/tmp/progress.log"
+    , log_hardwareprogress = "/tmp/hardwareprogress.log"
+    , log_power = "/tmp/power.log"
+    , time_file = "/tmp/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    str = printf ("Info:"%s) str
+printWarning str = colorShell Yellow $ printf ("Warning:"%s) str
+printError   str = colorShell Red $ printf ("Error:"%s) str
+
 myWhich str = which str >>= \case
-  (Just p) -> printInfo ("Found "%fp%" at "%fp%"\n") str p >> return p
-  Nothing -> die (format ("Argo `"%fp%"` not in $PATH.") str)
-
-data Args w = Args
-  { dargs                :: w ::: Text     <?> "Daemon arguments. Properly quote this."
-  , app                  :: w ::: FilePath <?> "Input file, target application script"
-  , manifest             :: w ::: FilePath <?> "Input file, manifest."
-  , app_out              :: w ::: FilePath <?> "Output file, application stdout"
-  , app_err              :: w ::: FilePath <?> "Output file, application stderr"
-  , daemon_out           :: w ::: FilePath <?> "Output file, daemon stdout"
-  , daemon_err           :: w ::: FilePath <?> "Output file, daemon stderr"
-  , log_progress         :: w ::: FilePath <?> "Output file, daemon progress log"
-  , log_hardwareprogress :: w ::: FilePath <?> "Output file, daemon hardware progress log"
-  , log_power            :: w ::: FilePath <?> "Output file, daemon power log"
-  , time_file            :: w ::: FilePath <?> "Output file, application runtime" } deriving (Generic)
-instance ParseRecord (Args Wrapped)
-
-removeSocket :: FilePath -> Shell ()
-removeSocket socketPath = do
-  foundSocket <- (testfile socketPath)
-  when foundSocket $ do
-    printError ("found stale socket at "%fp%"..") socketPath
-    shell (format ("sudo rm -f "%fp) socketPath) empty >>= \case
-      ExitSuccess   -> colorShell Green $ printf (" Successfully removed.\n")
-      ExitFailure n -> colorShell Red $ die ("Failed to remove stale socket." <> repr n)
-
-cleanLog :: FilePath -> Shell ()
-cleanLog logPath = do
-  foundSocket <- (testfile logPath)
-  when foundSocket $ do
-    printWarning ("found stale log at "%fp%".. ") logPath
-    shell (format ("sudo rm -f "%fp) logPath) empty >>= \case
-      ExitSuccess   -> colorShell Green $  printf ("Successfully removed.\n")
-      ExitFailure n -> die ("Failed to remove stale log file." <> repr n)
-  printInfo ("Using log file "%fp%"\n") logPath
-
-main :: IO ()
-main = sh $ do
-  Args{..}      <- unwrapRecord "minimal Argo benchmarking tool"
+  (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 ("using "%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"
 
+argoTest :: StackArgs -> IO ()
+argoTest StackArgs{..} = sh $ do
   --Cleaning
-  mapM_ cleanLog [daemon_out, daemon_err, app_out, app_err, time_file,
+  mapM_ cleanLog [daemon_out, daemon_err, cmd_out, cmd_err, time_file,
                   log_progress, log_hardwareprogress, log_power]
-  mapM_ removeSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
+  mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
 
   --Retrieving binaries,setting suid bits and perms
   confPath      <- myWhich "argo_nodeos_config"
@@ -83,7 +114,8 @@ main = sh $ do
   tempDirPath   <- mktempdir "/tmp" "argo-expe"
   let confPath' = tempDirPath </> "argo_nodeos_config"
   cp confPath confPath'
-  printInfo ("Copied the configurator to "%fp%"\n") 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)
@@ -94,7 +126,7 @@ main = sh $ do
   --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 liftIO $ printInfo ("Contents of argo_nodeos_config_exit_message: \n")
+    ExitFailure n -> do printInfo "Contents of argo_nodeos_config_exit_message: \n"
                         view $ cat  ["./argo_nodeos_config_exit_message"]
                         die ("Clean config failed with exit code " <> repr n)
   printInfo "Running the daemon.\n"
@@ -106,21 +138,19 @@ main = sh $ do
   let handler = do
                 sh $ printInfo "Interrupted. Killing daemon..."
                 cancel daemonAsync
-                sh $ inshell "pkill daemon" empty
                 sh $ colorShell Green $ printf "Killed daemon.\n"
   liftIO $ installHandler keyboardSignal (Catch handler) Nothing
 
   --Running the app
   printInfo "Launching the application through cmd.\n"
   (_,t) <- time $
-    shell (format ("cmd run -u toto "%fp%"  "%fp%" > "%fp%" 2>"%fp) manifest app app_out app_err) empty >>= \case
+    shell (format ("cmd run -u toto "%fp%"  "%fp%" > "%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 app_out <> " " <> repr app_err )
+        " . The application logs are at " <> repr cmd_out <> " " <> repr cmd_err )
   liftIO $ writeTextFile time_file (repr t)
 
   --Cleanup
   printInfo "Killing the daemon.\n"
   liftIO $ cancel daemonAsync
-  inshell "pkill daemon" empty
   printInfo "Daemon killed.\n"

default.nix

@@ -10,31 +10,29 @@ let
   amg = argopkgs.applications.nrm.amg;
 
   hpkgs = (p: with p;[
-    turtle optparse-generic interpolatedstring-perl6 managed
+    turtle optparse-generic data-default interpolatedstring-perl6 managed
   ]);
 
-  hpkgsPrecommit = (p: with p;[
-    turtle optparse-generic interpolatedstring-perl6 managed
-    (argopkgs.haskell.lib.doJailbreak panpipe)
+  hpkgs-dev = (p: with p;[
+    turtle optparse-generic data-default interpolatedstring-perl6 managed
+    (argopkgs.haskell.lib.doJailbreak panpipe) ghcid
   ]);
-in
+in rec
 {
-  test1 = argopkgs.stdenv.mkDerivation {
+  env = argopkgs.stdenv.mkDerivation {
       src=./.;
       name="nrm-experimental-dev-environment";
       buildInputs = [
         containers
         amg
         nrm
-        (argopkgs.haskellPackages.ghcWithPackages hpkgs)
       ];
   };
-  pre-commit = argopkgs.stdenv.mkDerivation {
-    name="pre-commit";
-    src = ./.;
-    buildInputs = [
-      (argopkgs.haskellPackages.ghcWitPackages hpkgsPrecommit)
-    ];
-  };
+  test = env.overrideAttrs(old: {
+    buildInputs = old.buildInputs ++ [ (argopkgs.haskellPackages.ghcWithPackages hpkgs) ];
+  });
+  dev = env.overrideAttrs(old: {
+    buildInputs = old.buildInputs ++ [ (argopkgs.haskellPackages.ghcWithHoogle hpkgs-dev) ];
+  });
 }
 

tests.hs

+#! /usr/bin/env nix-shell
+#! nix-shell default.nix -i runhaskell -A test
+
+import Argotest
+import Data.Default
+
+main :: IO ()
+main = argoTest def