ac2efb2 · docker-hs · git.iko.soy

src/Docker/Client/Api.hs+10

compare with master

unifiedsplit

@@ -7,6 +7,7 @@ module Docker.Client.Api (

7 , createContainer

8 , startContainer

9 , stopContainer

10+ , waitContainer

10 , killContainer

11 , killContainer

11 , restartContainer

12 , restartContainer

12 , pauseContainer

13 , pauseContainer

@@ -27,6 +28,7 @@ import qualified Data.ByteString.Lazy as BSL

27import qualified Data.Text as Text

28import qualified Data.Text as Text

28import Network.HTTP.Client (responseBody, responseStatus)

29import Network.HTTP.Client (responseBody, responseStatus)

29import Network.HTTP.Types (StdMethod (..))

30import Network.HTTP.Types (StdMethod (..))

31+import System.Exit (ExitCode(..))

30

32

31import Docker.Client.Http

33import Docker.Client.Http

32import Docker.Client.Types

34import Docker.Client.Types

@@ -93,6 +95,14 @@ startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid

93stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())

95stopContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m (Either DockerError ())

94stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

96stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

95

97

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+

96-- | Sends a 'Signal' to the container with the given 'ContainerID'. Same

106-- | Sends a 'Signal' to the container with the given 'ContainerID'. Same

97-- as 'stopContainer' but you choose the signal directly.

107-- as 'stopContainer' but you choose the signal directly.

98killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())

108killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m (Either DockerError ())

src/Docker/Client/Http.hs+5

@@ -194,6 +194,11 @@ statusCodeToError (StopContainerEndpoint _ _) st =

194 Nothing

195 else

196 Just $ DockerInvalidStatusCode st

197+statusCodeToError (WaitContainerEndpoint _) st =

198+ if st == status200 then

199+ Nothing

200+ else

201+ Just $ DockerInvalidStatusCode st

197statusCodeToError (KillContainerEndpoint _ _) st =

202statusCodeToError (KillContainerEndpoint _ _) st =

198 if st == status204 then

203 if st == status204 then

199 Nothing

204 Nothing

src/Docker/Client/Internal.hs+2

@@ -39,6 +39,7 @@ getEndpoint (StopContainerEndpoint t cid) = encodeURLWithQuery ["containers", fr

39 where query = case t of

40 Timeout x -> [("t", Just (encodeQ $ show x))]

41 DefaultTimeout -> []

42+getEndpoint (WaitContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "wait"]

42getEndpoint (KillContainerEndpoint s cid) = encodeURLWithQuery ["containers", fromContainerID cid, "kill"] query

43getEndpoint (KillContainerEndpoint s cid) = encodeURLWithQuery ["containers", fromContainerID cid, "kill"] query

43 where query = case s of

44 where query = case s of

44 SIG x -> [("signal", Just (encodeQ $ show x))]

45 SIG x -> [("signal", Just (encodeQ $ show x))]

@@ -66,6 +67,7 @@ getEndpointRequestBody (ListImagesEndpoint _) = Nothing

66getEndpointRequestBody (CreateContainerEndpoint opts _) = Just $ JSON.encode opts

67getEndpointRequestBody (CreateContainerEndpoint opts _) = Just $ JSON.encode opts

67getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

68getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

68getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

69getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

70+getEndpointRequestBody (WaitContainerEndpoint _) = Nothing

69getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

71getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

70getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing

72getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing

71getEndpointRequestBody (PauseContainerEndpoint _) = Nothing

73getEndpointRequestBody (PauseContainerEndpoint _) = Nothing

src/Docker/Client/Types.hs+16

@@ -12,6 +12,7 @@ module Docker.Client.Types (

12 , fromImageID

13 , toImageID

14 , Timeout(..)

15+ , StatusCode(..)

15 , Signal(..)

16 , Signal(..)

16 , ContainerDetails(..)

17 , ContainerDetails(..)

17 , DockerClientOpts(..)

18 , DockerClientOpts(..)

@@ -111,6 +112,7 @@ data Endpoint =

111 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)

112 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)

112 | StartContainerEndpoint StartOpts ContainerID

113 | StartContainerEndpoint StartOpts ContainerID

113 | StopContainerEndpoint Timeout ContainerID

114 | StopContainerEndpoint Timeout ContainerID

115+ | WaitContainerEndpoint ContainerID

114 | KillContainerEndpoint Signal ContainerID

116 | KillContainerEndpoint Signal ContainerID

115 | RestartContainerEndpoint Timeout ContainerID

117 | RestartContainerEndpoint Timeout ContainerID

116 | PauseContainerEndpoint ContainerID

118 | PauseContainerEndpoint ContainerID

@@ -165,6 +167,20 @@ toImageID t =

165-- | Timeout used for stopping a container. DefaultTimeout is 10 seconds.

167-- | Timeout used for stopping a container. DefaultTimeout is 10 seconds.

166data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)

168data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)

167

169

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+

168-- TODO: Add more Signals or use an existing lib

184-- TODO: Add more Signals or use an existing lib

169-- | Signal used for sending to the process running in the container.

185-- | Signal used for sending to the process running in the container.

170-- The default signal is SIGTERM.

186-- The default signal is SIGTERM.