git.iko.soy/docker-hs
on master help sign in
Merge pull request #23 from kseo/waitcontainer

Add waitContainer

commitac2efb202a4acb2ca9e1a3a7ffd600f8a27ca4ed authorDeni Bertovic <deni@denibertovic.com> dateThu 9 Feb 2017, 16:06 (10 years ago) parent7a79ba04ccf0bc
4 files changed+33
compare with master
unifiedsplit
src/Docker/Client/Api.hs+10 src/Docker/Client/Http.hs+5 src/Docker/Client/Internal.hs+2 src/Docker/Client/Types.hs+16
src/Docker/Client/Api.hs+10
@@ -7,6 +7,7 @@ module Docker.Client.Api (
77 , createContainer
88 , startContainer
99 , stopContainer
10+ , waitContainer
1011 , killContainer
1112 , restartContainer
1213 , pauseContainer
@@ -27,6 +28,7 @@ import qualified Data.ByteString.Lazy as BSL
2728import qualified Data.Text as Text
2829import Network.HTTP.Client (responseBody, responseStatus)
2930import Network.HTTP.Types (StdMethod (..))
31+import System.Exit (ExitCode(..))
3032
3133import Docker.Client.Http
3234import Docker.Client.Types
@@ -93,6 +95,14 @@ startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid
9395stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())
9496stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid
9597
98+-- | Blocks until a container with the given 'ContainerID' stops,
99+-- then returns the exit code
100+waitContainer :: forall m. Monad m => ContainerID -> DockerT m (Either DockerError ExitCode)
101+waitContainer cid = fmap (fmap statusCodeToExitCode) (requestHelper POST (WaitContainerEndpoint cid) >>= parseResponse)
102+ where
103+ statusCodeToExitCode (StatusCode 0) = ExitSuccess
104+ statusCodeToExitCode (StatusCode x) = ExitFailure x
105+
96106-- | Sends a 'Signal' to the container with the given 'ContainerID'. Same
97107-- as 'stopContainer' but you choose the signal directly.
98108killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())
src/Docker/Client/Http.hs+5
@@ -194,6 +194,11 @@ statusCodeToError (StopContainerEndpoint _ _) st =
194194 Nothing
195195 else
196196 Just $ DockerInvalidStatusCode st
197+statusCodeToError (WaitContainerEndpoint _) st =
198+ if st == status200 then
199+ Nothing
200+ else
201+ Just $ DockerInvalidStatusCode st
197202statusCodeToError (KillContainerEndpoint _ _) st =
198203 if st == status204 then
199204 Nothing
src/Docker/Client/Internal.hs+2
@@ -39,6 +39,7 @@ getEndpoint (StopContainerEndpoint t cid) = encodeURLWithQuery ["containers", fr
3939 where query = case t of
4040 Timeout x -> [("t", Just (encodeQ $ show x))]
4141 DefaultTimeout -> []
42+getEndpoint (WaitContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "wait"]
4243getEndpoint (KillContainerEndpoint s cid) = encodeURLWithQuery ["containers", fromContainerID cid, "kill"] query
4344 where query = case s of
4445 SIG x -> [("signal", Just (encodeQ $ show x))]
@@ -66,6 +67,7 @@ getEndpointRequestBody (ListImagesEndpoint _) = Nothing
6667getEndpointRequestBody (CreateContainerEndpoint opts _) = Just $ JSON.encode opts
6768getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing
6869getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing
70+getEndpointRequestBody (WaitContainerEndpoint _) = Nothing
6971getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing
7072getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing
7173getEndpointRequestBody (PauseContainerEndpoint _) = Nothing
src/Docker/Client/Types.hs+16
@@ -12,6 +12,7 @@ module Docker.Client.Types (
1212 , fromImageID
1313 , toImageID
1414 , Timeout(..)
15+ , StatusCode(..)
1516 , Signal(..)
1617 , ContainerDetails(..)
1718 , DockerClientOpts(..)
@@ -111,6 +112,7 @@ data Endpoint =
111112 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)
112113 | StartContainerEndpoint StartOpts ContainerID
113114 | StopContainerEndpoint Timeout ContainerID
115+ | WaitContainerEndpoint ContainerID
114116 | KillContainerEndpoint Signal ContainerID
115117 | RestartContainerEndpoint Timeout ContainerID
116118 | PauseContainerEndpoint ContainerID
@@ -165,6 +167,20 @@ toImageID t =
165167-- | Timeout used for stopping a container. DefaultTimeout is 10 seconds.
166168data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)
167169
170+data StatusCode = StatusCode Int
171+
172+instance ToJSON StatusCode where
173+ toJSON (StatusCode c) = object ["StatusCode" .= c]
174+
175+instance FromJSON StatusCode where
176+ parseJSON (JSON.Object o) = do
177+ c <- o .: "StatusCode"
178+ if c >= 0 && c <= 255 then
179+ return (StatusCode c)
180+ else
181+ fail "Unknown exit code"
182+ parseJSON _ = fail "Unknown exit code"
183+
168184-- TODO: Add more Signals or use an existing lib
169185-- | Signal used for sending to the process running in the container.
170186-- The default signal is SIGTERM.