diff --git a/test/Test/Basic.purs b/test/Test/Basic.purs index 3f30b30..4832663 100644 --- a/test/Test/Basic.purs +++ b/test/Test/Basic.purs @@ -13,8 +13,7 @@ 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) @@ -22,14 +21,11 @@ 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 diff --git a/test/Test/Binds.purs b/test/Test/Binds.purs index 71988da..438fa4f 100644 --- a/test/Test/Binds.purs +++ b/test/Test/Binds.purs @@ -2,89 +2,77 @@ 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 @@ -92,11 +80,13 @@ bindTest = do 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 diff --git a/test/Test/Entrypoint.purs b/test/Test/Entrypoint.purs index 28ffb56..02cf20c 100644 --- a/test/Test/Entrypoint.purs +++ b/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 diff --git a/test/Test/EnvironmentVariables.purs b/test/Test/EnvironmentVariables.purs index aa11928..e58c1c8 100644 --- a/test/Test/EnvironmentVariables.purs +++ b/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 diff --git a/test/Test/Ports.purs b/test/Test/Ports.purs index dd8dc4e..5ed5c64 100644 --- a/test/Test/Ports.purs +++ b/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) - diff --git a/test/Test/Privileged.purs b/test/Test/Privileged.purs index e8af220..9388ca2 100644 --- a/test/Test/Privileged.purs +++ b/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 diff --git a/test/Test/WaitStrategy.purs b/test/Test/WaitStrategy.purs index cccf53e..826d18b 100644 --- a/test/Test/WaitStrategy.purs +++ b/test/Test/WaitStrategy.purs @@ -3,21 +3,19 @@ module Test.WaitStrategy (waitStrategyTest) where import Prelude import Data.DateTime.Instant (unInstant) -import Data.Either (Either(..), isRight) +import Data.Either (Either(..)) import Data.String.Utils (includes) import Data.Time.Duration (Milliseconds(..)) import Effect.Aff (error, throwError) import Effect.Class (liftEffect) import Effect.Now (now) -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, setExposedPorts, setStartupTimeout, setWaitStrategy, withContainer) +import Test.TestContainers (setCommand, setExposedPorts, setStartupTimeout, setWaitStrategy, withContainer) import Test.TestContainers.Monad (setCommandM, setEnvironmentM, setStartupTimeoutM, setWaitStrategyM) import Test.TestContainers.Types (StartupTimeout(..), WaitStrategy(..)) -import Test.Utils (mkAffContainer, mkAffContainerM) +import Test.Utils (launchCommand, mkAffContainer, mkAffContainerM) waitStrategyTest :: Spec Unit waitStrategyTest = describe "Wait Strategies" $ do @@ -33,11 +31,9 @@ waitStrategyTest = describe "Wait Strategies" $ do setWaitStrategyM [ LogOutput "ready to accept connections" 2 ] res <- withContainer psql $ \c -> do - execResult <- exec [ "psql", "-U", "test", "-c", "SELECT true" ] c - execResult `shouldSatisfy` isRight - - let { output } = unsafePartial $ forceRight execResult - output `shouldInclude` "(1 row)" + launchCommand c [ "psql", "-U", "test", "-c", "SELECT true" ] + (\s -> s `shouldInclude` "(1 row)") + (\exitCode -> exitCode `shouldEqual` 0) case res of Left e -> throwError $ error e