{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Functions for sending HTTP requests to the Docker Engine API
module Docker.API.Client.Internal.Requests where

import Conduit (filterC, mapC)
import Control.Monad.Except
import Control.Monad.Trans.Resource (runResourceT)
import Data.Aeson (eitherDecode, encode)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Conduit (runConduit, (.|))
import Data.Conduit.Combinators (sinkFile, sinkNull, stdout)
import qualified Data.Conduit.Tar as Tar
import Data.Conduit.Zlib (ungzip)
import qualified Data.Text as T
import Docker.API.Client.Internal.Schemas (ContainerId, CreateContainer (..), CreateContainerResponse (..), WaitContainerResponse (..))
import Docker.API.Client.Internal.Types (ClientErrorMonad, ContainerLogType (..), ContainerSpec (image), DockerClientError (..))
import Docker.API.Client.Internal.Util (chownTarballContent, containerSpecToCreateContainer, createLogTypeFilter, parseMultiplexedDockerStream)
import Network.HTTP.Client
import qualified Network.HTTP.Conduit as HTTPC
import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.Status (Status, status200, status201, status204, statusCode, statusMessage)
import System.Posix.Types (GroupID, UserID)

-- | Docker Engine API version. This value will prefix all docker api url paths.
dockerAPIVersion :: String
dockerAPIVersion :: String
dockerAPIVersion = String
"v1.40"

-- | Helper function which formats the response of a failed HTTP request
formatRequestError :: Status -> LBS.ByteString -> String
formatRequestError :: Status -> ByteString -> String
formatRequestError Status
status ByteString
body =
  String
"Request failed with status "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Status -> Int
statusCode Status
status)
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Status -> ByteString
statusMessage Status
status)
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
body

-- | Similar to the `docker run` command. Runs a container in the background using the input HTTP connection manager, returning immediately.
-- To wait for the container to exit use `awaitContainer`.
-- Note that this currently always tries to pull the container's image.
runContainer ::
  -- | The connection manager for the docker daemon. You can `Docker.API.Client.newDefaultDockerManager` to get a default
  -- connection manager based on your operating system.
  Manager ->
  ContainerSpec ->
  ClientErrorMonad ContainerId
runContainer :: Manager -> ContainerSpec -> ClientErrorMonad String
runContainer Manager
manager ContainerSpec
spec =
  let payload :: CreateContainer
payload = ContainerSpec -> CreateContainer
containerSpecToCreateContainer ContainerSpec
spec
   in Manager -> Text -> ClientErrorMonad ()
pullImage Manager
manager (ContainerSpec -> Text
image ContainerSpec
spec) ClientErrorMonad ()
-> ExceptT DockerClientError IO ByteString
-> ExceptT DockerClientError IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Manager
-> CreateContainer -> ExceptT DockerClientError IO ByteString
submitCreateContainer Manager
manager CreateContainer
payload ExceptT DockerClientError IO ByteString
-> (ByteString -> ClientErrorMonad String)
-> ClientErrorMonad String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ClientErrorMonad String
parseCreateContainerResult ClientErrorMonad String
-> (String -> ClientErrorMonad String) -> ClientErrorMonad String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> String -> ClientErrorMonad String
startContainer Manager
manager

-- | Waits on a started container (e.g. via `runContainer`) until it exits, validating its exit code and returning an `DockerClientError` if
-- the container exited with an error. This will work for both actively running containers and those which have already exited.
awaitContainer ::
  -- | The connection manager for the docker daemon. You can `Docker.API.Client.newDefaultDockerManager` to get a default
  -- connection manager based on your operating system.
  Manager ->
  -- | The container id to await
  ContainerId ->
  ClientErrorMonad ()
awaitContainer :: Manager -> String -> ClientErrorMonad ()
awaitContainer Manager
manager String
cid = Manager -> String -> ExceptT DockerClientError IO ByteString
submitWaitContainer Manager
manager String
cid ExceptT DockerClientError IO ByteString
-> (ByteString
    -> ExceptT DockerClientError IO WaitContainerResponse)
-> ExceptT DockerClientError IO WaitContainerResponse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ExceptT DockerClientError IO WaitContainerResponse
parseWaitContainerResult ExceptT DockerClientError IO WaitContainerResponse
-> (WaitContainerResponse -> ClientErrorMonad ())
-> ClientErrorMonad ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WaitContainerResponse -> ClientErrorMonad ()
checkExitStatusCode

