Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type MonadDocker m = (MonadIO m, MonadMask m, MonadThrow m, MonadCatch m, MonadResource m)
- type ImageTag = Text
- data Image
- imageTag :: Image -> ImageTag
- type ContainerId = Text
- data Container
- containerId :: Container -> ContainerId
- containerImage :: Container -> Image
- containerIp :: Container -> Text
- containerPort :: Container -> Int -> Int
- containerReleaseKey :: Container -> ReleaseKey
- data ToImage
- fromTag :: ImageTag -> ToImage
- fromBuildContext :: FilePath -> Maybe FilePath -> ToImage
- fromDockerfile :: Text -> ToImage
- build :: MonadDocker m => ToImage -> m ToImage
- data DockerException
- = DockerException { }
- | InspectUnknownContainerId {
- id :: ContainerId
- | InspectOutputInvalidJSON {
- id :: ContainerId
- | InspectOutputUnexpected {
- id :: ContainerId
- | UnknownPortMapping {
- id :: ContainerId
- port :: Text
- data ContainerRequest
- containerRequest :: ToImage -> ContainerRequest
- setName :: Text -> ContainerRequest -> ContainerRequest
- setCmd :: [Text] -> ContainerRequest -> ContainerRequest
- setRm :: Bool -> ContainerRequest -> ContainerRequest
- setEnv :: [(Text, Text)] -> ContainerRequest -> ContainerRequest
- setLink :: [ContainerId] -> ContainerRequest -> ContainerRequest
- setExpose :: [Int] -> ContainerRequest -> ContainerRequest
- setWaitingFor :: WaitUntilReady -> ContainerRequest -> ContainerRequest
- run :: MonadDocker m => ContainerRequest -> m Container
- type InspectOutput = Value
- inspect :: MonadDocker m => Container -> m InspectOutput
- stop :: MonadDocker m => Container -> m ()
- kill :: MonadDocker m => Container -> m ()
- rm :: MonadDocker m => Container -> m ()
- withLogs :: forall m a. MonadDocker m => Container -> (Handle -> Handle -> m a) -> m a
- data WaitUntilReady
- waitUntilReady :: MonadDocker m => Container -> WaitUntilReady -> m ()
- newtype TimeoutException = TimeoutException {
- id :: ContainerId
- waitUntilTimeout :: Int -> WaitUntilReady -> WaitUntilReady
- waitWithLogs :: (Container -> Handle -> Handle -> IO ()) -> WaitUntilReady
- newtype UnexpectedEndOfPipe = UnexpectedEndOfPipe {
- id :: ContainerId
- data Pipe
- waitForLogLine :: Pipe -> (Text -> Bool) -> WaitUntilReady
- waitUntilMappedPortReachable :: Int -> WaitUntilReady
- type ResIO = ResourceT IO
- runResourceT :: MonadUnliftIO m => ResourceT m a -> m a
- (&) :: a -> (a -> b) -> b
Documentation
type MonadDocker m = (MonadIO m, MonadMask m, MonadThrow m, MonadCatch m, MonadResource m) Source #
Docker related functionality is parameterized over this Monad
.
Docker image
Handle to a Docker image.
imageTag :: Image -> ImageTag Source #
The image tag assigned by Docker. Uniquely identifies an Image
within Docker.
Docker container
type ContainerId = Text Source #
Identifies a container within the Docker runtime. Assigned by docker run
.
containerId :: Container -> ContainerId Source #
Returns the id of the container.
containerImage :: Container -> Image Source #
Returns the underlying image of the container.
containerIp :: Container -> Text Source #
Looks up the ip address of the container.
containerReleaseKey :: Container -> ReleaseKey Source #
Returns the internal release key used for safely shutting down the container. Use this with care. This function is considered an internal detail.
Referring to images
fromBuildContext :: FilePath -> Maybe FilePath -> ToImage Source #
Build the image from a build path and an optional path to the Dockerfile (default is Dockerfile)
fromDockerfile :: Text -> ToImage Source #
Build a contextless image only from a Dockerfile passed as Text
.
build :: MonadDocker m => ToImage -> m ToImage Source #
Build the Image
referred to by the argument. If the construction of the
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
.
Exceptions
data DockerException Source #
Failing to interact with Docker results in this exception being thrown.
DockerException | |
InspectUnknownContainerId | |
| |
InspectOutputInvalidJSON | |
| |
InspectOutputUnexpected | |
| |
UnknownPortMapping | |
|
Instances
Eq DockerException Source # | |
Defined in TestContainers.Docker (==) :: DockerException -> DockerException -> Bool # (/=) :: DockerException -> DockerException -> Bool # | |
Show DockerException Source # | |
Defined in TestContainers.Docker showsPrec :: Int -> DockerException -> ShowS # show :: DockerException -> String # showList :: [DockerException] -> ShowS # | |
Exception DockerException Source # | |
Defined in TestContainers.Docker |
Running containers
data ContainerRequest Source #
Parameters for a running a Docker container.
containerRequest :: ToImage -> ContainerRequest Source #
Default ContainerRequest
. Used as base for every Docker container.
setName :: Text -> ContainerRequest -> ContainerRequest Source #
Set the name of a Docker container.
setCmd :: [Text] -> ContainerRequest -> ContainerRequest Source #
The command to execute inside the Docker container.
setRm :: Bool -> ContainerRequest -> ContainerRequest Source #
Wether to remove the container once exited.
setEnv :: [(Text, Text)] -> ContainerRequest -> ContainerRequest Source #
Set the environment for the container.
setLink :: [ContainerId] -> ContainerRequest -> ContainerRequest Source #
Set link on the container.
setExpose :: [Int] -> ContainerRequest -> ContainerRequest Source #
setWaitingFor :: WaitUntilReady -> ContainerRequest -> ContainerRequest Source #
Set the waiting strategy on the container.
run :: MonadDocker m => ContainerRequest -> m Container Source #
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.
Managing the container lifecycle
type InspectOutput = Value Source #
The parsed JSON output of docker inspect command.
inspect :: MonadDocker m => Container -> m InspectOutput Source #
Runs the `docker inspect` command. Memoizes the result.
stop :: MonadDocker m => Container -> m () Source #
Stops a Docker container.
kill :: MonadDocker m => Container -> m () Source #
Kills a Docker container.
rm :: MonadDocker m => Container -> m () Source #
Remove a Docker container.
withLogs :: forall m a. MonadDocker m => Container -> (Handle -> Handle -> m a) -> m a Source #
Get the logs from a Docker container.
Wait for containers to become ready
data WaitUntilReady Source #
A strategy that describes how to asses readiness of a Container
. Allows
Users to plug in their definition of readiness.
waitUntilReady :: MonadDocker m => Container -> WaitUntilReady -> m () Source #
Blocks until the container is ready. waitUntilReady
might throw exceptions
depending on the used WaitUntilReady
on the container.
Only block for defined amounts of time
newtype TimeoutException Source #
The exception thrown by waitUntilTimeout
.
TimeoutException | |
|
Instances
Eq TimeoutException Source # | |
Defined in TestContainers.Docker (==) :: TimeoutException -> TimeoutException -> Bool # (/=) :: TimeoutException -> TimeoutException -> Bool # | |
Show TimeoutException Source # | |
Defined in TestContainers.Docker showsPrec :: Int -> TimeoutException -> ShowS # show :: TimeoutException -> String # showList :: [TimeoutException] -> ShowS # | |
Exception TimeoutException Source # | |
Defined in TestContainers.Docker |
waitUntilTimeout :: Int -> WaitUntilReady -> WaitUntilReady Source #
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.
Wait until a specific pattern appears in the logs
waitWithLogs :: (Container -> Handle -> Handle -> IO ()) -> WaitUntilReady Source #
A low-level primitive that allows scanning the logs for specific log lines that indicate readiness of a container.
The Handle
s passed to the function argument represent stdout
and stderr
of the container.
newtype UnexpectedEndOfPipe Source #
The exception thrown by waitForLine
in case the expected log line
wasn't found.
UnexpectedEndOfPipe | |
|
Instances
Eq UnexpectedEndOfPipe Source # | |
Defined in TestContainers.Docker (==) :: UnexpectedEndOfPipe -> UnexpectedEndOfPipe -> Bool # (/=) :: UnexpectedEndOfPipe -> UnexpectedEndOfPipe -> Bool # | |
Show UnexpectedEndOfPipe Source # | |
Defined in TestContainers.Docker showsPrec :: Int -> UnexpectedEndOfPipe -> ShowS # show :: UnexpectedEndOfPipe -> String # showList :: [UnexpectedEndOfPipe] -> ShowS # | |
Exception UnexpectedEndOfPipe Source # | |
Defined in TestContainers.Docker |
A data type indicating which pipe to scan for a specific log line.
waitForLogLine :: Pipe -> (Text -> Bool) -> WaitUntilReady Source #
Waits for a specific line to occur in the logs. Throws a UnexpectedEndOfPipe
exception in case the desired line can not be found on the logs.
Say you want to find "Ready to accept connections" in the logs on Stdout try:
wairForLogLine Stdout ("Ready to accept connections" `isInfixOf
`)
Wait until a socket is reachable
waitUntilMappedPortReachable :: Int -> WaitUntilReady Source #
Waits until the port of a container is ready to accept connections.
This combinator should always be used with waitUntilTimeout
.
Reexports for convenience
runResourceT :: MonadUnliftIO m => ResourceT m a -> m a #
Unwrap a ResourceT
transformer, and call all registered release actions.
Note that there is some reference counting involved due to resourceForkIO
.
If multiple threads are sharing the same collection of resources, only the
last call to runResourceT
will deallocate the resources.
NOTE Since version 1.2.0, this function will throw a
ResourceCleanupException
if any of the cleanup functions throw an
exception.
Since: resourcet-0.3.0