diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index aac3ef4..ba48d67 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -15,17 +15,15 @@ jobs: os: [ubuntu-latest] # [macOS-latest, windows-latest] do not come with docker :( cabal: ["3.6"] ghc: - - 8.8.4 - - 8.10.7 - - 9.0.2 - - 9.2.4 - - 9.4.2 + - 9.2.8 + - 9.4.8 + - 9.6.4 steps: - uses: actions/checkout@v2 if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2.6.1 id: setup-haskell-cabal name: Setup Haskell with: @@ -63,7 +61,7 @@ jobs: - uses: actions/checkout@v2 if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2.6.1 name: Setup Haskell Stack with: ghc-version: ${{ matrix.ghc }} diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index aea3008..b33fcfa 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -15,7 +15,7 @@ jobs: - name: Check code is formatted using Ormolu run: | - curl -L https://github.com/tweag/ormolu/releases/download/0.5.3.0/ormolu-Linux.zip -o ormolu.zip + curl -L https://github.com/tweag/ormolu/releases/download/0.7.2.0/ormolu-Linux.zip -o ormolu.zip unzip ormolu.zip git ls-files | grep \.hs | xargs ./ormolu --mode=inplace diff --git a/.gitignore b/.gitignore index c83ad81..c3bec36 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +.DS_Store dist dist-* cabal-dev diff --git a/src/TestContainers.hs b/src/TestContainers.hs index 52b5451..5677d9b 100644 --- a/src/TestContainers.hs +++ b/src/TestContainers.hs @@ -16,6 +16,7 @@ module TestContainers -- * @docker run@ parameters M.ContainerRequest, M.containerRequest, + M.withoutReaper, M.setName, M.setFixedName, M.setSuffixedName, diff --git a/src/TestContainers/Docker.hs b/src/TestContainers/Docker.hs index 3ae4c84..e7552bf 100644 --- a/src/TestContainers/Docker.hs +++ b/src/TestContainers/Docker.hs @@ -75,6 +75,7 @@ module TestContainers.Docker -- * Running containers ContainerRequest, containerRequest, + withoutReaper, withLabels, setName, setFixedName, @@ -220,6 +221,7 @@ import TestContainers.Docker.Internal InspectOutput, LogConsumer, Pipe (..), + WithoutReaper (..), consoleLogConsumer, docker, dockerFollowLogs, @@ -284,6 +286,9 @@ data ContainerRequest = ContainerRequest workDirectory :: Maybe Text } +instance WithoutReaper ContainerRequest where + withoutReaper request = request {noReaper = True} + -- | Parameters for a naming a Docker container. -- -- @since 0.5.0.0 @@ -1109,8 +1114,8 @@ internalContainerIp :: Container -> Text internalContainerIp Container {id, inspectOutput} = case inspectOutput ^? Optics.key "NetworkSettings" - % Optics.key "IPAddress" - % Optics._String of + % Optics.key "IPAddress" + % Optics._String of Nothing -> throw $ InspectOutputUnexpected {id} Just address -> diff --git a/src/TestContainers/Docker/Internal.hs b/src/TestContainers/Docker/Internal.hs index c414920..1ca2c59 100644 --- a/src/TestContainers/Docker/Internal.hs +++ b/src/TestContainers/Docker/Internal.hs @@ -21,6 +21,9 @@ module TestContainers.Docker.Internal LogConsumer, consoleLogConsumer, dockerFollowLogs, + + -- * Common abstractions for Docker resources + WithoutReaper (..), ) where @@ -40,6 +43,14 @@ import qualified System.IO import qualified System.Process as Process import TestContainers.Trace (Trace (..), Tracer, withTrace) +-- | Shared property between Docker resources. +class WithoutReaper request where + -- | Do not register the docker resource (container, register, etc.) with the resource reaper. + -- Careful, doing this will make your container leak on shutdown if not explicitly stopped. + -- + -- @since x.x.x + withoutReaper :: request -> request + -- | Identifies a network within the Docker runtime. Assigned by @docker network create@ -- -- @since 0.5.0.0 diff --git a/src/TestContainers/Docker/Network.hs b/src/TestContainers/Docker/Network.hs index 1c77b93..f92263b 100644 --- a/src/TestContainers/Docker/Network.hs +++ b/src/TestContainers/Docker/Network.hs @@ -16,6 +16,7 @@ module TestContainers.Docker.Network networkRequest, withDriver, withIpv6, + withoutReaper, ) where @@ -23,7 +24,7 @@ import Control.Monad (replicateM) import Control.Monad.Reader (ask) import Data.Text (Text, pack, strip) import qualified System.Random as Random -import TestContainers.Docker.Internal (NetworkId, docker) +import TestContainers.Docker.Internal (NetworkId, WithoutReaper (..), docker) import TestContainers.Docker.Reaper (reaperLabels) import TestContainers.Monad (Config (..), TestContainer) import Prelude hiding (id) @@ -47,9 +48,13 @@ networkId Network {id} = id data NetworkRequest = NetworkRequest { ipv6 :: Bool, driver :: Maybe Text, - labels :: [(Text, Text)] + labels :: [(Text, Text)], + noReaper :: Bool } +instance WithoutReaper NetworkRequest where + withoutReaper request = request {noReaper = True} + -- | Default parameters for creating a new Docker network. -- -- @since 0.5.0.0 @@ -58,7 +63,8 @@ networkRequest = NetworkRequest { ipv6 = False, driver = Nothing, - labels = [] + labels = [], + noReaper = False } -- | Enable IPv6 for the Docker network. @@ -100,7 +106,7 @@ createNetwork NetworkRequest {..} = do -- Creating the network with the reaper labels ensures cleanup -- at the end of the session let additionalLabels = - reaperLabels reaper + if noReaper then [] else reaperLabels reaper stdout <- docker configTracer $ diff --git a/src/TestContainers/Docker/Reaper.hs b/src/TestContainers/Docker/Reaper.hs index c19fd5d..faaf5c6 100644 --- a/src/TestContainers/Docker/Reaper.hs +++ b/src/TestContainers/Docker/Reaper.hs @@ -4,7 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} module TestContainers.Docker.Reaper - ( Reaper, + ( Reaper (..), reaperLabels, -- * Ryuk based reaper @@ -22,13 +22,19 @@ import qualified Network.Socket as Socket import qualified Network.Socket.ByteString as Socket import qualified System.Random as Random --- | Reaper for safe resource cleanup. +-- | Reaper for safe resource cleanup. This type is exposed to allow users to +-- create their own 'Reapers'. -- -- @since 0.5.0.0 data Reaper = Reaper - { -- | @runReaper label value@ reaps Docker any Docker resource with a matching - -- label. - runReaper :: Text -> Text -> IO (), + { -- | Registers a @label = value@ pair for reaping. Reaping happens when + -- closing/de-allocating of the 'Reaper' through 'MonadResource'. + register :: + -- \| Label + Text -> + -- \| Value + Text -> + IO (), -- | 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. labels :: [(Text, Text)] @@ -88,23 +94,32 @@ newRyukReaper host port = do (Socket.addrSocketType address) (Socket.addrProtocol address) Socket.connect socket (Socket.addrAddress address) - pure (socket, runRyuk sessionId (Ryuk socket)) + + -- Construct the reaper and regiter the session with it. + -- Doing it here intead of in the teardown (like we did before) + -- guarantees the Reaper knows about our session. + let reaper = + newReaper sessionId (Ryuk socket) + register reaper sessionIdLabel sessionId + + pure (socket, reaper) ) - ( \(socket, ryuk) -> do - runReaper ryuk sessionIdLabel sessionId + ( \(socket, _ryuk) -> do + -- Tearing down the connection lets Ryuk know it can reap the + -- running containers. Socket.close socket ) pure ryuk -runRyuk :: +newReaper :: -- | Session id Text -> Ryuk -> Reaper -runRyuk sessionId ryuk = +newReaper sessionId ryuk = Reaper - { runReaper = \label value -> do + { register = \label value -> do Socket.sendAll (ryukSocket ryuk) ("label=" <> encodeUtf8 label <> "=" <> encodeUtf8 value <> "\n") diff --git a/src/TestContainers/Docker/State.hs b/src/TestContainers/Docker/State.hs index a2b911a..30d2911 100644 --- a/src/TestContainers/Docker/State.hs +++ b/src/TestContainers/Docker/State.hs @@ -68,7 +68,7 @@ stateStatus :: State -> Status stateStatus (State value) = case value ^? Optics.key "Status" - % Optics._String of + % Optics._String of Just "created" -> Created Just "running" -> Running Just "paused" -> Paused @@ -86,7 +86,7 @@ stateOOMKilled :: State -> Bool stateOOMKilled (State value) = case value ^? Optics.key "OOMKilled" - % Optics._Bool of + % Optics._Bool of Just True -> True _ -> False @@ -97,7 +97,7 @@ statePid :: State -> Maybe Int statePid (State value) = case value ^? Optics.key "Pid" - % Optics._Integer of + % Optics._Integer of Just pid -> Just (fromIntegral pid) _ -> Nothing @@ -108,7 +108,7 @@ stateExitCode :: State -> Maybe Int stateExitCode (State value) = case value ^? Optics.key "ExitCode" - % Optics._Integer of + % Optics._Integer of Just exitCode -> Just (fromIntegral exitCode) _ -> Nothing @@ -119,7 +119,7 @@ stateError :: State -> Maybe Text stateError (State value) = case value ^? Optics.key "Error" - % Optics._String of + % Optics._String of Just err -> Just err _ -> Nothing @@ -130,7 +130,7 @@ stateStartedAt :: State -> Maybe Text stateStartedAt (State value) = case value ^? Optics.key "StartedAt" - % Optics._String of + % Optics._String of Just err -> Just err _ -> Nothing @@ -141,6 +141,6 @@ stateFinishedAt :: State -> Maybe Text stateFinishedAt (State value) = case value ^? Optics.key "FinishedAt" - % Optics._String of + % Optics._String of Just err -> Just err _ -> Nothing diff --git a/testcontainers.cabal b/testcontainers.cabal index 01dd6cc..5bba371 100644 --- a/testcontainers.cabal +++ b/testcontainers.cabal @@ -48,7 +48,7 @@ library , aeson-optics >=1.1 && <2 , async , base >=4.12 && <5 - , bytestring >=0.10.8 && <0.12 + , bytestring >=0.10.8 && <0.13 , directory >=1.3.6 && <2 , exceptions >=0.10.4 && <0.11 , http-client >=0.5.14 && <1 @@ -59,7 +59,7 @@ library , process >=1.6.5 && <1.7 , random >=1.2 && <2 , resourcet >=1.2.4 && <1.4 - , tasty >=1.0 && <1.5 + , tasty >=1.0 && <1.6 , text >=1.2.3 && <3 , unliftio-core >=0.1.0 && <0.3