diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,6 @@ # Revision history for testcontainer-hs -## 0.4.0.0 -- 2023-02-20 +## 0.5.0.0 -- 2023-02-20 * BREAKING: Refined lifecycle management. testcontainers is now using testcontainers/ryuk resource reaper to cleanup containers, networks and volumes. Release keys for containers are deprecated. (@alexbiehl, https://github.com/testcontainers/testcontainers-hs/pull/33) @@ -8,7 +8,13 @@ * BREAKING: Introduce TestContainer monad (@alexbiehl, https://github.com/testcontainers/testcontainers-hs/pull/29) +* Control container naming (@blackheaven, https://github.com/testcontainers/testcontainers-hs/pull/18) + * Ability to use Docker networks (@alexbiehl, https://github.com/testcontainers/testcontainers-hs/pull/32) + +* Better handling of running testcontainers from within Docker (@michivi, https://github.com/testcontainers/testcontainers-hs/pull/22) + +* Ability to wait for particular HTTP routes to become available with waitforHttp (@michivi, https://github.com/testcontainers/testcontainers-hs/pull/24) * Some internal module reorganization (@alexbiehl, https://github.com/testcontainers/testcontainers-hs/pull/32) diff --git a/src/TestContainers.hs b/src/TestContainers.hs --- a/src/TestContainers.hs +++ b/src/TestContainers.hs @@ -24,7 +24,6 @@ M.setVolumeMounts, M.setRm, M.setEnv, - M.setNetwork, M.withNetwork, M.withNetworkAlias, M.setLink, diff --git a/src/TestContainers/Config.hs b/src/TestContainers/Config.hs --- a/src/TestContainers/Config.hs +++ b/src/TestContainers/Config.hs @@ -11,7 +11,7 @@ -- | Default configuration. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 defaultConfig :: Config defaultConfig = Config diff --git a/src/TestContainers/Docker.hs b/src/TestContainers/Docker.hs --- a/src/TestContainers/Docker.hs +++ b/src/TestContainers/Docker.hs @@ -84,7 +84,6 @@ setVolumeMounts, setRm, setEnv, - setNetwork, withNetwork, withNetworkAlias, setLink, @@ -281,7 +280,7 @@ -- | Parameters for a naming a Docker container. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 data NamingStrategy = RandomName | FixedName Text @@ -320,7 +319,7 @@ -- | Set the name of a Docker container. This is equivalent to invoking @docker run@ -- with the @--name@ parameter. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 setFixedName :: Text -> ContainerRequest -> ContainerRequest setFixedName newName req = -- TODO error on empty Text @@ -329,7 +328,7 @@ -- | Set the name randomly given of a Docker container. This is equivalent to omitting -- the @--name@ parameter calling @docker run@. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 setRandomName :: ContainerRequest -> ContainerRequest setRandomName req = -- TODO error on empty Text @@ -338,7 +337,7 @@ -- | Set the name randomly suffixed of a Docker container. This is equivalent to invoking -- @docker run@ with the @--name@ parameter. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 setSuffixedName :: Text -> ContainerRequest -> ContainerRequest setSuffixedName preffix req = -- TODO error on empty Text @@ -377,15 +376,7 @@ -- | Set the network the container will connect to. This is equivalent to passing -- @--network network_name@ to @docker run@. -- --- @since 0.4.0.0 -setNetwork :: Text -> ContainerRequest -> ContainerRequest -setNetwork networkName req = - req {network = Just (Right networkName)} - --- | Set the network the container will connect to. This is equivalent to passing --- @--network network_name@ to @docker run@. --- --- @since 0.4.0.0 +-- @since 0.5.0.0 withNetwork :: Network -> ContainerRequest -> ContainerRequest withNetwork network req = req {network = Just (Left network)} @@ -393,14 +384,14 @@ -- | Set the network alias for this container. This is equivalent to passing -- @--network-alias alias@ to @docker run@. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 withNetworkAlias :: Text -> ContainerRequest -> ContainerRequest withNetworkAlias alias req = req {networkAlias = Just alias} -- | Sets labels for a container -- --- @since 0.4.0.0 +-- @since 0.5.0.0 withLabels :: [(Text, Text)] -> ContainerRequest -> ContainerRequest withLabels xs request = request {labels = xs} @@ -415,7 +406,7 @@ -- | Forwards container logs to the given 'LogConsumer' once ran. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 withFollowLogs :: LogConsumer -> ContainerRequest -> ContainerRequest withFollowLogs logConsumer request = request {followLogs = Just logConsumer} @@ -443,14 +434,14 @@ defaultProtocol :: Text defaultProtocol = "tcp" --- @since 0.4.0.0 +-- @since 0.5.0.0 instance Show Port where show Port {port, protocol} = show port <> "/" <> unpack protocol -- | A cursed but handy instance supporting literal 'Port's. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 instance Num Port where fromInteger x = Port {port = fromIntegral x, protocol = defaultProtocol} @@ -463,7 +454,7 @@ -- | A cursed but handy instance supporting literal 'Port's of them -- form @"8080"@, @"8080/udp"@, @"8080/tcp"@. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 instance IsString Port where fromString input = case splitOn "/" (pack input) of [numberish] @@ -595,7 +586,7 @@ -- | Sets up a Ryuk 'Reaper'. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 createRyukReaper :: TestContainer Reaper createRyukReaper = do ryukContainer <- @@ -607,8 +598,8 @@ & setWaitingFor (waitUntilMappedPortReachable ryukPort) & setRm True - (ryukContainerAddress, ryukContainerPort) <- - containerAddress ryukContainer ryukPort + let (ryukContainerAddress, ryukContainerPort) = + containerAddress ryukContainer ryukPort newRyukReaper ryukContainerAddress ryukContainerPort @@ -777,11 +768,11 @@ -- Next check WaitUntilReady --- | @since 0.4.0.0 +-- | @since 0.5.0.0 instance Semigroup WaitUntilReady where (<>) = WaitMany --- | @since 0.4.0.0 +-- | @since 0.5.0.0 instance Monoid WaitUntilReady where mempty = WaitReady mempty @@ -822,7 +813,7 @@ -- | @waitForState@ waits for a certain state of the container. If the container reaches a terminal -- state 'InvalidStateException' will be thrown. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 waitForState :: (State -> Bool) -> WaitUntilReady waitForState isReady = WaitReady $ \Container {id} -> do let wait = do @@ -850,7 +841,7 @@ -- | @successfulExit@ is supposed to be used in conjunction with 'waitForState'. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 successfulExit :: State -> Bool successfulExit state = stateStatus state == Exited && stateExitCode state == Just 0 @@ -866,7 +857,7 @@ -- | Waits for a specific http status code. -- This combinator should always be used with `waitUntilTimeout`. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 waitForHttp :: -- | Port Port -> @@ -883,7 +874,8 @@ retry :: (MonadIO m, MonadCatch m) => Manager -> m () retry manager = do - (endpointHost, endpointPort) <- containerAddress container port + let (endpointHost, endpointPort) = + containerAddress container port let request = defaultRequest { host = encodeUtf8 endpointHost, @@ -936,7 +928,8 @@ pure socket wait = do - (endpointHost, endpointPort) <- containerAddress container port + let (endpointHost, endpointPort) = + containerAddress container port result <- try (resolve (unpack endpointHost) endpointPort >>= open) case result of @@ -1104,7 +1097,7 @@ -- | Get the container's network alias. -- Takes the first alias found. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 containerAlias :: Container -> Text containerAlias Container {id, inspectOutput} = case inspectOutput @@ -1127,7 +1120,7 @@ -- | Get the IP address for the container's gateway, i.e. the host. -- Takes the first gateway address found. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 containerGateway :: Container -> Text containerGateway Container {id, inspectOutput} = case inspectOutput @@ -1181,14 +1174,13 @@ -- domain and port if the program is running in the same network. Otherwise, -- 'containerAddress' will use the exposed port on the Docker host. -- --- @since 0.4.0.0 -containerAddress :: (MonadIO m) => Container -> Port -> m (Text, Int) -containerAddress container Port {port, protocol} = do - inDocker <- isRunningInDocker - pure $ - if inDocker - then (containerAlias container, port) - else ("localhost", containerPort container (Port {port, protocol})) +-- @since 0.5.0.0 +containerAddress :: Container -> Port -> (Text, Int) +containerAddress container Port {port, protocol} = + let inDocker = unsafePerformIO isRunningInDocker + in if inDocker + then (containerAlias container, port) + else ("localhost", containerPort container (Port {port, protocol})) -- | Runs the `docker inspect` command. Memoizes the result. -- diff --git a/src/TestContainers/Docker/Internal.hs b/src/TestContainers/Docker/Internal.hs --- a/src/TestContainers/Docker/Internal.hs +++ b/src/TestContainers/Docker/Internal.hs @@ -42,7 +42,7 @@ -- | Identifies a network within the Docker runtime. Assigned by @docker network create@ -- --- @since 0.4.0.0 +-- @since 0.5.0.0 type NetworkId = Text -- | Identifies a container within the Docker runtime. Assigned by @docker run@. @@ -132,12 +132,12 @@ -- | An abstraction for forwarding logs. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 type LogConsumer = Pipe -> ByteString -> IO () -- | A simple 'LogConsumer' that writes log lines to stdout and stderr respectively. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 consoleLogConsumer :: LogConsumer consoleLogConsumer pipe line = do case pipe of @@ -150,7 +150,7 @@ -- | Forwards container logs to a 'LogConsumer'. This is equivalent of calling @docker logs containerId --follow@ -- --- @since 0.4.0.0 +-- @since 0.5.0.0 dockerFollowLogs :: (MonadResource m) => Tracer -> ContainerId -> LogConsumer -> m () dockerFollowLogs tracer containerId logConsumer = do let dockerArgs = diff --git a/src/TestContainers/Docker/Network.hs b/src/TestContainers/Docker/Network.hs --- a/src/TestContainers/Docker/Network.hs +++ b/src/TestContainers/Docker/Network.hs @@ -29,20 +29,20 @@ -- | Handle to a Docker network. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 newtype Network = Network { id :: NetworkId } -- | Returns the id of the network. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 networkId :: Network -> NetworkId networkId Network {id} = id -- | Parameters for creating a new Docker network. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 data NetworkRequest = NetworkRequest { ipv6 :: Bool, driver :: Maybe Text, @@ -51,7 +51,7 @@ -- | Default parameters for creating a new Docker network. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 networkRequest :: NetworkRequest networkRequest = NetworkRequest @@ -62,21 +62,21 @@ -- | Enable IPv6 for the Docker network. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 withIpv6 :: NetworkRequest -> NetworkRequest withIpv6 request = request {ipv6 = True} -- | Driver to manage the Network (default "bridge"). -- --- @since 0.4.0.0 +-- @since 0.5.0.0 withDriver :: Text -> NetworkRequest -> NetworkRequest withDriver driver request = request {driver = Just driver} -- | Creates a new 'Network' from a 'NetworkRequest'. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 createNetwork :: NetworkRequest -> TestContainer Network createNetwork NetworkRequest {..} = do Config {..} <- ask diff --git a/src/TestContainers/Docker/Reaper.hs b/src/TestContainers/Docker/Reaper.hs --- a/src/TestContainers/Docker/Reaper.hs +++ b/src/TestContainers/Docker/Reaper.hs @@ -24,7 +24,7 @@ -- | Reaper for safe resource cleanup. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 data Reaper = Reaper { -- | @runReaper label value@ reaps Docker any Docker resource with a matching -- label. @@ -37,33 +37,33 @@ -- | Additional labels to add to any Docker resource on creation. Adding the -- labels is necessary in order for the 'Reaper' to find resources for cleanup. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 reaperLabels :: Reaper -> [(Text, Text)] reaperLabels Reaper {labels} = labels -- | Ryuk based resource reaper -- --- @since 0.4.0.0 +-- @since 0.5.0.0 newtype Ryuk = Ryuk {ryukSocket :: Socket.Socket} -- | Tag for the ryuk image -- --- @since 0.4.0.0 +-- @since 0.5.0.0 ryukImageTag :: Text ryukImageTag = "docker.io/testcontainers/ryuk:0.3.4" -- | Exposed port for the ryuk reaper. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 ryukPort :: (Num a) => a ryukPort = 8080 -- | Creates a new 'Reaper' from a host and port. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 newRyukReaper :: (MonadResource m) => -- | Host diff --git a/src/TestContainers/Docker/State.hs b/src/TestContainers/Docker/State.hs --- a/src/TestContainers/Docker/State.hs +++ b/src/TestContainers/Docker/State.hs @@ -27,7 +27,7 @@ -- | An exception thrown in case the State object is invalid and couldn't be parsed. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 data StateInvalidException = StateInvalidException deriving stock (Eq, Show) @@ -35,7 +35,7 @@ -- | Status of a Docker container. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 data Status = Created | Running @@ -49,12 +49,12 @@ -- | State of a Docker container. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 newtype State = State Value -- | Extract the 'State' of a Docker container from an 'InspectOutput'. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 containerState :: InspectOutput -> State containerState inspectOutput = case inspectOutput ^? Optics.key "State" of @@ -63,7 +63,7 @@ -- | Returns the 'Status' of container. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 stateStatus :: State -> Status stateStatus (State value) = case value @@ -81,7 +81,7 @@ -- | Whether a container was killed by the OOM killer. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 stateOOMKilled :: State -> Bool stateOOMKilled (State value) = case value @@ -92,7 +92,7 @@ -- | -- --- @since 0.4.0.0 +-- @since 0.5.0.0 statePid :: State -> Maybe Int statePid (State value) = case value @@ -103,7 +103,7 @@ -- | -- --- @since 0.4.0.0 +-- @since 0.5.0.0 stateExitCode :: State -> Maybe Int stateExitCode (State value) = case value @@ -114,7 +114,7 @@ -- | -- --- @since 0.4.0.0 +-- @since 0.5.0.0 stateError :: State -> Maybe Text stateError (State value) = case value @@ -125,7 +125,7 @@ -- | -- --- @since 0.4.0.0 +-- @since 0.5.0.0 stateStartedAt :: State -> Maybe Text stateStartedAt (State value) = case value @@ -136,7 +136,7 @@ -- | -- --- @since 0.4.0.0 +-- @since 0.5.0.0 stateFinishedAt :: State -> Maybe Text stateFinishedAt (State value) = case value diff --git a/src/TestContainers/Monad.hs b/src/TestContainers/Monad.hs --- a/src/TestContainers/Monad.hs +++ b/src/TestContainers/Monad.hs @@ -39,7 +39,7 @@ -- | The heart and soul of the testcontainers library. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 newtype TestContainer a = TestContainer {unTestContainer :: ReaderT TestContainerEnv (ResourceT IO) a} deriving newtype ( Functor, @@ -78,7 +78,7 @@ -- | Run a 'TestContainer' action. Any container spun up during the computation are guaranteed -- to be shutdown and cleaned up once this function returns. -- --- @since 0.4.0.0 +-- @since 0.5.0.0 runTestContainer :: Config -> TestContainer a -> IO a runTestContainer config action = do -- Ensure through caching that there is only ever exactly @@ -106,7 +106,7 @@ ) ) --- | Docker related functionality is parameterized over this `Monad`. Since 0.4.0.0 this is +-- | Docker related functionality is parameterized over this `Monad`. Since 0.5.0.0 this is -- just a type alias for @m ~ 'TestContainer'@. -- -- @since 0.1.0.0 diff --git a/testcontainers.cabal b/testcontainers.cabal --- a/testcontainers.cabal +++ b/testcontainers.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: testcontainers -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Docker containers for your integration tests. description: testcontainers is a Haskell library that provides a friendly API to