-- | Analagous to the `docker cp` command. Recursively copies contents at the specified path in the container to
-- the provided output path on the host, setting file permissions to the specified user and group id.  Note that the
-- container must have been started for this to succeed (i.e. it must have a running or finished state).  This method
-- uses conduit to optimize memory usage.
saveContainerArchive ::
  -- | The connection manager for the docker daemon
  Manager ->
  -- | The user id to use for output files and directories
  UserID ->
  -- | The group id to use for output files and directories
  GroupID ->
  -- | The path in the container to copy
  FilePath ->
  -- | The output path at which to write outputs
  FilePath ->
  ContainerId ->
  ClientErrorMonad ()
saveContainerArchive :: Manager
-> UserID
-> GroupID
-> String
-> String
-> String
-> ClientErrorMonad ()
saveContainerArchive Manager
manager UserID
uid GroupID
gid String
itemPath String
outPath String
cid = do
  let request :: Request
request =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString
"path", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
B.pack String
itemPath))] (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
          Request
defaultRequest
            { method :: ByteString
method = ByteString
"GET",
              path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/archive"
            }
  Maybe DockerClientError
result <- IO (Maybe DockerClientError)
-> ExceptT DockerClientError IO (Maybe DockerClientError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DockerClientError)
 -> ExceptT DockerClientError IO (Maybe DockerClientError))
-> IO (Maybe DockerClientError)
-> ExceptT DockerClientError IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$
    ResourceT IO (Maybe DockerClientError)
-> IO (Maybe DockerClientError)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Maybe DockerClientError)
 -> IO (Maybe DockerClientError))
-> ResourceT IO (Maybe DockerClientError)
-> IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$ do
      Response (ConduitM () ByteString (ResourceT IO) ())
response <- Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
HTTPC.http Request
request Manager
manager
      let body :: ConduitM () ByteString (ResourceT IO) ()
body = Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall body. Response body -> body
HTTPC.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
response
      let status :: Status
status = Response (ConduitM () ByteString (ResourceT IO) ()) -> Status
forall body. Response body -> Status
HTTPC.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
response
      -- Note: we're using a different approach than in the other http requests since the response
      -- is wrapped in a ResourceT when using http-conduit, and we would have to implement
      -- the conduit pipeline using ExceptT to make it compatible with that approach.
      if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200
        then do
          -- This operation may throw an unexpected exception. If we want to catch stuff like
          -- tar decoding errors we can switch to Tar.restoreFileIntoLenient
          ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) () -> ResourceT IO ())
-> ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) ()
body ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
ungzip ConduitT ByteString ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FileInfo -> ConduitM ByteString (IO ()) (ResourceT IO) ())
-> ConduitM ByteString (IO ()) (ResourceT IO) ()
forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
Tar.untar (String -> FileInfo -> ConduitM ByteString (IO ()) (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
String -> FileInfo -> ConduitM ByteString (IO ()) m ()
Tar.restoreFileInto String
outPath (FileInfo -> ConduitM ByteString (IO ()) (ResourceT IO) ())
-> (FileInfo -> FileInfo)
-> FileInfo
-> ConduitM ByteString (IO ()) (ResourceT IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserID -> GroupID -> FileInfo -> FileInfo
chownTarballContent UserID
uid GroupID
gid) ConduitM ByteString (IO ()) (ResourceT IO) ()
-> ConduitM (IO ()) Void (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (IO ()) Void (ResourceT IO) ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull
          Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DockerClientError
forall a. Maybe a
Nothing
        else Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError))
-> Maybe DockerClientError
-> ResourceT IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$ DockerClientError -> Maybe DockerClientError
forall a. a -> Maybe a
Just (DockerClientError -> Maybe DockerClientError)
-> DockerClientError -> Maybe DockerClientError
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
GetContainerArchiveError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
""
  case Maybe DockerClientError
result of
    Just DockerClientError
e -> DockerClientError -> ClientErrorMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DockerClientError
e
    Maybe DockerClientError
Nothing -> () -> ClientErrorMonad ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Pulls an image from a remote registry (similar to a `docker pull` command). This currently
-- only supports public registries (e.g. DockerHub).
pullImage ::
  -- | The connection manager for the docker daemon
  Manager ->
  -- | The image of interest. May include an optional tag or digest field. Note that
  -- in line with the Docker Engine API, this will pull **ALL** images in a repo if no tag
  -- or digest is specified.
  T.Text ->
  ClientErrorMonad ()
pullImage :: Manager -> Text -> ClientErrorMonad ()
pullImage Manager
manager Text
image = do
  let request :: Request
request =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString
"fromImage", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
image))] (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
          Request
defaultRequest
            { method :: ByteString
method = ByteString
"POST",
              path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/images/create"
            }
  Response ByteString
response <- IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ExceptT DockerClientError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  let result :: ClientErrorMonad ()
result
        | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200 = () -> ClientErrorMonad ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = DockerClientError -> ClientErrorMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ClientErrorMonad ())
