@@ -2,117 +2,12 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33
44module 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
5+ module Docker.Client.Api
6+ , module Docker.Client.Types
7+ , module Docker.Client.Http
298 ) where
309
31−import Control.Monad.Except (ExceptT (..), runExceptT, throwError)
32−import Control.Monad.Reader (ask, lift)
33−import Data.Aeson (FromJSON, eitherDecode')
34−import qualified Data.ByteString.Lazy as BSL
35−import qualified Data.Text as Text
36−import Network.HTTP.Client (responseBody, responseStatus)
37−import Network.HTTP.Types (StdMethod (..))
38−
10+import Docker.Client.Api
3911import Docker.Client.Http
4012import Docker.Client.Types
4113
42−requestUnit :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())
43−requestUnit verb endpoint = const (Right ()) <$> requestHelper verb endpoint
44−
45−requestHelper :: (Monad m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError Response)
46−requestHelper 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
53−
54− -- Check status code.
55− let status = responseStatus response
56− maybe (return ()) throwError $
57− statusCodeToError endpoint status
58−
59− return response
60−
61−parseResponse :: (FromJSON a, Monad m) => Either DockerError Response -> DockerT m (Either DockerError a)
62−parseResponse (Left err) =
63− return $ Left err
64−parseResponse (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
71−
72−getDockerVersion :: forall m. Monad m => DockerT m (Either DockerError DockerVersion)
73−getDockerVersion = requestHelper GET VersionEndpoint >>= parseResponse
74−
75−listContainers :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Container])
76−listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseResponse
77−
78−listImages :: forall m. Monad m => ListOpts -> DockerT m (Either DockerError [Image])
79−listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
80−
81−createContainer :: forall m. Monad m => CreateOpts -> DockerT m (Either DockerError ContainerID)
82−createContainer opts = requestHelper POST (CreateContainerEndpoint opts) >>= parseResponse
83−
84−-- TODO: Is this the correct return type? XXX
85−-- convert status code to unit or error
86−startContainer :: forall m. Monad m => StartOpts -> ContainerID -> DockerT m (Either DockerError ())
87−startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid
88−
89−stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())
90−stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid
91−
92−killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())
93−killContainer s cid = requestUnit POST $ KillContainerEndpoint s cid
94−
95−restartContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())
96−restartContainer t cid = requestUnit POST $ RestartContainerEndpoint t cid
97−
98−pauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())
99−pauseContainer cid = requestUnit POST $ PauseContainerEndpoint cid
100−
101−unpauseContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ())
102−unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid
103−
104−deleteContainer :: forall m. Monad m => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())
105−deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid
106−
107−inspectContainer :: forall m . Monad m => ContainerID -> DockerT m (Either DockerError ContainerDetails)
108−inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= parseResponse
109−
110−getContainerLogs :: forall m. Monad m => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)
111−getContainerLogs logopts cid = fmap responseBody <$> requestHelper GET (ContainerLogsEndpoint logopts False cid)
112−
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
118−