70ad6dd · docker-hs · git.iko.soy

git.iko.soy/docker-hs

Merge branch 'dev' into streaming

commit70ad6dde8b7f8915216809e4e3d8d42a7ce4b38f authorJames Parker <dev@jamesparker.me> dateThu 9 Mar 2017, 17:43 (10 years ago) parent62e0c70 ac2efb2

7 files changed+86−10

compare with master

unifiedsplit

.travis.yml+12−7 src/Docker/Client/Api.hs+13−3 src/Docker/Client/Http.hs+5 src/Docker/Client/Internal.hs+2 src/Docker/Client/Types.hs+18 stack-7.10.yaml+32 stack-8.0.yaml+4

.travis.yml+12−7

@@ -16,7 +16,8 @@ services:

1616 - docker

1717

1818env:

19− - STACK_ARGS=""

19+ - GHCVER=7.10 STACK_ARGS=""

20+ - GHCVER=8.0 STACK_ARGS=""

2021

2122addons:

2223 apt:

@@ -24,20 +25,24 @@ addons:

2425 - libgmp-dev

2526

2627before_install:

27− # Upgrade docker to 1.12

28+ # Upgrade docker to 1.12.3.0

2829 - sudo sh -c 'echo "deb https://apt.dockerproject.org/repo ubuntu-trusty main" > /etc/apt/sources.list.d/docker.list'

2930 - sudo apt-key adv --keyserver hkp://p80.pool.sks-keyservers.net:80 --recv-keys 58118E89F3A912897C070ADBF76221572C52609D

3031 - sudo apt-get update

31− - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=1.12.0-0~trusty

32+ - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=1.12.3-0~trusty

33+

34+install:

3235 - mkdir -p "$HOME"/.local/bin

3336 - export PATH=$HOME/.local/bin:$PATH

34−

37+ - export STACK_YAML=stack-$GHCVER.yaml

3538 # install Stack

3639 - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C $HOME/.local/bin '*/stack'

37− - export PATH=$(stack --stack-yaml stack.yaml path --local-install-root):$PATH

38− - stack setup

39−

40+ - export PATH=$(stack path --local-install-root):$PATH

41+ - stack --version

4042

4143script:

44+ - stack setup

45+ - stack update

46+ - stack build

4247 - stack test

4348

src/Docker/Client/Api.hs+13−3

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

77 , createContainer

88 , startContainer

99 , stopContainer

10+ , waitContainer

1011 , killContainer

1112 , restartContainer

1213 , pauseContainer

@@ -22,7 +23,7 @@ module Docker.Client.Api (

2223 , getDockerVersion

2324 ) where

2425

25−import Control.Monad.Catch (MonadMask(..))

26+import Control.Monad.Catch (MonadMask(..))

2627import Control.Monad.IO.Class

2728import Control.Monad.Reader (ask, lift)

2829import Data.Aeson (FromJSON, eitherDecode')

@@ -31,8 +32,9 @@ import qualified Data.ByteString.Lazy as BSL

3132import Data.Conduit (Sink)

3233import qualified Data.Conduit.Binary as Conduit

3334import qualified Data.Text as Text

34−import Network.HTTP.Client (responseStatus)

35−import Network.HTTP.Types (StdMethod (..))

35+import Network.HTTP.Client (responseStatus)

36+import Network.HTTP.Types (StdMethod (..))

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

3638

3739import Docker.Client.Http

3840import Docker.Client.Types

@@ -105,6 +107,14 @@ startContainer sopts cid = requestUnit POST $ StartContainerEndpoint sopts cid

105107stopContainer :: forall m. (MonadIO m, MonadMask m) => Timeout -> ContainerID -> DockerT m (Either DockerError ())

106108stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

107109

110+-- | Blocks until a container with the given 'ContainerID' stops,

111+-- then returns the exit code

112+waitContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT m (Either DockerError ExitCode)

113+waitContainer cid = fmap (fmap statusCodeToExitCode) (requestHelper POST (WaitContainerEndpoint cid) >>= parseResponse)

114+ where

115+ statusCodeToExitCode (StatusCode 0) = ExitSuccess

116+ statusCodeToExitCode (StatusCode x) = ExitFailure x

117+

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

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

110120killContainer :: forall m. (MonadIO m, MonadMask m) => Signal -> ContainerID -> DockerT m (Either DockerError ())

src/Docker/Client/Http.hs+5

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

204204 Nothing

205205 else

206206 Just $ DockerInvalidStatusCode st

207+statusCodeToError (WaitContainerEndpoint _) st =

208+ if st == status200 then

209+ Nothing

210+ else

211+ Just $ DockerInvalidStatusCode st

207212statusCodeToError (KillContainerEndpoint _ _) st =

208213 if st == status204 then

209214 Nothing

src/Docker/Client/Internal.hs+2

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

4141 where query = case t of

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

4343 DefaultTimeout -> []

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

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

4546 where query = case s of

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

@@ -77,6 +78,7 @@ getEndpointRequestBody (ListImagesEndpoint _) = Nothing

7778getEndpointRequestBody (CreateContainerEndpoint opts _) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)