-> DockerClientError -> ClientErrorMonad ()
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
ImagePullError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
body
        where
          body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response
          status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
  ClientErrorMonad ()
result

-- | Streams the logs from a docker container into the specified output file path. Logs can include
-- stdout, stderr, or both. Note that if you include both streams, the sorting of the timestamps in the output
-- file may not be perfectly sorted since the stream returned by the docker api is only sorted within each
-- stream type (i.e. stdout and stderr are sorted separately).
saveContainerLogs ::
  -- | The connection manager for the docker daemon
  Manager ->
  -- | Which logs to fetch from the container
  ContainerLogType ->
  -- | Output file at which to write logs
  FilePath ->
  ContainerId ->
  ClientErrorMonad ()
saveContainerLogs :: Manager
-> ContainerLogType -> String -> String -> ClientErrorMonad ()
saveContainerLogs Manager
manager ContainerLogType
logType String
outPath String
cid = do
  let request :: Request
request =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString
          [ (ByteString
"follow", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"false"),
            (ByteString
"stdout", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
stdout),
            (ByteString
"stderr", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
stderr),
            (ByteString
"timestamps", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"true")
          ]
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
defaultRequest
            { method :: ByteString
method = ByteString
"GET",
              path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/logs"
            }
        where
          stderr :: ByteString
stderr = case ContainerLogType
logType of
            ContainerLogType
Stdout -> ByteString
"false"
            ContainerLogType
_ -> ByteString
"true"
          stdout :: ByteString
stdout = case ContainerLogType
logType of
            ContainerLogType
StdErr -> ByteString
"false"
            ContainerLogType
_ -> ByteString
"true"
  Maybe DockerClientError
result <- IO (Maybe DockerClientError)
-> ExceptT DockerClientError IO (Maybe DockerClientError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DockerClientError)
 -> ExceptT DockerClientError IO (Maybe DockerClientError))
-> IO (Maybe DockerClientError)
-> ExceptT DockerClientError IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$
    ResourceT IO (Maybe DockerClientError)
-> IO (Maybe DockerClientError)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Maybe DockerClientError)
 -> IO (Maybe DockerClientError))
-> ResourceT IO (Maybe DockerClientError)
-> IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$ do
      Response (ConduitM () ByteString (ResourceT IO) ())
response <- Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
HTTPC.http Request
request Manager
manager
      let body :: ConduitM () ByteString (ResourceT IO) ()
body = Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall body. Response body -> body
HTTPC.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
response
      let status :: Status
status = Response (ConduitM () ByteString (ResourceT IO) ()) -> Status
forall body. Response body -> Status
HTTPC.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
response
      -- Note: we're using a different approach than in the other http requests since the response
      -- is wrapped in a ResourceT when using http-conduit, and we would have to implement
      -- the conduit pipeline using ExceptT to make it compatible with that approach.
      if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200
        then do
          let isLogType :: (DockerStreamType, a) -> Bool
isLogType = ContainerLogType -> (DockerStreamType, a) -> Bool
forall a. ContainerLogType -> (DockerStreamType, a) -> Bool
createLogTypeFilter ContainerLogType
logType
          ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) () -> ResourceT IO ())
-> ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) ()
body ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT
  ByteString (DockerStreamType, ByteString) (ResourceT IO) ()
forall (m :: * -> *).
MonadIO m =>
ConduitT ByteString (DockerStreamType, ByteString) m ()
parseMultiplexedDockerStream ConduitT
  ByteString (DockerStreamType, ByteString) (ResourceT IO) ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((DockerStreamType, ByteString) -> Bool)
-> ConduitT
     (DockerStreamType, ByteString)
     (DockerStreamType, ByteString)
     (ResourceT IO)
     ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
filterC (DockerStreamType, ByteString) -> Bool
forall a. (DockerStreamType, a) -> Bool
isLogType ConduitT
  (DockerStreamType, ByteString)
  (DockerStreamType, ByteString)
  (ResourceT IO)
  ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((DockerStreamType, ByteString) -> ByteString)
