[#50] Consider Docker host IP during port mapping resolution

src/TestContainers/Docker.hs

@@ -181,6 +181,7 @@ import Data.Aeson (decode')
 import qualified Data.Aeson.Optics as Optics
 import qualified Data.ByteString.Lazy.Char8 as LazyByteString
 import Data.Function ((&))
+import Data.IP (IP (..), fromSockAddr)
 import Data.List (find, stripPrefix)
 import Data.Maybe (fromMaybe)
 import Data.String (IsString (..))
@@ -203,6 +204,7 @@ import Network.HTTP.Client
   )
 import Network.HTTP.Types (statusCode)
 import qualified Network.Socket as Socket
+import Optics.AffineFold (filtered)
 import Optics.Fold (pre)
 import Optics.Operators ((^?))
 import Optics.Optic ((%), (<&>))
@@ -265,6 +267,7 @@ import TestContainers.Monad
     TestContainer,
   )
 import TestContainers.Trace (Trace (..), Tracer, newTracer, withTrace)
+import Text.Read (readMaybe)
 import Prelude hiding (error, id)
 import qualified Prelude
 
@@ -618,13 +621,20 @@ run request = do
   forM_ followLogs $
     dockerFollowLogs configTracer id
 
+  -- TODO: support non-localhost docker hosts
+  hostSockAddr <-
+    liftIO $
+      (Socket.addrAddress . head) <$> Socket.getAddrInfo (Just Socket.defaultHints) (Just "localhost") Nothing
+  let hostIp = maybe (Prelude.error "failed to deduce Docker host address") fst $ fromSockAddr hostSockAddr
+
   let container =
         Container
           { id,
             releaseKey,
             image,
             inspectOutput,
-            config
+            config,
+            hostIp
           }
 
   -- Last but not least, execute the WaitUntilReady checks
@@ -933,9 +943,13 @@ waitForHttp port path acceptableStatusCodes = WaitReady $ \container -> do
       retry manager = do
         let (endpointHost, endpointPort) =
               containerAddress container port
+            endpointHostText = case readMaybe $ unpack endpointHost of
+              -- Ugly, but http-client expects IPv6 address to be wrapped by '[]'
+              Just (IPv6 _) -> "[" <> endpointHost <> "]"
+              _ -> endpointHost
         let request =
               defaultRequest
-                { host = encodeUtf8 endpointHost,
+                { host = encodeUtf8 endpointHostText,
                   port = endpointPort,
                   path = encodeUtf8 (pack path)
                 }
@@ -988,7 +1002,6 @@ waitUntilMappedPortReachable port = WaitReady $ \container -> do
         wait = do
           let (endpointHost, endpointPort) =
                 containerAddress container port
-
           result <- try (resolve (unpack endpointHost) endpointPort >>= open)
           case result of
             Right socket -> do
@@ -1109,7 +1122,14 @@ data Container = Container
     -- | Configuration used to create and run this container.
     config :: Config,
     -- | Memoized output of `docker inspect`. This is being calculated lazily.
-    inspectOutput :: InspectOutput
+    inspectOutput :: InspectOutput,
+    -- | Docker host address running the container.
+    --
+    -- Currently stores 'head <$> getAddrInfo ... (Just "localhost") ...' result.
+    -- This addr is later used to deduce the correct port in port mapping.
+    -- Host IP is deduced at container creation time since helpers like 'containerAddress'
+    -- are pure and host is not going to change over time.
+    hostIp :: IP
   }
 
 -- | Returns the id of the container.
@@ -1175,6 +1195,27 @@ containerAlias Container {id, inspectOutput} =
     Just alias ->
       alias
 
+-- | Get the container's network IP address.
+-- Takes the IP address from the first network found.
+--
+-- @since x.x.x.x
+containerIPAddress :: Container -> IP
+containerIPAddress Container {id, inspectOutput} =
+  case inspectOutput
+    ^? pre
+      ( Optics.key "NetworkSettings"
+          % Optics.key "Networks"
+          % Optics.members
+          % Optics.key "IPAddress"
+          % Optics._String
+      ) of
+    Nothing ->
+      throw $
+        InspectOutputMissingNetwork
+          { id
+          }
+    Just ipRaw -> read $ unpack ipRaw
+
 -- | Get the IP address for the container's gateway, i.e. the host.
 -- Takes the first gateway address found.
 --
@@ -1201,20 +1242,30 @@ containerGateway Container {id, inspectOutput} =
 --
 -- @since 0.1.0.0
 containerPort :: Container -> Port -> Int
-containerPort Container {id, inspectOutput} Port {port, protocol} =
+containerPort Container {id, inspectOutput, hostIp} 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
+      -- check if the current 'HostIp' matches the hostIp
+      -- if 'HostIp' is '0.0.0.0' or '::', we need to check that we match protocol
+      -- otherwise, check that we match host address
+      matchAnyIPv4 = IPv4 $ read "0.0.0.0"
+      matchAnyIPv6 = IPv6 $ read "::"
+      matchHost v = fromMaybe False $ do
+        bindHostIp :: IP <- (read . unpack) <$> v ^? Optics.key "HostIp" % Optics._String
+        return $ case bindHostIp of
+          IPv4 _ | bindHostIp == matchAnyIPv4 -> True
+          IPv6 _ | bindHostIp == matchAnyIPv6 -> True
+          _ -> hostIp == bindHostIp
+   in case inspectOutput
         ^? pre
           ( Optics.key "NetworkSettings"
               % Optics.key "Ports"
               % Optics.key textPort
               % Optics.values
+              % filtered matchHost
               % Optics.key "HostPort"
               % Optics._String
           ) of
@@ -1237,8 +1288,8 @@ 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}))
+        then (pack $ show $ containerIPAddress container, port)
+        else (pack $ show $ hostIp container, containerPort container (Port {port, protocol}))
 
 -- | Runs the `docker inspect` command. Memoizes the result.
 --

testcontainers.cabal

@@ -53,6 +53,7 @@ library
     , exceptions     >=0.10.4  && <0.11
     , http-client    >=0.5.14  && <1
     , http-types     >=0.12.3  && <1
+    , iproute        >=1.7.0   && <1.8
     , mtl            >=2.2.2   && <3
     , network        >=2.8.0   && <3.2
     , optics-core    >=0.1     && <0.5