refactor(tests): refactor creations and execs

Use the utils I've created to ease the creation of containers and
execution of commands inside of them.

test/Test/Basic.purs

@@ -13,23 +13,19 @@ import Test.Partials (forceRight)
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual, shouldNotEqual, shouldSatisfy)
 import Test.Spec.Assertions.String (shouldStartWith)
-import Test.TestContainers (getFirstMappedPort, getHost, getId, getMappedPort, getName, mkContainer, setCommand, setUser, setWorkingDirectory, withContainer)
-import Test.TestContainers.Monad (configure, getContainer, setCommandM, setNameM, setPrivilegedModeM, setPullPolicyM)
+import Test.TestContainers (getFirstMappedPort, getHost, getId, getMappedPort, getName, setCommand, setName, setPrivilegedMode, setPullPolicy, setUser, setWorkingDirectory, withContainer)
 import Test.TestContainers.Types (PullPolicy(..))
 import Test.Utils (launchCommand, mkAffContainer)
 
 basicTest :: Spec Unit
 basicTest = do
   describe "Basic stuff" $ do
     it "should launch a basic container" $ do
-      let
-        cnt = mkContainer "alpine:latest" # configure $ do
-          setCommandM [ "sleep", "360" ]
-          setPullPolicyM AlwaysPull
-          setNameM "sleeper" -- do not do this in production
-          setPrivilegedModeM
-          ret <- getContainer
-          pure ret
+      cnt <- mkAffContainer "alpine:latest" $
+        setCommand [ "sleep", "360" ]
+          <<< setPullPolicy AlwaysPull
+          <<< setName "sleeper"
+          <<< setPrivilegedMode
 
       void $ withContainer cnt $ \c -> do
         containerIdE <- liftEffect $ getId c

test/Test/Binds.purs

@@ -2,101 +2,91 @@ module Test.Binds (bindTest) where
 
 import Prelude
 
-import Data.Either (Either(..), isRight)
-import Effect (Effect)
+import Data.Either (Either(..))
 import Effect.Aff (error, throwError)
 import Effect.Class (liftEffect)
 import Node.Process as Process
-import Partial.Unsafe (unsafePartial)
 import Test.Assertions (shouldInclude)
-import Test.Partials (forceRight)
 import Test.Spec (Spec, describe, it)
-import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
-import Test.TestContainers (exec, mkContainer, setBindMounts, setCommand, setCopyFilesToContainer, setTmpFs, withContainer)
-import Test.TestContainers.Monad (configure, getContainer, setCommandM, setPrivilegedModeM, setPullPolicyM)
-import Test.TestContainers.Types (CopyContentToContainer(..), FileMode(..), PullPolicy(..), TestContainer)
+import Test.Spec.Assertions (shouldEqual)
+import Test.TestContainers (setBindMounts, setCommand, setCopyFilesToContainer, setTmpFs, withContainer)
+import Test.TestContainers.Types (CopyContentToContainer(..), FileMode(..))
 import Test.Utils (launchCommand, mkAffContainer)
 
 bindTest :: Spec Unit
 bindTest = do
   describe "Binds and Volumes" $ do
     it "should bind single files" $ do
-      alpine <- liftEffect $ do
-        currentDir <- Process.cwd
-        mkAlpineContainer $
-          setBindMounts [ { readOnly: true, source: currentDir <> "/test/bound_file.txt", target: "/bound_file.txt" } ]
+      currentDir <- liftEffect Process.cwd
+      alpine <- mkAffContainer "alpine:latest" $
+        setCommand [ "sleep", "infinity" ]
+          <<< setBindMounts [ { readOnly: true, source: currentDir <> "/test/bound_file.txt", target: "/bound_file.txt" } ]
 
       res <- withContainer alpine $ \c -> do
-        res <- exec [ "cat", "/bound_file.txt" ] c
-        res `shouldSatisfy` isRight
-        let { exitCode, output } = unsafePartial $ forceRight res
-        exitCode `shouldEqual` 0
-        output `shouldEqual` "hello world from a bounded file\n\n"
+        launchCommand c [ "cat", "/bound_file.txt" ]
+          (\s -> s `shouldInclude` "hello world from a bounded file\n\n")
+          (\exitCode -> exitCode `shouldEqual` 0)
 
       case res of
         Left err -> throwError $ error err
         Right _ -> pure unit
 
     it "should bind folders" $ do
