module Docker.Client.Api (
listContainers
, createContainer
, startContainer
, stopContainer
, waitContainer
, killContainer
, restartContainer
, pauseContainer
, unpauseContainer
, deleteContainer
, inspectContainer
, getContainerLogs
, getContainerLogsStream
, listImages
, buildImageFromDockerfile
, pullImage
, getDockerVersion
) where
import Control.Monad.Catch (MonadMask (..))
import Control.Monad.IO.Class
import Control.Monad.Reader (ask, lift)
import Data.Aeson (FromJSON, eitherDecode')
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Conduit (Sink)
import qualified Data.Conduit.Binary as Conduit
import qualified Data.Text as T
import qualified Data.Text as Text
import Network.HTTP.Client (responseStatus)
import Network.HTTP.Types (StdMethod (..))
import System.Exit (ExitCode (..))
import Docker.Client.Http
import Docker.Client.Types
import Docker.Client.Utils
requestUnit :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())
requestUnit verb endpoint = fmap (const ()) <$> requestHelper verb endpoint
requestHelper :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError BSL.ByteString)
requestHelper verb endpoint = requestHelper' verb endpoint Conduit.sinkLbs
requestHelper' :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> Sink BS.ByteString m a -> DockerT m (Either DockerError a)
requestHelper' verb endpoint sink = do
(opts, HttpHandler httpHandler) <- ask
case mkHttpRequest verb endpoint opts of
Nothing ->
return $ Left $ DockerInvalidRequest endpoint
Just request -> do
lift $ httpHandler request $ \response ->
let status = responseStatus response in
case statusCodeToError endpoint status of
Just err ->
return $ Left err
Nothing ->
fmap Right sink
parseResponse :: (FromJSON a, Monad m) => Either DockerError BSL.ByteString -> DockerT m (Either DockerError a)
parseResponse (Left err) =
return $ Left err
parseResponse (Right response) =
case eitherDecode' response of
Left err ->
return $ Left $ DockerClientDecodeError $ Text.pack err
Right r ->
return $ Right r
getDockerVersion :: forall m. (MonadIO m, MonadMask m) => DockerT m (Either DockerError DockerVersion)
getDockerVersion = requestHelper GET VersionEndpoint >>= parseResponse
listContainers :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Container])
listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseResponse
listImages :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Image])
listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
createContainer :: forall m. (MonadIO m, MonadMask m) => CreateOpts -> Maybe ContainerName -> DockerT m (Either DockerError ContainerID)
createContainer opts cn = requestHelper POST (CreateContainerEndpoint opts cn) >>= parseResponse
startContainer :: forall m. (MonadIO m, MonadMask m) => StartOpts -> ContainerID -> DockerT m (Either DockerError ())
startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid
stopContainer :: forall m. (MonadIO m, MonadMask m) => Timeout -> ContainerID -> DockerT m (Either DockerError ())
stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid
waitContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ExitCode)
waitContainer cid = fmap (fmap statusCodeToExitCode) (requestHelper POST (WaitContainerEndpoint cid) >>= parseResponse)
where
statusCodeToExitCode (StatusCode 0) = ExitSuccess
statusCodeToExitCode (StatusCode x) = ExitFailure x
killContainer :: forall m. (MonadIO m, MonadMask m) => Signal -> ContainerID -> DockerT m (Either DockerError ())
killContainer s cid = requestUnit POST $ KillContainerEndpoint s cid
restartContainer :: forall m. (MonadIO m, MonadMask m) => Timeout -> ContainerID -> DockerT m (Either DockerError ())
restartContainer t cid = requestUnit POST $ RestartContainerEndpoint t cid
pauseContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ())
pauseContainer cid = requestUnit POST $ PauseContainerEndpoint cid
unpauseContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ())
unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid
deleteContainer :: forall m. (MonadIO m, MonadMask m) => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())
deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid
inspectContainer :: forall m . (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ContainerDetails)
inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= parseResponse
getContainerLogs :: forall m. (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)
getContainerLogs logopts cid = requestHelper GET (ContainerLogsEndpoint logopts False cid)
getContainerLogsStream :: forall m b . (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)
getContainerLogsStream logopts cid = requestHelper' GET (ContainerLogsEndpoint logopts True cid)
buildImageFromDockerfile :: forall m. (MonadIO m, MonadMask m) => BuildOpts -> FilePath -> DockerT m (Either DockerError ())
buildImageFromDockerfile opts base = do
ctx <- makeBuildContext $ BuildContextRootDir base
case ctx of
Left e -> return $ Left e
Right c -> requestUnit POST (BuildImageEndpoint opts c)
pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)
pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing)