git.iko.soy/docker-hs
on 201fe06 help sign in
docker-hs/src/Docker/Client.hs
118 lines 5.0 kB history raw
1{-# LANGUAGE ExplicitForAll #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4module Docker.Client (
5 runDockerT
6 , DockerT
7 , DockerError(..)
8 , DockerClientOpts(..)
9 , defaultClientOpts
10 , HttpHandler
11 , defaultHttpHandler
12 , httpHandler
13 , unixHttpHandler
14 , clientParamsWithClientAuthentication
15 , clientParamsSetCA
16 , getDockerVersion
17 , listContainers
18 , listImages
19 , createContainer
20 , startContainer
21 , stopContainer
22 , killContainer
23 , restartContainer
24 , pauseContainer
25 , unpauseContainer
26 , deleteContainer
27 , inspectContainer
28 , getContainerLogs
29 ) where
31import Control.Monad.Except (ExceptT (..), runExceptT, throwError)
32import Control.Monad.Reader (ask, lift)
33import Data.Aeson (FromJSON, eitherDecode')
34import qualified Data.ByteString.Lazy as BSL
35import qualified Data.Text as Text
36import Network.HTTP.Client (responseBody, responseStatus)
37import Network.HTTP.Types (StdMethod (..))
39import Docker.Client.Http
40import Docker.Client.Types
42requestUnit :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())
43requestUnit verb endpoint = const (Right ()) <$> requestHelper verb endpoint
45requestHelper :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError Response)
46requestHelper verb endpoint = runExceptT $ do
47 (opts, httpHandler) <- lift ask
48 case mkHttpRequest verb endpoint opts of
49 Nothing ->
50 throwError $ DockerInvalidRequest endpoint
51 Just request -> do
52 response <- ExceptT $ lift $ httpHandler request
54 -- Check status code.
55 let status = responseStatus response
56 maybe (return ()) throwError $
57 statusCodeToError endpoint status
59 return response
61parseResponse :: (FromJSON a, Monad m) => Either DockerError Response -> DockerT m (Either DockerError a)
62parseResponse (Left err) =
63 return $ Left err
64parseResponse (Right response) =
65 -- Parse request body.
66 case eitherDecode' $ responseBody response of
67 Left err ->
68 return $ Left $ DockerClientDecodeError $ Text.pack err
69 Right r ->
70 return $ Right r
72getDockerVersion :: forall m. Monad m => DockerT m (Either DockerError DockerVersion)
73getDockerVersion = requestHelper GET VersionEndpoint >>= parseResponse
75listContainers :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Container])
76listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseResponse
78listImages :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Image])
79listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
81createContainer :: forall m. Monad m => CreateOpts -> DockerT m (Either DockerError ContainerID)
82createContainer opts = requestHelper POST (CreateContainerEndpoint opts) >>= parseResponse
84-- TODO: Is this the correct return type? XXX
85-- convert status code to unit or error
86startContainer :: forall m. Monad m => StartOpts -> ContainerID -> DockerT m (Either DockerError ())
87startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid
89stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())
90stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid
92killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())
93killContainer s cid = requestUnit POST $ KillContainerEndpoint s cid
95restartContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())
96restartContainer t cid = requestUnit POST $ RestartContainerEndpoint t cid
98pauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())
99pauseContainer cid = requestUnit POST $ PauseContainerEndpoint cid
101unpauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())
102unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid
104deleteContainer :: forall m. Monad m => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())
105deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid
107inspectContainer :: forall m . Monad m => ContainerID -> DockerT m (Either DockerError ContainerDetails)
108inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= parseResponse
110getContainerLogs :: forall m. Monad m => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)
111getContainerLogs logopts cid = fmap responseBody <$> requestHelper GET (ContainerLogsEndpoint logopts False cid)
113-- TODO: Use http-conduit to output to a sink.
114-- getContainerLogsStream :: forall m. Monad m => Sink BSL.ByteString m b -> LogOpts -> ContainerID -> DockerT m (Either DockerError b)
115-- getContainerLogsStream sink logopts cid = runResourceT $ do
116-- response <- http request manager
117-- responseBody response C.$$+- sink