-      alpine <- liftEffect $ do
-        currentDir <- Process.cwd
-        mkAlpineContainer $
-          setBindMounts [ { readOnly: true, source: currentDir <> "/src/", target: "/sources" } ]
+      currentDir <- liftEffect Process.cwd
+      alpine <- mkAffContainer "alpine:latest" $
+        setCommand [ "sleep", "infinity" ]
+          <<< setBindMounts [ { readOnly: true, source: currentDir <> "/src/", target: "/sources" } ]
 
       res <- withContainer alpine $ \c -> do
-        res <- exec [ "ls", "/sources" ] c
-        res `shouldSatisfy` isRight
-        let { exitCode, output } = unsafePartial $ forceRight res
-        exitCode `shouldEqual` 0
-        output `shouldInclude` "Test\n"
+        launchCommand c [ "ls", "/sources" ]
+          (\s -> s `shouldInclude` "Test\n")
+          (\exitCode -> exitCode `shouldEqual` 0)
 
         -- Read only should be respected
-        res' <- exec [ "touch", "/sources/a" ] c
-        res' `shouldSatisfy` isRight
-        let { exitCode: exitCode' } = unsafePartial $ forceRight res'
-        exitCode' `shouldEqual` 1
+        launchCommand c [ "touch", "/sources/a" ]
+          (\_ -> pure unit)
+          (\exitCode -> exitCode `shouldEqual` 1)
 
       case res of
         Left err -> throwError $ error err
         Right _ -> pure unit
 
     it "should copy files and contents to containers" $ do
-      alpine <- liftEffect $ do
-        currentDir <- Process.cwd
-        mkAlpineContainer $
-          setCopyFilesToContainer
+      currentDir <- liftEffect Process.cwd
+      alpine <- mkAffContainer "alpine:latest" $
+        setCommand [ "sleep", "infinity" ]
+          <<< setCopyFilesToContainer
             [ (FromSource "test/bound_file.txt" "/bound_file.txt" $ FileMode "0644")
             , (FromContent "hello world from copied content" "/copied_content.txt" $ FileMode "0644")
             , (FromDirectory (currentDir <> "/test") "/test" $ FileMode "0644")
             ]
-      res <- withContainer alpine $ \c -> do
-        res <- exec [ "cat", "/bound_file.txt" ] c
-        res `shouldSatisfy` isRight
-        let { output } = unsafePartial $ forceRight res
-        output `shouldEqual` "hello world from a bounded file\n\n"
 
-        res' <- exec [ "cat", "/copied_content.txt" ] c
-        res' `shouldSatisfy` isRight
-        let { output: output' } = unsafePartial $ forceRight res'
-        output' `shouldEqual` "hello world from copied content"
+      res <- withContainer alpine $ \c -> do
+        launchCommand c [ "cat", "/bound_file.txt" ]
+          (\s -> s `shouldEqual` "hello world from a bounded file\n\n")
+          (\exitCode -> exitCode `shouldEqual` 0)
 
-        res'' <- exec [ "ls", "/test" ] c
-        res'' `shouldSatisfy` isRight
-        let { output: output'' } = unsafePartial $ forceRight res''
+        launchCommand c [ "cat", "/copied_content.txt" ] 
+          (\s -> s `shouldEqual` "hello world from copied content")
+          (\exitCode -> exitCode `shouldEqual` 0)
 
-        output'' `shouldInclude` "bound_file.txt"
+        launchCommand c [ "ls", "/test" ]
+          (\s -> s `shouldInclude` "bound_file.txt")
+          (\exitCode -> exitCode `shouldEqual` 0)
 
       case res of
         Left err -> throwError $ error err
         Right _ -> pure unit
 
     it "should bind tmpfs volumes" $ do
       alpine <- mkAffContainer "alpine:latest" $
-        setCommand [ "sleep", "30" ]
+        setCommand [ "sleep", "infinity" ]
           <<< setTmpFs { path: "/tmpfsmount", mountOptions: "rw,noexec,nosuid,size=655536k" }
 
       res <- withContainer alpine $ \c -> do
-        launchCommand c [ "touch", "/tmpfsmount/a" ] (\_ -> pure unit) (\code -> code `shouldEqual` 0)
+        launchCommand c [ "touch", "/tmpfsmount/a" ] 
+          (\_ -> pure unit) 
+          (\exitCode -> exitCode `shouldEqual` 0)
         launchCommand c [ "mount" ]
           (\s -> s `shouldInclude` "/tmpfsmount")
           (\_ -> pure unit)
@@ -105,16 +95,3 @@ bindTest = do
         Left e -> throwError $ error e
         Right _ -> pure unit
 
-  where
-  -- TODO: this can be probably done in a better way
-  mkAlpineContainer :: (TestContainer -> TestContainer) -> Effect TestContainer
-  mkAlpineContainer action = do
-    let
-      cnt = mkContainer "alpine:latest" # configure $ do
-        setCommandM [ "sleep", "360" ]
-        setPullPolicyM AlwaysPull
-        setPrivilegedModeM
-        ret <- getContainer
-        pure ret
-
-    pure $ action cnt

test/Test/Entrypoint.purs

@@ -2,16 +2,14 @@ module Test.Entrypoint where
 
 import Prelude
 
-import Data.Either (Either(..), isRight)
+import Data.Either (Either(..))
 import Effect.Aff (error, throwError)
-import Partial.Unsafe (unsafePartial)
 import Test.Assertions (shouldInclude)
-import Test.Partials (forceRight)
 import Test.Spec (Spec, describe, it)
-import Test.Spec.Assertions (shouldSatisfy)
-import Test.TestContainers (exec, setCommand, setCopyFilesToContainer, setEntrypoint, withContainer)
+import Test.Spec.Assertions (shouldEqual)
+import Test.TestContainers (setCommand, setCopyFilesToContainer, setEntrypoint, withContainer)
 import Test.TestContainers.Types (CopyContentToContainer(..), FileMode(..))
-import Test.Utils (mkAffContainer)
+import Test.Utils (launchCommand, mkAffContainer)
 
 entrypointTest :: Spec Unit
 entrypointTest = describe "Test Entrypoint" $ do
@@ -22,11 +20,9 @@ entrypointTest = describe "Test Entrypoint" $ do
         <<< setCopyFilesToContainer [ FromSource "./test/docker-entrypoint.sh" "/docker-entrypoint.sh" (FileMode "0755") ]
 
     res <- withContainer sleeper $ \c -> do
-      execResult <- exec [ "ps" ] c
-      execResult `shouldSatisfy` isRight
-      let { output } = unsafePartial $ forceRight execResult
-
-      output `shouldInclude` "sleep 30"
+      launchCommand c [ "ps" ]
+        (\s -> s `shouldInclude` "sleep 30")
+        (\exitCode -> exitCode `shouldEqual` 0)
 
     case res of
       Left e -> throwError $ error e

test/Test/EnvironmentVariables.purs

@@ -2,28 +2,28 @@ module Test.EnvironmentVariables where
 
 import Prelude
 
-import Data.Either (Either(..), isRight)
+import Data.Either (Either(..))
 import Effect.Aff (error, throwError)
-import Partial.Unsafe (unsafePartial)
 import Test.Assertions (shouldInclude)
-import Test.Partials (forceRight)
 import Test.Spec (Spec, describe, it)
-import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
-import Test.TestContainers (exec, setCommand, setEnvironment, withContainer)
-import Test.Utils (mkAffContainer)
+import Test.Spec.Assertions (shouldEqual)
+import Test.TestContainers (setCommand, setEnvironment, withContainer)
+import Test.Utils (launchCommand, mkAffContainer)
 
 environmentTest :: Spec Unit
 environmentTest = describe "Environment Variables" $ do
   it "should set environment variables properly" $ do
-    sleeperContainer <- mkAffContainer "alpine:latest" $ setEnvironment env <<< setCommand [ "sleep", "360" ]
-    res <- withContainer sleeperContainer $ \c -> do
-      execResult <- exec [ "env" ] c
-      execResult `shouldSatisfy` isRight
+    sleeperContainer <- mkAffContainer "alpine:latest" $
+      setEnvironment env
+        <<< setCommand [ "sleep", "360" ]
 
-      let { output, exitCode } = unsafePartial $ forceRight execResult
-      output `shouldInclude` "SOME_VARIABLE=SOME_VALUE"
-      output `shouldInclude` "OTHER_VARIABLE=OTHER_VALUE"
-      exitCode `shouldEqual` 0
+    res <- withContainer sleeperContainer $ \c -> do
+      launchCommand c [ "env" ]
+        ( \s -> do
+            s `shouldInclude` "SOME_VARIABLE=SOME_VALUE"
+            s `shouldInclude` "OTHER_VARIABLE=OTHER_VALUE"
+        )
+        (\exitCode -> exitCode `shouldEqual` 0)
 
     case res of
       Left e -> throwError $ error e

test/Test/Ports.purs

@@ -7,22 +7,18 @@ import Partial.Unsafe (unsafePartial)
 import Test.Partials (forceRight)
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual, shouldNotEqual, shouldSatisfy)
-import Test.TestContainers (getFirstMappedPort, getMappedPort, mkContainer, withContainer)
-import Test.TestContainers.Monad (configure, getContainer, setExposedPortsM, setPullPolicyM, setReuseM, setUserM, setWaitStrategyM)
+import Test.TestContainers (getFirstMappedPort, getMappedPort, setExposedPorts, setPullPolicy, setReuse, setWaitStrategy, withContainer)
 import Test.TestContainers.Types (PullPolicy(..), WaitStrategy(..))
-import Test.Utils (launchCommand)
+import Test.Utils (mkAffContainer)
 
 portMappingTest :: Spec Unit
 portMappingTest = do
   describe "Port Mappings" $ do
     it "should map ports" $ do
-      let
-        nginx = mkContainer "nginx:alpine" # configure $ do
-          setExposedPortsM [ 80 ]
-          setPullPolicyM AlwaysPull
-          setReuseM
-          ret <- getContainer
-          pure ret
+      nginx <- mkAffContainer "nginx:alpine" $
+        setExposedPorts [ 80 ]
+          <<< setPullPolicy AlwaysPull
+          <<< setReuse
 
       void $ withContainer nginx $ \c -> do
         ports <- getMappedPort 80 c
@@ -35,19 +31,11 @@ portMappingTest = do
         let singleMappedPort = unsafePartial $ forceRight singlePort
         singleMappedPort `shouldEqual` mappedPort
 
-        launchCommand c [ "whoami" ]
-          (\s -> s `shouldEqual` "root\n")
-          (\code -> code `shouldEqual` 0)
-
     it "should map multiple ports" $ do
-      let
-        redis = mkContainer "redis:latest" # configure $ do
-          setExposedPortsM [ 6379, 6270 ]
-          setPullPolicyM AlwaysPull
-          setWaitStrategyM [ LogOutput "Ready to accept connections tcp" 1 ]
-          setUserM "redis"
-          ret <- getContainer
-          pure ret
+      redis <- mkAffContainer "redis:latest" $
+        setExposedPorts [ 6379, 6270 ]
+          <<< setPullPolicy AlwaysPull
+          <<< setWaitStrategy [ LogOutput "Ready to accept connections tcp" 1 ]
 
       void $ withContainer redis $ \c -> do
         port <- getMappedPort 6379 c
@@ -60,7 +48,3 @@ portMappingTest = do
 
         mappedPort `shouldNotEqual` mappedPort'
 
-        launchCommand c [ "whoami" ]
-          (\s -> s `shouldEqual` "redis\n")
-          (\_ -> pure unit)
-

test/Test/Privileged.purs

@@ -3,29 +3,23 @@ module Test.Privileged where
 import Prelude
 
 import Control.Monad.Error.Class (throwError)
-import Data.Either (Either(..), isRight)
+import Data.Either (Either(..))
 import Effect.Aff (error)
-import Partial.Unsafe (unsafePartial)
 import Test.Assertions (shouldInclude)
-import Test.Partials (forceRight)
 import Test.Spec (Spec, describe, it)
-import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
-import Test.TestContainers (exec, setPrivilegedMode, setWaitStrategy, withContainer)
+import Test.Spec.Assertions (shouldEqual)
+import Test.TestContainers (setPrivilegedMode, setWaitStrategy, withContainer)
 import Test.TestContainers.Types (WaitStrategy(..))
-import Test.Utils (mkAffContainer)
+import Test.Utils (launchCommand, mkAffContainer)
 
 privilegedTest :: Spec Unit
 privilegedTest = describe "Privileged Mode" $ do
   it "should set privileged mode correctly" $ do
     dockerDind <- mkAffContainer "docker:dind" $ setPrivilegedMode <<< setWaitStrategy [ LogOutput "API listen on" 1 ]
     res <- withContainer dockerDind $ \c -> do
-      execResult <- exec [ "docker", "ps" ] c
-      execResult `shouldSatisfy` isRight
-
-      let { output, exitCode } = unsafePartial $ forceRight execResult
-      exitCode `shouldEqual` 0
-      output `shouldInclude` "STATUS"
-      pure unit
+      launchCommand c [ "docker", "ps" ]
+        (\s -> s `shouldInclude` "STATUS")
+        (\exitCode -> exitCode `shouldEqual` 0)
 
     -- Check that the withContainer function succeeded
     case res of