fixed port bindings for testcontainers

Author: justinwoo

src/TestContainers.hs

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

src/TestContainers/Docker.hs

@@ -93,6 +93,7 @@ module TestContainers.Docker
     withNetworkAlias,
     setLink,
     setExpose,
+    setPortBindings,
     setWaitingFor,
     run,
 
@@ -276,6 +277,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,
@@ -313,6 +315,7 @@ containerRequest image =
       cmd = Nothing,
       env = [],
       exposedPorts = [],
+      portBindings = [],
       volumeMounts = [],
       network = Nothing,
       networkAlias = Nothing,
@@ -523,6 +526,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.
@@ -545,6 +566,7 @@ run request = do
           cmd,
           env,
           exposedPorts,
+          portBindings,
           volumeMounts,
           network,
           networkAlias,
@@ -587,6 +609,7 @@ run request = do
             ++ [["--label", label <> "=" <> value] | (label, value) <- additionalLabels ++ labels]
             ++ [["--env", variable <> "=" <> value] | (variable, value) <- env]
             ++ [["--publish", pack (show port) <> "/" <> protocol] | Port {port, protocol} <- exposedPorts]
+            ++ [["--publish", pack (show hostPort) <> ":" <> pack (show containerPort) <> "/" <> protocol] | (hostPort, Port {port = containerPort, protocol}) <- portBindings]
             ++ [["--network", networkName] | Just (Right networkName) <- [network]]
             ++ [["--network", networkId dockerNetwork] | Just (Left dockerNetwork) <- [network]]
             ++ [["--network-alias", alias] | Just alias <- [networkAlias]]
@@ -623,8 +646,9 @@ run request = do
           { id,
             releaseKey,
             image,
-            inspectOutput,
-            config
+            config,
+            containerPortBindings = portBindings,
+            inspectOutput
           }
 
   -- Last but not least, execute the WaitUntilReady checks
@@ -1108,6 +1132,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
   }
@@ -1201,31 +1227,35 @@ containerGateway Container {id, inspectOutput} =
 --
 -- @since 0.1.0.0
 containerPort :: Container -> Port -> Int
-containerPort Container {id, inspectOutput} 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 ->
-          throw $
-            UnknownPortMapping
-              { id,
-                port = textPort
-              }
-        Just hostPort ->
-          read (unpack hostPort)
+containerPort Container {id, inspectOutput, 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 ->
+              throw $
+                UnknownPortMapping
+                  { id,
+                    port = textPort
+                  }
+            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