From b36fb18d6d448379e59d670297ca5a2ffead09a9 Mon Sep 17 00:00:00 2001
From: Roman Melnikov <roman.melnikov@serokell.io>
Date: Mon, 22 Apr 2024 11:44:33 +0200
Subject: [PATCH] fixup! [#50] Consider Docker host IP during port mapping
 resolution

---
 src/TestContainers/Docker.hs        | 15 ++++++++-------
 src/TestContainers/Docker/Reaper.hs |  7 +++----
 src/TestContainers/Trace.hs         |  5 ++---
 3 files changed, 13 insertions(+), 14 deletions(-)

diff --git a/src/TestContainers/Docker.hs b/src/TestContainers/Docker.hs
index f3980ab..03e57de 100644
--- a/src/TestContainers/Docker.hs
+++ b/src/TestContainers/Docker.hs
@@ -267,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
 
@@ -942,10 +943,10 @@ waitForHttp port path acceptableStatusCodes = WaitReady $ \container -> do
       retry manager = do
         let (endpointHost, endpointPort) =
               containerAddress container port
-            endpointHostText = pack $ case endpointHost of
-              IPv4 addr -> show addr
+            endpointHostText = case readMaybe $ unpack endpointHost of
               -- Ugly, but http-client expects IPv6 address to be wrapped by '[]'
-              IPv6 addr -> "[" <> show addr <> "]"
+              Just (IPv6 _) -> "[" <> endpointHost <> "]"
+              _ -> endpointHost
         let request =
               defaultRequest
                 { host = encodeUtf8 endpointHostText,
@@ -1001,7 +1002,7 @@ waitUntilMappedPortReachable port = WaitReady $ \container -> do
         wait = do
           let (endpointHost, endpointPort) =
                 containerAddress container port
-          result <- try (resolve (show endpointHost) endpointPort >>= open)
+          result <- try (resolve (unpack endpointHost) endpointPort >>= open)
           case result of
             Right socket -> do
               withTrace configTracer (TraceOpenSocket endpointHost endpointPort Nothing)
@@ -1283,12 +1284,12 @@ containerPort Container {id, inspectOutput, hostIp} Port {port, protocol} =
 -- 'containerAddress' will use the exposed port on the Docker host.
 --
 -- @since 0.5.0.0
-containerAddress :: Container -> Port -> (IP, Int)
+containerAddress :: Container -> Port -> (Text, Int)
 containerAddress container Port {port, protocol} =
   let inDocker = unsafePerformIO isRunningInDocker
    in if inDocker
-        then (containerIPAddress container, port)
-        else (hostIp container, 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.
 --
diff --git a/src/TestContainers/Docker/Reaper.hs b/src/TestContainers/Docker/Reaper.hs
index bed4da3..faaf5c6 100644
--- a/src/TestContainers/Docker/Reaper.hs
+++ b/src/TestContainers/Docker/Reaper.hs
@@ -16,8 +16,7 @@ where
 
 import Control.Monad (replicateM)
 import Control.Monad.Trans.Resource (MonadResource, allocate)
-import Data.IP (IP)
-import Data.Text (Text, pack)
+import Data.Text (Text, pack, unpack)
 import Data.Text.Encoding (encodeUtf8)
 import qualified Network.Socket as Socket
 import qualified Network.Socket.ByteString as Socket
@@ -74,7 +73,7 @@ ryukPort =
 newRyukReaper ::
   (MonadResource m) =>
   -- | Host
-  IP ->
+  Text ->
   -- | Port
   Int ->
   m Reaper
@@ -88,7 +87,7 @@ newRyukReaper host port = do
           let hints =
                 Socket.defaultHints {Socket.addrSocketType = Socket.Stream}
           address <-
-            head <$> Socket.getAddrInfo (Just hints) (Just (show host)) (Just (show port))
+            head <$> Socket.getAddrInfo (Just hints) (Just (unpack host)) (Just (show port))
           socket <-
             Socket.socket
               (Socket.addrFamily address)
diff --git a/src/TestContainers/Trace.hs b/src/TestContainers/Trace.hs
index 61f8bdb..01cb3c8 100644
--- a/src/TestContainers/Trace.hs
+++ b/src/TestContainers/Trace.hs
@@ -14,7 +14,6 @@ where
 
 import Control.Exception (IOException)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.IP (IP)
 import Data.Text (Text)
 import System.Exit (ExitCode)
 
@@ -36,9 +35,9 @@ data Trace
     -- timeout to wait (in seconds).
     TraceWaitUntilReady (Maybe Int)
   | -- | Opening socket
-    TraceOpenSocket IP Int (Maybe IOException)
+    TraceOpenSocket Text Int (Maybe IOException)
   | -- | Call HTTP endpoint
-    TraceHttpCall IP Int (Either String Int)
+    TraceHttpCall Text Int (Either String Int)
   deriving stock (Eq, Show)
 
 -- | Traces execution within testcontainers library.