From 53c6854045e038a9fe138b6e9f36af5f5036e301 Mon Sep 17 00:00:00 2001 From: justinwoo Date: Tue, 18 Nov 2025 11:16:14 +0000 Subject: [PATCH] fixed port bindings for testcontainers --- src/TestContainers.hs | 1 + src/TestContainers/Docker.hs | 89 +++++++++++++++++++++----------- test/TestContainers/HspecSpec.hs | 22 +++++++- 3 files changed, 80 insertions(+), 32 deletions(-) diff --git a/src/TestContainers.hs b/src/TestContainers.hs index 0523200..5924613 100644 --- a/src/TestContainers.hs +++ b/src/TestContainers.hs @@ -36,6 +36,7 @@ module TestContainers M.withNetworkAlias, M.setLink, M.setExpose, + M.setPortBindings, M.setWaitingFor, M.withFollowLogs, diff --git a/src/TestContainers/Docker.hs b/src/TestContainers/Docker.hs index b20eb2b..703c7e0 100644 --- a/src/TestContainers/Docker.hs +++ b/src/TestContainers/Docker.hs @@ -94,6 +94,7 @@ module TestContainers.Docker withNetworkAlias, setLink, setExpose, + setPortBindings, setWaitingFor, run, @@ -279,6 +280,7 @@ data ContainerRequest = ContainerRequest cmd :: Maybe [Text], env :: [(Text, Text)], exposedPorts :: [Port], + portBindings :: [(Int, Port)], volumeMounts :: [(Text, Text)], network :: Maybe (Either Network Text), networkAlias :: Maybe Text, @@ -317,6 +319,7 @@ containerRequest image = cmd = Nothing, env = [], exposedPorts = [], + portBindings = [], volumeMounts = [], network = Nothing, networkAlias = Nothing, @@ -549,6 +552,24 @@ setExpose :: [Port] -> ContainerRequest -> ContainerRequest setExpose newExpose req = req {exposedPorts = newExpose} +-- | Set fixed port bindings on the container. This is equivalent to setting +-- @--publish HOST_PORT:CONTAINER_PORT@ for each binding. If a host port is +-- already in use, Docker will fail to start the container. +-- +-- Example: +-- +-- @ +-- container <- `run` $ `containerRequest` postgres +-- & `setPortBindings` [(5432, 5432), (5433, 5433)] +-- @ +-- +-- This will fail if port 5432 or 5433 is already bound on the host. +-- +-- @since 0.5.1.0 +setPortBindings :: [(Int, Port)] -> ContainerRequest -> ContainerRequest +setPortBindings bindings req = + req {portBindings = bindings} + -- | 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. @@ -571,6 +592,7 @@ run request = do cmd, env, exposedPorts, + portBindings, volumeMounts, network, networkAlias, @@ -622,6 +644,7 @@ run request = do ++ [["--network", networkId dockerNetwork] | Just (Left dockerNetwork) <- [network]] ++ [["--network-alias", alias] | Just alias <- [networkAlias]] ++ [["--publish", pack (show port) <> "/" <> protocol] | Port {port, protocol} <- exposedPorts] + ++ [["--publish", pack (show hostPort) <> ":" <> pack (show containerPort) <> "/" <> protocol] | (hostPort, Port {port = containerPort, protocol}) <- portBindings] ++ [["--rm"] | rmOnExit] ++ [["--volume", src <> ":" <> dest] | (src, dest) <- volumeMounts] ++ [["--workdir", workdir] | Just workdir <- [workDirectory]] @@ -658,8 +681,9 @@ run request = do { id, releaseKey, image, - inspectOutput, - config + config, + containerPortBindings = portBindings, + inspectOutput } -- Last but not least, execute the WaitUntilReady checks @@ -1165,6 +1189,8 @@ data Container = Container image :: Image, -- | Configuration used to create and run this container. config :: Config, + -- | Fixed port bindings specified in the ContainerRequest. + containerPortBindings :: [(Int, Port)], -- | Memoized output of `docker inspect`. This is being calculated lazily. inspectOutput :: InspectOutput } @@ -1270,34 +1296,37 @@ containerGateway Container {id, inspectOutput, image} = -- -- @since 0.1.0.0 containerPort :: Container -> Port -> Int -containerPort Container {id, inspectOutput, image} Port {port, protocol} = - let -- TODO also support UDP ports - -- Using IsString so it works both with Text (aeson<2) and Aeson.Key (aeson>=2) - textPort :: (IsString s) => s - textPort = fromString $ show port <> "/" <> unpack protocol - in -- TODO be more mindful, make sure to grab the - -- port from the right host address - - case inspectOutput - ^? pre - ( Optics.key "NetworkSettings" - % Optics.key "Ports" - % Optics.key textPort - % Optics.values - % Optics.key "HostPort" - % Optics._String - ) of - Nothing -> - let containerName = inspectOutput ^? Optics.key "Name" % Optics._String - in throw $ - UnknownPortMapping - { id, - port = textPort, - imageName = Just (imageTag image), - containerName = containerName - } - Just hostPort -> - read (unpack hostPort) +containerPort Container {id, inspectOutput, image, containerPortBindings} requestedPort@(Port {port, protocol}) = + -- First check if there's a fixed binding for this port + case find (\(_, boundPort) -> boundPort == requestedPort) containerPortBindings of + Just (hostPort, _) -> hostPort + Nothing -> + let -- TODO also support UDP ports + -- Using IsString so it works both with Text (aeson<2) and Aeson.Key (aeson>=2) + textPort :: (IsString s) => s + textPort = fromString $ show port <> "/" <> unpack protocol + in -- TODO be more mindful, make sure to grab the + -- port from the right host address + case inspectOutput + ^? pre + ( Optics.key "NetworkSettings" + % Optics.key "Ports" + % Optics.key textPort + % Optics.values + % Optics.key "HostPort" + % Optics._String + ) of + Nothing -> + let containerName = inspectOutput ^? Optics.key "Name" % Optics._String + in throw $ + UnknownPortMapping + { id, + port = textPort, + imageName = Just (imageTag image), + containerName = containerName + } + Just hostPort -> + read (unpack hostPort) -- | Returns the domain and port exposing the given container's port. Differs -- from 'containerPort' in that 'containerAddress' will return the container's diff --git a/test/TestContainers/HspecSpec.hs b/test/TestContainers/HspecSpec.hs index 2bfda6b..c65e792 100644 --- a/test/TestContainers/HspecSpec.hs +++ b/test/TestContainers/HspecSpec.hs @@ -11,7 +11,9 @@ import TestContainers.Hspec containerRequest, redis, run, + setPortBindings, withContainers, + (&), ) data ContainerPorts = ContainerPorts @@ -26,12 +28,28 @@ containers1 = do { redisPort = containerPort redisContainer "6379/tcp" } +containers2 :: TestContainer ContainerPorts +containers2 = do + redisContainer <- + run $ + containerRequest redis + & setPortBindings [(16379, "6379/tcp")] + pure + ContainerPorts + { redisPort = containerPort redisContainer "6379/tcp" + } + main :: IO () main = hspec spec_all spec_all :: Spec -spec_all = +spec_all = do around (withContainers containers1) $ - describe "TestContainers tests" $ + describe "TestContainers tests with random ports" $ it "test1" $ \ContainerPorts {} -> shouldBe () () + + around (withContainers containers2) $ + describe "TestContainers tests with fixed port bindings" $ do + it "should use the fixed host port" $ \ContainerPorts {..} -> + redisPort `shouldBe` 16379