7879getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

7980getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

81+getEndpointRequestBody (WaitContainerEndpoint _) = Nothing

8082getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

8183getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing

8284getEndpointRequestBody (PauseContainerEndpoint _) = Nothing

src/Docker/Client/Types.hs+18

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

1212 , fromImageID

1313 , toImageID

1414 , Timeout(..)

15+ , StatusCode(..)

1516 , Signal(..)

1617 , ContainerDetails(..)

1718 , DockerClientOpts(..)

@@ -85,6 +86,8 @@ module Docker.Client.Types (

8586 , addLink

8687 , addVolume

8788 , addVolumeFrom

89+ , MemoryConstraint(..)

90+ , MemoryConstraintSize(..)

8891 ) where

8992

9093import Data.Aeson (FromJSON, ToJSON, genericParseJSON,

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

111114 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)

112115 | StartContainerEndpoint StartOpts ContainerID

113116 | StopContainerEndpoint Timeout ContainerID

117+ | WaitContainerEndpoint ContainerID

114118 | KillContainerEndpoint Signal ContainerID

115119 | RestartContainerEndpoint Timeout ContainerID

116120 | PauseContainerEndpoint ContainerID

@@ -166,6 +170,20 @@ toImageID t =

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

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

168172

173+data StatusCode = StatusCode Int

174+

175+instance ToJSON StatusCode where

176+ toJSON (StatusCode c) = object ["StatusCode" .= c]

177+

178+instance FromJSON StatusCode where

179+ parseJSON (JSON.Object o) = do

180+ c <- o .: "StatusCode"

181+ if c >= 0 && c <= 255 then

182+ return (StatusCode c)

183+ else

184+ fail "Unknown exit code"

185+ parseJSON _ = fail "Unknown exit code"

186+

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

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

171189-- The default signal is SIGTERM.

stack-7.10.yamlnew file+32

@@ -0,0 +1,32 @@

1+# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md

3+# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)

4+resolver: lts-5.18

6+# Local packages, usually specified by relative directory name

7+packages:

8+- '.'

10+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)

11+extra-deps: []

12+

13+# Override default flag values for local packages and extra-deps

14+flags: {}

15+

16+# Extra package databases containing global packages

17+extra-package-dbs: []

18+

19+# Control whether we use the GHC we find on the path

20+# system-ghc: true

21+

22+# Require a specific version of stack, using version ranges

23+# require-stack-version: -any # Default

24+# require-stack-version: >= 0.1.4.0

25+

26+# Override the architecture used by stack, especially useful on Windows

27+# arch: i386

28+# arch: x86_64

29+

30+# Extra directories used by stack for building

31+# extra-include-dirs: [/path/to/dir]

32+# extra-lib-dirs: [/path/to/dir]

stack-8.0.yamlnew file+4

@@ -0,0 +1,4 @@

1+resolver: lts-7.12

2+packages:

3+- '.'

4+extra-deps: []