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

.travis.yml+12−7

compare with master

unifiedsplit

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

16 - docker

17

18env:

19+ - GHCVER=7.10 STACK_ARGS=""

19− - STACK_ARGS=""

20+ - GHCVER=8.0 STACK_ARGS=""

20

21

21addons:

22addons:

22 apt:

23 apt:

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

24 - libgmp-dev

25 - libgmp-dev

25

26

26before_install:

27before_install:

27− # Upgrade docker to 1.12

28+ # Upgrade docker to 1.12.3.0

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

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

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

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

30 - sudo apt-get update

31 - 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:

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

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

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

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

34−

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

35 # install Stack

38 # install Stack

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

39 - 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

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

38− - stack setup

41+ - stack --version

39−

40

42

41script:

43script:

44+ - stack setup

45+ - stack update

46+ - stack build

42 - stack test

47 - stack test

43

48

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

@@ -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

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

22 , getDockerVersion

23 , getDockerVersion

23 ) where

24 ) where

24

25

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

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

26import Control.Monad.IO.Class

27import Control.Monad.IO.Class

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

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

28import Data.Aeson (FromJSON, eitherDecode')

29import Data.Aeson (FromJSON, eitherDecode')

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

31import Data.Conduit (Sink)

32import Data.Conduit (Sink)

32import qualified Data.Conduit.Binary as Conduit

33import qualified Data.Conduit.Binary as Conduit

33import qualified Data.Text as Text

34import qualified Data.Text as Text

34−import Network.HTTP.Client (responseStatus)

35+import Network.HTTP.Client (responseStatus)

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

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

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

36

38

37import Docker.Client.Http

39import Docker.Client.Http

38import Docker.Client.Types

40import Docker.Client.Types

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

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

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

106stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

108stopContainer t cid = requestUnit POST $ StopContainerEndpoint t cid

107

109

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+

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

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

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

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

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

120killContainer :: 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 =

204 Nothing

205 else

206 Just $ DockerInvalidStatusCode st

207+statusCodeToError (WaitContainerEndpoint _) st =

208+ if st == status200 then

209+ Nothing

210+ else

211+ Just $ DockerInvalidStatusCode st

207statusCodeToError (KillContainerEndpoint _ _) st =

212statusCodeToError (KillContainerEndpoint _ _) st =

208 if st == status204 then

213 if st == status204 then

209 Nothing

214 Nothing

src/Docker/Client/Internal.hs+2

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

41 where query = case t of

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

43 DefaultTimeout -> []

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

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

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

45 where query = case s of

46 where query = case s of

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

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

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

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

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

78getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

79getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

79getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

80getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

81+getEndpointRequestBody (WaitContainerEndpoint _) = Nothing

80getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

82getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

81getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing

83getEndpointRequestBody (RestartContainerEndpoint _ _) = Nothing

82getEndpointRequestBody (PauseContainerEndpoint _) = Nothing

84getEndpointRequestBody (PauseContainerEndpoint _) = Nothing

src/Docker/Client/Types.hs+18

@@ -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(..)

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

85 , addLink

86 , addLink

86 , addVolume

87 , addVolume

87 , addVolumeFrom

88 , addVolumeFrom

89+ , MemoryConstraint(..)

90+ , MemoryConstraintSize(..)

88 ) where

91 ) where

89

92

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

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

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

111 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)

114 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)

112 | StartContainerEndpoint StartOpts ContainerID

115 | StartContainerEndpoint StartOpts ContainerID

113 | StopContainerEndpoint Timeout ContainerID

116 | StopContainerEndpoint Timeout ContainerID

117+ | WaitContainerEndpoint ContainerID

114 | KillContainerEndpoint Signal ContainerID

118 | KillContainerEndpoint Signal ContainerID

115 | RestartContainerEndpoint Timeout ContainerID

119 | RestartContainerEndpoint Timeout ContainerID

116 | PauseContainerEndpoint ContainerID

120 | PauseContainerEndpoint ContainerID

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

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

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

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

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

168

172

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+

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

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

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

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

171-- The default signal is SIGTERM.

189-- 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

2+

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

5+

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

7+packages:

8+- '.'

9+

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: []