-> ConduitT
     (DockerStreamType, ByteString) ByteString (ResourceT IO) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (DockerStreamType, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ConduitT
  (DockerStreamType, ByteString) ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| String -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitT ByteString o m ()
sinkFile String
outPath
          Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DockerClientError
forall a. Maybe a
Nothing
        else Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError))
-> Maybe DockerClientError
-> ResourceT IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$ DockerClientError -> Maybe DockerClientError
forall a. a -> Maybe a
Just (DockerClientError -> Maybe DockerClientError)
-> DockerClientError -> Maybe DockerClientError
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
GetContainerLogsError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
""
  case Maybe DockerClientError
result of
    Just DockerClientError
e -> DockerClientError -> ClientErrorMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DockerClientError
e
    Maybe DockerClientError
Nothing -> () -> ClientErrorMonad ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Streams the logs from a docker container, printing them to stdout. Logs can include
-- stdout, stderr, or both.
printContainerLogs ::
  -- | The connection manager for the docker daemon
  Manager ->
  -- | Which logs to fetch from the container
  ContainerLogType ->
  ContainerId ->
  ClientErrorMonad ()
printContainerLogs :: Manager -> ContainerLogType -> String -> ClientErrorMonad ()
printContainerLogs Manager
manager ContainerLogType
logType String
cid = do
  let request :: Request
request =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString
          [ (ByteString
"follow", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"true"),
            (ByteString
"stdout", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
stdout),
            (ByteString
"stderr", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
stderr),
            (ByteString
"timestamps", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"true")
          ]
          (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
defaultRequest
            { method :: ByteString
method = ByteString
"GET",
              path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/logs"
            }
        where
          stderr :: ByteString
stderr = case ContainerLogType
logType of
            ContainerLogType
Stdout -> ByteString
"false"
            ContainerLogType
_ -> ByteString
"true"
          stdout :: ByteString
stdout = case ContainerLogType
logType of
            ContainerLogType
StdErr -> ByteString
"false"
            ContainerLogType
_ -> ByteString
"true"
  Maybe DockerClientError
result <- IO (Maybe DockerClientError)
-> ExceptT DockerClientError IO (Maybe DockerClientError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DockerClientError)
 -> ExceptT DockerClientError IO (Maybe DockerClientError))
-> IO (Maybe DockerClientError)
-> ExceptT DockerClientError IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$
    ResourceT IO (Maybe DockerClientError)
-> IO (Maybe DockerClientError)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Maybe DockerClientError)
 -> IO (Maybe DockerClientError))
-> ResourceT IO (Maybe DockerClientError)
-> IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$ do
      Response (ConduitM () ByteString (ResourceT IO) ())
response <- Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
HTTPC.http Request
request Manager
manager
      let body :: ConduitM () ByteString (ResourceT IO) ()
body = Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall body. Response body -> body
HTTPC.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
response
      let status :: Status
status = Response (ConduitM () ByteString (ResourceT IO) ()) -> Status
forall body. Response body -> Status
HTTPC.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
response
      -- Note: we're using a different approach than in the other http requests since the response
      -- is wrapped in a ResourceT when using http-conduit, and we would have to implement
      -- the conduit pipeline using ExceptT to make it compatible with that approach.
      if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200
        then do
          let isLogType :: (DockerStreamType, a) -> Bool
isLogType = ContainerLogType -> (DockerStreamType, a) -> Bool
forall a. ContainerLogType -> (DockerStreamType, a) -> Bool
createLogTypeFilter ContainerLogType
logType
          ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) () -> ResourceT IO ())
-> ConduitT () Void (ResourceT IO) () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString (ResourceT IO) ()
body ConduitM () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT
  ByteString (DockerStreamType, ByteString) (ResourceT IO) ()
forall (m :: * -> *).
MonadIO m =>
ConduitT ByteString (DockerStreamType, ByteString) m ()
parseMultiplexedDockerStream ConduitT
  ByteString (DockerStreamType, ByteString) (ResourceT IO) ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((DockerStreamType, ByteString) -> Bool)
-> ConduitT
     (DockerStreamType, ByteString)
     (DockerStreamType, ByteString)
     (ResourceT IO)
     ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
filterC (DockerStreamType, ByteString) -> Bool
forall a. (DockerStreamType, a) -> Bool
isLogType ConduitT
  (DockerStreamType, ByteString)
  (DockerStreamType, ByteString)
  (ResourceT IO)
  ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((DockerStreamType, ByteString) -> ByteString)
