fixed port bindings for testcontainers

src/TestContainers.hs

@@ -36,6 +36,7 @@ module TestContainers
     M.withNetworkAlias,
     M.setLink,
     M.setExpose,
+    M.setPortBindings,
     M.setWaitingFor,
     M.withFollowLogs,
 

src/TestContainers/Docker.hs

@@ -94,6 +94,7 @@
     withNetworkAlias,
     setLink,
     setExpose,
+    setPortBindings,
     setWaitingFor,
     run,
 
@@ -279,6 +280,7 @@
     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 @@
       cmd = Nothing,
       env = [],
       exposedPorts = [],
+      portBindings = [],
       volumeMounts = [],
       network = Nothing,
       networkAlias = Nothing,
@@ -549,6 +552,24 @@
 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 @@
           cmd,
           env,
           exposedPorts,
+          portBindings,
           volumeMounts,
           network,
           networkAlias,
@@ -622,6 +644,7 @@
             ++ [["--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 @@
           { id,
             releaseKey,
             image,
-            inspectOutput,
-            config
+            config,
+            containerPortBindings = portBindings,
+            inspectOutput
           }
 
   -- Last but not least, execute the WaitUntilReady checks
@@ -1022,7 +1046,7 @@
 
     let resolve endpointHost endpointPort = do
           let hints = Socket.defaultHints {Socket.addrSocketType = Socket.Stream}
           head <$> Socket.getAddrInfo (Just hints) (Just endpointHost) (Just (show endpointPort))
 
         open addr = do
           socket <-
@@ -1165,6 +1189,8 @@
     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 @@
 --
 -- @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

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