testcontainers 0.1.0.0 → 0.2.0.0
raw patch · 9 files changed
+455/−78 lines, 9 filesdep +aeson-opticsdep +mtldep +optics-coredep −lensdep −lens-aesondep ~networkdep ~unliftio-core
Dependencies added: aeson-optics, mtl, optics-core
Dependencies removed: lens, lens-aeson
Dependency ranges changed: network, unliftio-core
Files
- CHANGELOG.md +4/−0
- src/TestContainers.hs +104/−1
- src/TestContainers/Docker.hs +303/−55
- src/TestContainers/Hspec.hs +11/−5
- src/TestContainers/Image.hs +6/−0
- src/TestContainers/Tasty.hs +8/−2
- test/TestContainers/HspecSpec.hs +1/−0
- test/TestContainers/TastySpec.hs +12/−10
- testcontainers.cabal +6/−5
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for testcontainer-hs +## 0.2.0.0 -- 2020-08-07++* Dependency rework (@blackheaven, https://github.com/alexbiehl/testcontainers-hs/pull/3)+ ## 0.1.0.0 -- 2020-08-06 * First version. Released on an unsuspecting world.
src/TestContainers.hs view
@@ -1,6 +1,109 @@+-- |+-- This module shall be used as entrypoint to the testcontainers library. It exports+-- all the necessary types and functions for most common use-cases.+-- module TestContainers (- module M++ -- * Docker images++ M.ImageTag++ , M.Image+ , M.imageTag++ -- * Referring to Docker images++ , M.ToImage+ , M.fromTag+ , M.fromBuildContext+ , M.build++ -- * @docker run@ parameters++ , M.ContainerRequest+ , M.containerRequest++ , M.setName+ , M.setCmd+ , M.setRm+ , M.setEnv+ , M.setLink+ , M.setExpose+ , M.setWaitingFor++ -- * Running Docker containers (@docker run@)++ , M.Container+ , M.containerIp+ , M.containerPort+ , M.containerReleaseKey+ , M.containerImage++ , M.run++ -- * Inspecting Docker containers++ , M.InspectOutput+ , M.inspect++ -- * Docker container lifecycle++ , M.stop+ , M.kill+ , M.rm+ , M.withLogs++ -- * Readiness checks++ , M.WaitUntilReady++ -- ** Timeout for readiness checks++ , M.waitUntilTimeout++ -- ** Waiting on particular log lines++ , M.Pipe(..)+ , M.waitWithLogs+ , M.waitForLogLine++ -- ** Wait until connection can be established++ , M.waitUntilMappedPortReachable++ -- * Monad++ , M.MonadDocker++ -- * Configuration++ , Config(..)+ , defaultDockerConfig+ , dockerForMacConfig+ , determineConfig++ -- * Exceptions++ , M.DockerException(..)+ , M.TimeoutException(..)+ , M.UnexpectedEndOfPipe(..)++ -- * Misc. Docker functions++ , dockerVersion+ , isDockerForDesktop++ -- * Predefined Docker images++ , M.redis+ , M.mongo++ -- * Reexports++ , ResIO+ , runResourceT+ , (&) ) where import TestContainers.Docker as M
src/TestContainers/Docker.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}@@ -10,6 +11,13 @@ ( MonadDocker + -- * Configuration++ , Config(..)+ , defaultDockerConfig+ , dockerForMacConfig+ , determineConfig+ -- * Docker image , ImageTag@@ -79,6 +87,11 @@ , Pipe(..) , waitForLogLine + -- * Misc. Docker functions++ , dockerVersion+ , isDockerForDesktop+ -- * Wait until a socket is reachable , waitUntilMappedPortReachable @@ -91,25 +104,30 @@ import Control.Concurrent (threadDelay) import Control.Exception (IOException, throw)-import Control.Lens ((^?))+import Optics.Operators ((^?))+import Optics.Optic ((%))+import Optics.Fold (pre) import Control.Monad.Catch (Exception, MonadCatch, MonadMask, MonadThrow, bracket, throwM, try) import Control.Monad.Fix (mfix) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.IO.Unlift (MonadUnliftIO (withRunInIO))+import Control.Monad.Reader (MonadReader (..), runReaderT) import Control.Monad.Trans.Resource (MonadResource (liftResourceT), ReleaseKey, ResIO, register, runResourceT) import Data.Aeson (Value, decode')-import qualified Data.Aeson.Lens as Lens+import qualified Data.Aeson.Optics as Optics import qualified Data.ByteString.Lazy.Char8 as LazyByteString import Data.Function ((&)) import Data.List (find)-import Data.Text (Text, pack, strip, unpack)+import Data.Text (Text, isInfixOf, pack, strip,+ unpack) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText-import GHC.Stack (HasCallStack, withFrozenCallStack)+import GHC.Stack (HasCallStack,+ withFrozenCallStack) import qualified Network.Socket as Socket import Prelude hiding (error, id) import qualified Prelude@@ -120,8 +138,65 @@ import System.Timeout (timeout) +-- | Configuration for defaulting behavior.+--+-- Note that IP address returned by `containerIp` is not reachable when using+-- Docker For Mac (See https://docs.docker.com/docker-for-mac/networking/#per-container-ip-addressing-is-not-possible).+--+-- If you are targeting Docker For Mac you should use `dockerForMacConfig`, instead+-- use `defaultDockerConfig`.+--+-- @since 0.2.0.0+--+data Config = Config+ {+ -- | How to retrieve the IP address of a Docker container.+ -- There some known limitations around Docker for Mac in that+ -- it doesn't support accessing containers by their IP (see `containerIp`).+ --+ -- This configuration let's you define how to access the IP.+ configContainerIp :: Container -> Text+ }+++-- | Default configuration.+--+-- @since 0.2.0.0+--+defaultDockerConfig :: Config+defaultDockerConfig = Config+ {+ configContainerIp = internalContainerIp+ }+++-- | A default configuration to use with Docker for Mac installations. It doesn't+-- use a Docker container's IP address to access a container, instead it always uses+-- the loopback interface @0.0.0.0@.+--+-- @since 0.2.0.0+--+dockerForMacConfig :: Config+dockerForMacConfig = defaultDockerConfig+ {+ configContainerIp = \_ -> "0.0.0.0"+ }+++-- | Autoselect the default configuration depending on wether you use Docker For+-- Mac/Desktop or not.+determineConfig :: IO Config+determineConfig = do+ -- TODO We used to be clever here but it turned out that it wouldn't let+ -- hosts reach containers. Even on linux! Figure out how to do Docker+ -- networking properly.+ pure dockerForMacConfig+ -- | Failing to interact with Docker results in this exception -- being thrown.+--+-- @since 0.1.0.0+-- data DockerException = DockerException {@@ -139,7 +214,7 @@ { -- | Id of the `Container` that we tried to lookup the -- port mapping.- id :: ContainerId+ id :: ContainerId -- | Textual representation of port mapping we were -- trying to look up. , port :: Text@@ -151,11 +226,17 @@ -- | Docker related functionality is parameterized over this `Monad`.+--+-- @since 0.1.0.0+-- type MonadDocker m =- (MonadIO m, MonadMask m, MonadThrow m, MonadCatch m, MonadResource m)+ (MonadIO m, MonadMask m, MonadThrow m, MonadCatch m, MonadResource m, MonadReader Config m) -- | Parameters for a running a Docker container.+--+-- @since 0.1.0.0+-- data ContainerRequest = ContainerRequest { toImage :: ToImage@@ -171,6 +252,9 @@ -- | Default `ContainerRequest`. Used as base for every Docker container.+--+-- @since 0.1.0.0+-- containerRequest :: ToImage -> ContainerRequest containerRequest image = ContainerRequest {@@ -186,51 +270,80 @@ } --- | Set the name of a Docker container.+-- | Set the name of a Docker container. This is equivalent to invoking @docker run@+-- with the @--name@ parameter.+--+-- @since 0.1.0.0+-- setName :: Text -> ContainerRequest -> ContainerRequest setName newName req = -- TODO error on empty Text req { name = Just newName } --- | The command to execute inside the Docker container.+-- | The command to execute inside the Docker container. This is the equivalent+-- of passing the command on the @docker run@ invocation.+--+-- @since 0.1.0.0+-- setCmd :: [Text] -> ContainerRequest -> ContainerRequest setCmd newCmd req = req { cmd = Just newCmd } --- | Wether to remove the container once exited.+-- | Wether to remove the container once exited. This is equivalent to passing+-- @--rm@ to @docker run@. (default is `True`).+--+-- @since 0.1.0.0+-- setRm :: Bool -> ContainerRequest -> ContainerRequest setRm newRm req = req { rmOnExit = newRm } --- | Set the environment for the container.+-- | Set the environment for the container. This is equivalent to passing @--env key=value@+-- to @docker run@.+--+-- @since 0.1.0.0+-- setEnv :: [(Text, Text)] -> ContainerRequest -> ContainerRequest setEnv newEnv req = req { env = newEnv } --- | Set link on the container.+-- | Set link on the container. This is equivalent to passing @--link other_container@+-- to @docker run@.+--+-- @since 0.1.0.0+-- setLink :: [ContainerId] -> ContainerRequest -> ContainerRequest setLink newLink req = req { links = newLink } --- | Set exposed ports on the container.------ Example:+-- | Set exposed ports on the container. This is equivalent to setting @--publish $PORT@ to+-- @docker run@. Docker assigns a random port for the host port. You will have to use `containerIp`+-- and `containerPort` to connect to the published port. ----- @ redis--- `&` `setExpose` [ 6379 ] -- @+-- container <- `run` $ `containerRequest` `redis` & `setExpose` [ 6379 ]+-- let (redisHost, redisPort) = (`containerIp` container, `containerPort` container 6379)+-- print (redisHost, redisPort)+-- @ --+-- @since 0.1.0.0+-- setExpose :: [Int] -> ContainerRequest -> ContainerRequest setExpose newExpose req = req { exposedPorts = newExpose } --- | Set the waiting strategy on the container.+-- | Set the waiting strategy on the container. Depending on a Docker container+-- it can take some time until the provided service is ready. You will want to+-- use to `setWaitingFor` to block until the container is ready to use.+--+-- @since 0.1.0.0+-- setWaitingFor :: WaitUntilReady -> ContainerRequest -> ContainerRequest setWaitingFor newWaitingFor req = req { readiness = Just newWaitingFor }@@ -238,8 +351,12 @@ -- | Runs a Docker container from an `Image` and `ContainerRequest`. A finalizer -- is registered so that the container is aways stopped when it goes out of scope.+-- This function is essentially @docker run@.+--+-- @since 0.1.0.0+-- run :: MonadDocker m => ContainerRequest -> m Container-run request = liftResourceT $ do+run request = do let ContainerRequest@@ -279,22 +396,23 @@ -- N.B. Force to not leak STDOUT String strip (pack stdout) - let -- Careful, this is really meant to be lazy ~inspectOutput = unsafePerformIO $ internalInspect id - container <- mfix $ \container -> do- -- Note: We have to tie the knot as the resulting container- -- carries the release key as well.- releaseKey <- register $ runResourceT (stop container)- pure $ Container- {- id- , releaseKey- , image- , inspectOutput- }+ config <- ask+ container <- liftResourceT $ mfix $ \container -> do+ -- Note: We have to tie the knot as the resulting container+ -- carries the release key as well.+ releaseKey <- register $ runReaderT (runResourceT (stop container)) config+ pure $ Container+ {+ id+ , releaseKey+ , image+ , inspectOutput+ , config+ } case readiness of Just wait ->@@ -307,6 +425,9 @@ -- | Internal function that runs Docker. Takes care of throwing an exception -- in case of failure.+--+-- @since 0.1.0.0+-- docker :: MonadIO m => [Text] -> m String docker args = dockerWithStdin args ""@@ -314,6 +435,9 @@ -- | Internal function that runs Docker. Takes care of throwing an exception -- in case of failure.+--+-- @since 0.1.0.0+-- dockerWithStdin :: MonadIO m => [Text] -> Text -> m String dockerWithStdin args stdin = liftIO $ do (exitCode, stdout, stderr) <- Process.readProcessWithExitCode "docker"@@ -328,28 +452,41 @@ } --- | Kills a Docker container.+-- | Kills a Docker container. `kill` is essentially @docker kill@.+--+-- @since 0.1.0.0+-- kill :: MonadDocker m => Container -> m () kill Container { id } = do _ <- docker [ "kill", id ] return () --- | Stops a Docker container.+-- | Stops a Docker container. `stop` is essentially @docker stop@.+--+-- @since 0.1.0.0+-- stop :: MonadDocker m => Container -> m () stop Container { id } = do _ <- docker [ "stop", id ] return () --- | Remove a Docker container.+-- | Remove a Docker container. `rm` is essentially @docker rm -f@+--+-- @since 0.1.0.0+-- rm :: MonadDocker m => Container -> m () rm Container { id } = do _ <- docker [ "rm", "-f", "-v", id ] return () --- | Get the logs from a Docker container.+-- | Access STDOUT and STDERR of a running Docker container. This is essentially+-- @docker logs@ under the hood.+--+-- @since 0.1.0.0+-- withLogs :: forall m a . MonadDocker m => Container -> (Handle -> Handle -> m a) -> m a withLogs Container { id } logger = do @@ -358,7 +495,7 @@ acquire = liftIO $ Process.runInteractiveProcess "docker"- [ "logs", unpack id ]+ [ "logs", "--follow", unpack id ] Nothing Nothing @@ -374,10 +511,16 @@ -- | A tag to a Docker image.+--+-- @since 0.1.0.0+-- type ImageTag = Text -- | A description of how to build an `Image`.+--+-- @since 0.1.0.0+-- data ToImage = ToImage { runToImage :: forall m. MonadDocker m => m Image@@ -389,6 +532,9 @@ -- image is expensive (e.g. a call to `fromBuildContext`) we don't want to -- repeatedly build the image. Instead, `build` can be used to execute the -- underlying Docker build once and re-use the resulting `Image`.+--+-- @since 0.1.0.0+-- build :: MonadDocker m => ToImage -> m ToImage build toImage@ToImage { applyToContainerRequest } = do image <- runToImage toImage@@ -400,6 +546,9 @@ -- | Default `ToImage`. Doesn't apply anything to to `ContainerRequests`.+--+-- @since 0.1.0.0+-- defaultToImage :: (forall m . MonadDocker m => m Image) -> ToImage defaultToImage action = ToImage {@@ -409,9 +558,12 @@ -- | Get an `Image` from a tag.+--+-- @since 0.1.0.0+-- fromTag :: ImageTag -> ToImage-fromTag imageTag = defaultToImage $ do- output <- docker [ "pull", "--quiet", imageTag ]+fromTag tag = defaultToImage $ do+ output <- docker [ "pull", "--quiet", tag ] return $ Image { tag = strip (pack output)@@ -420,6 +572,9 @@ -- | Build the image from a build path and an optional path to the -- Dockerfile (default is Dockerfile)+--+-- @since 0.1.0.0+-- fromBuildContext :: FilePath -> Maybe FilePath@@ -439,6 +594,9 @@ -- | Build a contextless image only from a Dockerfile passed as `Text`.+--+-- @since 0.1.0.0+-- fromDockerfile :: Text -> ToImage@@ -451,10 +609,16 @@ -- | Identifies a container within the Docker runtime. Assigned by @docker run@.+--+-- @since 0.1.0.0+-- type ContainerId = Text -- | Dumb logger abstraction to allow us to trace container execution.+--+-- @since 0.1.0.0+-- data Logger = Logger { debug :: forall m . (HasCallStack, MonadIO m) => Text -> m ()@@ -465,6 +629,9 @@ -- | Logger that doesn't log anything.+--+-- @since 0.1.0.0+-- silentLogger :: Logger silentLogger = Logger {@@ -477,14 +644,20 @@ -- | A strategy that describes how to asses readiness of a `Container`. Allows -- Users to plug in their definition of readiness.+--+-- @since 0.1.0.0+-- newtype WaitUntilReady = WaitUntilReady {- checkContainerReady :: Logger -> Container -> ResIO ()+ checkContainerReady :: Logger -> Config -> Container -> ResIO () } -- | The exception thrown by `waitForLine` in case the expected log line -- wasn't found.+--+-- @since 0.1.0.0+-- newtype UnexpectedEndOfPipe = UnexpectedEndOfPipe { -- | The id of the underlying container.@@ -497,6 +670,9 @@ -- | The exception thrown by `waitUntilTimeout`.+--+-- @since 0.1.0.0+-- newtype TimeoutException = TimeoutException { -- | The id of the underlying container that was not ready in time.@@ -511,11 +687,14 @@ -- | @waitUntilTimeout n waitUntilReady@ waits @n@ seconds for the container -- to be ready. If the container is not ready by then a `TimeoutException` will -- be thrown.+--+-- @since 0.1.0.0+-- waitUntilTimeout :: Int -> WaitUntilReady -> WaitUntilReady-waitUntilTimeout seconds wait = WaitUntilReady $ \logger container@Container{ id } -> do+waitUntilTimeout seconds wait = WaitUntilReady $ \logger config container@Container{ id } -> do withRunInIO $ \runInIO -> do result <- timeout (seconds * 1000000) $- runInIO (checkContainerReady wait logger container)+ runInIO (checkContainerReady wait logger config container) case result of Nothing -> throwM $ TimeoutException { id }@@ -525,10 +704,13 @@ -- | Waits until the port of a container is ready to accept connections. -- This combinator should always be used with `waitUntilTimeout`.+--+-- @since 0.1.0.0+-- waitUntilMappedPortReachable :: Int -> WaitUntilReady-waitUntilMappedPortReachable port = WaitUntilReady $ \logger container ->+waitUntilMappedPortReachable port = WaitUntilReady $ \logger _config container -> withFrozenCallStack $ do let@@ -575,13 +757,19 @@ -- -- The `Handle`s passed to the function argument represent @stdout@ and @stderr@ -- of the container.+--+-- @since 0.1.0.0+-- waitWithLogs :: (Container -> Handle -> Handle -> IO ()) -> WaitUntilReady-waitWithLogs waiter = WaitUntilReady $ \_logger container -> do- withLogs container $ \stdout stderr ->+waitWithLogs waiter = WaitUntilReady $ \_logger config container -> do+ flip runReaderT config $ withLogs container $ \stdout stderr -> liftIO $ waiter container stdout stderr -- | A data type indicating which pipe to scan for a specific log line.+--+-- @since 0.1.0.0+-- data Pipe -- | Refer to logs on STDOUT. = Stdout@@ -598,6 +786,9 @@ -- @ -- wairForLogLine Stdout ("Ready to accept connections" ``LazyText.isInfixOf``) -- @+--+-- @since 0.1.0.0+-- waitForLogLine :: Pipe -> (LazyText.Text -> Bool) -> WaitUntilReady waitForLogLine whereToLook matches = waitWithLogs $ \Container { id } stdout stderr -> do let@@ -623,12 +814,19 @@ -- | Blocks until the container is ready. `waitUntilReady` might throw exceptions -- depending on the used `WaitUntilReady` on the container.+--+-- @since 0.1.0.0+-- waitUntilReady :: MonadDocker m => Container -> WaitUntilReady -> m ()-waitUntilReady container waiter =- liftResourceT $ checkContainerReady waiter silentLogger container+waitUntilReady container waiter = do+ config <- ask+ liftResourceT $ checkContainerReady waiter silentLogger config container -- | Handle to a Docker image.+--+-- @since 0.1.0.0+-- data Image = Image { -- | The image tag assigned by Docker. Uniquely identifies an `Image`@@ -640,11 +838,17 @@ -- | The image tag assigned by Docker. Uniquely identifies an `Image` -- within Docker.+--+-- @since 0.1.0.0+-- imageTag :: Image -> ImageTag imageTag Image { tag } = tag -- | Handle to a Docker container.+--+-- @since 0.1.0.0+-- data Container = Container { -- | The container Id assigned by Docker, uniquely identifying this `Container`.@@ -653,21 +857,32 @@ , releaseKey :: ReleaseKey -- | The underlying `Image` of this container. , image :: Image+ -- | Configuration used to create and run this container.+ , config :: Config -- | Memoized output of `docker inspect`. This is being calculated lazily. , inspectOutput :: InspectOutput } -- | The parsed JSON output of docker inspect command.+--+-- @since 0.1.0.0+-- type InspectOutput = Value -- | Returns the id of the container.+--+-- @since 0.1.0.0+-- containerId :: Container -> ContainerId containerId Container { id } = id -- | Returns the underlying image of the container.+--+-- @since 0.1.0.0+-- containerImage :: Container -> Image containerImage Container { image } = image @@ -675,17 +890,29 @@ -- | Returns the internal release key used for safely shutting down -- the container. Use this with care. This function is considered -- an internal detail.+--+-- @since 0.1.0.0+-- containerReleaseKey :: Container -> ReleaseKey containerReleaseKey Container { releaseKey } = releaseKey -- | Looks up the ip address of the container.+--+-- @since 0.1.0.0+-- containerIp :: Container -> Text-containerIp Container { id, inspectOutput } =+containerIp container@Container { config = Config { configContainerIp } } =+ configContainerIp container+++-- | Get the IP address of a running Docker container using @docker inspect@.+internalContainerIp :: Container -> Text+internalContainerIp Container { id, inspectOutput } = case inspectOutput- ^? Lens.key "NetworkSettings"- . Lens.key "IPAddress"- . Lens._String of+ ^? Optics.key "NetworkSettings"+ % Optics.key "IPAddress"+ % Optics._String of Nothing -> throw $ InspectOutputUnexpected { id }@@ -695,6 +922,9 @@ -- | Looks up an exposed port on the host.+--+-- @since 0.1.0.0+-- containerPort :: Container -> Int -> Int containerPort Container { id, inspectOutput } port = let@@ -706,12 +936,12 @@ -- port from the right host address case inspectOutput- ^? Lens.key "NetworkSettings"- . Lens.key "Ports"- . Lens.key textPort- . Lens.values- . Lens.key "HostPort"- . Lens._String of+ ^? pre (Optics.key "NetworkSettings"+ % Optics.key "Ports"+ % Optics.key textPort+ % Optics.values+ % Optics.key "HostPort"+ % Optics._String) of Nothing -> throw $ UnknownPortMapping@@ -724,12 +954,18 @@ -- | Runs the `docker inspect` command. Memoizes the result.+--+-- @since 0.1.0.0+-- inspect :: MonadDocker m => Container -> m InspectOutput inspect Container { inspectOutput } = pure inspectOutput -- | Runs the `docker inspect` command.+--+-- @since 0.1.0.0+-- internalInspect :: (MonadThrow m, MonadIO m) => ContainerId -> m InspectOutput internalInspect id = do stdout <- docker [ "inspect", id ]@@ -742,3 +978,15 @@ pure value Just _ -> Prelude.error "Internal: Multiple results where I expected single result"+++dockerVersion :: (MonadResource m, MonadMask m, MonadIO m) => m Text+dockerVersion = do+ stdout <- docker [ "version", "--format", "{{.Server.KernelVersion}}" ]+ return (pack stdout)+++isDockerForDesktop :: (MonadResource m, MonadMask m, MonadIO m) => m Bool+isDockerForDesktop = do+ version <- dockerVersion+ pure $ "linuxkit" `isInfixOf` version
src/TestContainers/Hspec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module TestContainers.Hspec@@ -11,6 +12,7 @@ import Control.Exception (bracket) import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (runReaderT) import Control.Monad.Trans.Resource (InternalState, getInternalState) import Control.Monad.Trans.Resource.Internal (stateAlloc,@@ -46,13 +48,17 @@ -> IO () withContainers startContainers = dropState $ bracket acquire release where+ runC action = do+ config <- determineConfig+ runReaderT (runResourceT action) config+ acquire :: IO (a, InternalState)- acquire = runResourceT $ do- result <- startContainers- releaseMap <- getInternalState+ acquire = runC $ do+ result <- startContainers+ releaseMap <- getInternalState - liftIO $ stateAlloc releaseMap- pure (result, releaseMap)+ liftIO $ stateAlloc releaseMap+ pure (result, releaseMap) release :: (a, InternalState) -> IO () release (_, internalState) =
src/TestContainers/Image.hs view
@@ -21,6 +21,9 @@ -- @ -- redis = fromTag "redis:5.0" -- @+--+-- @since 0.1.0.0+-- redis :: ToImage redis = fromTag "redis:5.0"@@ -31,6 +34,9 @@ -- @ -- mongo = Tag "mongo:4.0.17" -- @+--+-- @since 0.1.0.0+-- mongo :: ToImage mongo = fromTag "mongo:4.0.17"
src/TestContainers/Tasty.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module TestContainers.Tasty@@ -10,6 +11,7 @@ ) where import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (runReaderT) import Control.Monad.Trans.Resource (InternalState, getInternalState, runResourceT)@@ -21,7 +23,7 @@ import TestContainers (Container, ContainerRequest, MonadDocker, ToImage,- run, stop)+ stop) import TestContainers as Reexports @@ -58,13 +60,17 @@ -> TestTree withContainers startContainers tests = let+ runC action = do+ config <- determineConfig+ runReaderT (runResourceT action) config+ -- Correct resource handling is tricky here: -- Tasty offers a bracket alike in IO. We have -- to transfer the ReleaseMap of the ResIO safely -- to the release function. Fortunately resourcet -- let's us access the internal state.. acquire :: IO (a, InternalState)- acquire = runResourceT $ do+ acquire = runC $ do result <- startContainers releaseMap <- getInternalState
test/TestContainers/HspecSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} module TestContainers.HspecSpec(main, spec_all) where import Test.Hspec
test/TestContainers/TastySpec.hs view
@@ -1,27 +1,29 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module TestContainers.TastySpec(main, test_all) where -import Control.Monad.IO.Class (liftIO)-import Data.Text (unpack)+import Data.Text.Lazy (isInfixOf) import Test.Tasty import Test.Tasty.HUnit-import TestContainers.Tasty (MonadDocker, containerIp,- containerPort, containerRequest, redis,- run, setExpose, setWaitingFor,- waitUntilMappedPortReachable,- waitUntilTimeout, withContainers, (&))+import TestContainers.Tasty (MonadDocker, Pipe (Stdout),+ containerRequest, fromTag, redis, run,+ setExpose, setRm, setWaitingFor,+ waitForLogLine,+ waitUntilMappedPortReachable,+ waitUntilTimeout, withContainers, (&)) containers1 :: MonadDocker m => m () containers1 = do- redisContainer <- run $ containerRequest redis+ _redisContainer <- run $ containerRequest redis & setExpose [ 6379 ] & setWaitingFor (waitUntilTimeout 30 $ waitUntilMappedPortReachable 6379) - liftIO $- print $ unpack (containerIp redisContainer) <> ":" <> show (containerPort redisContainer 6379)+ _rabbitmq <- run $ containerRequest (fromTag "rabbitmq:3.8.4")+ & setRm False+ & setWaitingFor (waitForLogLine Stdout (("completed with" `isInfixOf`))) pure ()
testcontainers.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: testcontainers-version: 0.1.0.0+version: 0.2.0.0 synopsis: Docker containers for your integration tests. description: testcontainers is a Haskell library that provides a friendly API to run Docker containers. It is designed to create a runtime environment@@ -30,15 +30,16 @@ -- other-extensions: build-depends: base >=4.12 && <5, aeson >= 1.4.6 && < 1.5,+ aeson-optics >= 1.1 && < 1.2, bytestring >= 0.10.8 && < 0.11, text >= 1.2.3 && < 1.3, exceptions >= 0.10.4 && < 0.11,- lens >= 4.19.2 && < 5,+ optics-core >= 0.1 && < 0.4, process >= 1.6.5 && < 1.7,- lens-aeson >= 1.1 && < 1.2,- network >= 2.8.0 && < 2.9,+ network >= 2.8.0 && < 3.2,+ mtl >= 2.2.2 && < 2.3, resourcet >= 1.2.4 && < 1.3,- unliftio-core >= 0.2.0 && < 0.3,+ unliftio-core >= 0.1.0 && < 0.3, tasty >= 1.0 && < 1.4 hs-source-dirs: src