-> ConduitT
     (DockerStreamType, ByteString) ByteString (ResourceT IO) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (DockerStreamType, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ConduitT
  (DockerStreamType, ByteString) ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM (DockerStreamType, ByteString) Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o. MonadIO m => ConduitT ByteString o m ()
stdout
          Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DockerClientError
forall a. Maybe a
Nothing
        else Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DockerClientError -> ResourceT IO (Maybe DockerClientError))
-> Maybe DockerClientError
-> ResourceT IO (Maybe DockerClientError)
forall a b. (a -> b) -> a -> b
$ DockerClientError -> Maybe DockerClientError
forall a. a -> Maybe a
Just (DockerClientError -> Maybe DockerClientError)
-> DockerClientError -> Maybe DockerClientError
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
GetContainerLogsError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
""
  case Maybe DockerClientError
result of
    Just DockerClientError
e -> DockerClientError -> ClientErrorMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DockerClientError
e
    Maybe DockerClientError
Nothing -> () -> ClientErrorMonad ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Attempts to create a docker container, returning the new container's id
submitCreateContainer :: Manager -> CreateContainer -> ClientErrorMonad LBS.ByteString
submitCreateContainer :: Manager
-> CreateContainer -> ExceptT DockerClientError IO ByteString
submitCreateContainer Manager
manager CreateContainer
object = do
  let reqBody :: RequestBody
reqBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ CreateContainer -> ByteString
forall a. ToJSON a => a -> ByteString
encode CreateContainer
object
  let request :: Request
request =
        Request
defaultRequest
          { method :: ByteString
method = ByteString
"POST",
            path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/create",
            requestBody :: RequestBody
requestBody = RequestBody
reqBody,
            requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
hContentType, ByteString
"application/json")]
          }
  Response ByteString
response <- IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ExceptT DockerClientError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  let result :: ExceptT DockerClientError IO ByteString
result
        -- In the ExceptT world, return is used where you would use Right
        | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status201 = ByteString -> ExceptT DockerClientError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
body
        -- And throwError is used where you would use Left
        | Bool
otherwise = DockerClientError -> ExceptT DockerClientError IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ExceptT DockerClientError IO ByteString)
-> DockerClientError -> ExceptT DockerClientError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
ContainerCreationFailedError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
body
        where
          body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response
          status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
  ExceptT DockerClientError IO ByteString
result

startContainer :: Manager -> ContainerId -> ClientErrorMonad ContainerId
startContainer :: Manager -> String -> ClientErrorMonad String
startContainer Manager
manager String
cid = do
  let request :: Request
request =
        Request
defaultRequest
          { method :: ByteString
method = ByteString
"POST",
            path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/start"
          }
  Response ByteString
response <- IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ExceptT DockerClientError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  let result :: ClientErrorMonad String
result
        -- In the ExceptT world, return is used where you would use Right
        | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status204 = String -> ClientErrorMonad String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cid
        -- And throwError is used where you would use Left
        | Bool
otherwise = DockerClientError -> ClientErrorMonad String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ClientErrorMonad String)
-> DockerClientError -> ClientErrorMonad String
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
ContainerCreationFailedError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
body
        where
          body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response
          status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
  ClientErrorMonad String
result

submitWaitContainer :: Manager -> ContainerId -> ClientErrorMonad LBS.ByteString
submitWaitContainer :: Manager -> String -> ExceptT DockerClientError IO ByteString
submitWaitContainer Manager
manager String
cid = do
  let request :: Request
request =
        Request
defaultRequest
          { method :: ByteString
method = ByteString
"POST",
            path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/wait"
          }
  Response ByteString
response <- IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ExceptT DockerClientError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  let result :: ExceptT DockerClientError IO ByteString
result
        -- In the ExceptT world, return is used where you would use Right
        | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200 = ByteString -> ExceptT DockerClientError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT DockerClientError IO ByteString)
-> ByteString -> ExceptT DockerClientError IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response
        -- And throwError is used where you would use Left
        | Bool
otherwise = DockerClientError -> ExceptT DockerClientError IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ExceptT DockerClientError IO ByteString)
-> DockerClientError -> ExceptT DockerClientError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
ContainerCreationFailedError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
body
        where
          body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response
          status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
  ExceptT DockerClientError IO ByteString
result

