Force no timeout for waitContainer API

denibertovic · Feb 23, 2022 · 015762a · 015762a
1 parent b5cd781
commit 015762a
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 2 deletions.
diff --git a/src/Docker/Client/Http.hs b/src/Docker/Client/Http.hs
@@ -21,7 +21,8 @@ import           Data.X509.File               (readKeyFile, readSignedObject)
 import           Network.HTTP.Client          (defaultManagerSettings,
                                                managerRawConnection, method,
                                                newManager, parseRequest,
-                                               requestBody, requestHeaders)
+                                               requestBody, requestHeaders,
+                                               responseTimeout)
 import qualified Network.HTTP.Client          as HTTP
 import           Network.HTTP.Client.Internal (makeConnection)
 import qualified Network.HTTP.Simple          as NHS
@@ -46,7 +47,8 @@ import qualified Network.Socket.ByteString    as SBS
 
 import           Docker.Client.Internal       (getEndpoint,
                                                getEndpointContentType,
-                                               getEndpointRequestBody)
+                                               getEndpointRequestBody,
+                                               getEndpointTimeout)
 import           Docker.Client.Types          (DockerClientOpts, Endpoint (..),
                                                apiVer, baseUrl)
 
@@ -101,6 +103,7 @@ mkHttpRequest verb e opts = request
               request' = case  initialR of
                             Just ir ->
                                 return $ ir {method = (encodeUtf8 . T.pack $ show verb),
+                                              responseTimeout = getEndpointTimeout e,
                                               requestHeaders = [("Content-Type", (getEndpointContentType e))]}
                             Nothing -> Nothing
               request = (\r -> maybe r (\body -> r {requestBody = body,  -- This will either be a HTTP.RequestBodyLBS  or HTTP.RequestBodySourceChunked for the build endpoint

diff --git a/src/Docker/Client/Internal.hs b/src/Docker/Client/Internal.hs
@@ -106,3 +106,6 @@ getEndpointContentType :: Endpoint -> BSC.ByteString
 getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
 getEndpointContentType _ = BSC.pack "application/json; charset=utf-8"
 
+getEndpointTimeout :: Endpoint -> HTTP.ResponseTimeout 
+getEndpointTimeout (WaitContainerEndpoint _) = HTTP.responseTimeoutNone
+getEndpointTimeout _ = HTTP.responseTimeoutDefault