-- | Remove a container, equivalent to the `docker container rm` command
removeContainer ::
  -- | The connection manager for the docker daemon
  Manager ->
  -- | Enable force removal?
  Bool ->
  -- | Also remove container's volumes?
  Bool ->
  ContainerId ->
  ClientErrorMonad ContainerId
removeContainer :: Manager -> Bool -> Bool -> String -> ClientErrorMonad String
removeContainer Manager
manager Bool
isForceful Bool
alsoRemoveVolumes String
cid = do
  let request :: Request
request =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString
"force", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
force), (ByteString
"v", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v)] (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
          Request
defaultRequest
            { method :: ByteString
method = ByteString
"DELETE",
              path :: ByteString
path = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dockerAPIVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/containers/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cid
            }
        where
          force :: ByteString
force = if Bool
isForceful then ByteString
"true" else ByteString
"false"
          v :: ByteString
v = if Bool
alsoRemoveVolumes then ByteString
"true" else ByteString
"false"
  Response ByteString
response <- IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
 -> ExceptT DockerClientError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT DockerClientError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  let result :: ClientErrorMonad String
result
        | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status204 = String -> ClientErrorMonad String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cid
        | Bool
otherwise = DockerClientError -> ClientErrorMonad String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ClientErrorMonad String)
-> DockerClientError -> ClientErrorMonad String
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
ContainerCreationFailedError (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ Status -> ByteString -> String
formatRequestError Status
status ByteString
body
        where
          body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response
          status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
  ClientErrorMonad String
result

-- | Parses the response body of a create container request
parseCreateContainerResult :: LBS.ByteString -> ClientErrorMonad ContainerId
parseCreateContainerResult :: ByteString -> ClientErrorMonad String
parseCreateContainerResult ByteString
body = case ByteString -> Either String CreateContainerResponse
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
  Left String
msg -> DockerClientError -> ClientErrorMonad String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ClientErrorMonad String)
-> DockerClientError -> ClientErrorMonad String
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
UnrecognizedJSONResponseError String
msg
  Right CreateContainerResponse
object -> String -> ClientErrorMonad String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ClientErrorMonad String)
-> String -> ClientErrorMonad String
forall a b. (a -> b) -> a -> b
$ CreateContainerResponse -> String
createContainerResponseId CreateContainerResponse
object

-- | Parses the response body of an await container request
parseWaitContainerResult :: LBS.ByteString -> ClientErrorMonad WaitContainerResponse
parseWaitContainerResult :: ByteString -> ExceptT DockerClientError IO WaitContainerResponse
parseWaitContainerResult ByteString
body = case ByteString -> Either String WaitContainerResponse
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
  Left String
msg -> DockerClientError
-> ExceptT DockerClientError IO WaitContainerResponse
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError
 -> ExceptT DockerClientError IO WaitContainerResponse)
-> DockerClientError
-> ExceptT DockerClientError IO WaitContainerResponse
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
UnrecognizedJSONResponseError String
msg
  Right WaitContainerResponse
object -> WaitContainerResponse
-> ExceptT DockerClientError IO WaitContainerResponse
forall (m :: * -> *) a. Monad m => a -> m a
return WaitContainerResponse
object

-- | Checks the status code value of a WaitContainerResponse
checkExitStatusCode :: WaitContainerResponse -> ClientErrorMonad ()
checkExitStatusCode :: WaitContainerResponse -> ClientErrorMonad ()
checkExitStatusCode WaitContainerResponse
response = do
  if Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then () -> ClientErrorMonad ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else case WaitContainerResponse -> Maybe WaitContainerError
waitContainerResponseError WaitContainerResponse
response of
      -- Docker will only sometimes return the associated errors
      Just WaitContainerError
err -> DockerClientError -> ClientErrorMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ClientErrorMonad ())
-> DockerClientError -> ClientErrorMonad ()
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
NonZeroExitCode (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ WaitContainerError -> String
forall a. Show a => a -> String
show WaitContainerError
err
      Maybe WaitContainerError
Nothing -> DockerClientError -> ClientErrorMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DockerClientError -> ClientErrorMonad ())
-> DockerClientError -> ClientErrorMonad ()
forall a b. (a -> b) -> a -> b
$ String -> DockerClientError
NonZeroExitCode (String -> DockerClientError) -> String -> DockerClientError
forall a b. (a -> b) -> a -> b
$ String
"Container status code was " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with no error message"
  where
    code :: Int
code = WaitContainerResponse -> Int
waitContainerResponseStatusCode WaitContainerResponse
response