git.iko.soy/docker-hs
on f5f50fa help sign in
9009766
swap
0 ahead, 98 behind
.travis.yml+3−25
since splitsnapshots
unifiedsplit
@@ -22,30 +22,8 @@ services:
22 - docker
22 - docker
23
23
24env:
24env:
25− global:
25+ - GHCVER=7.10 STACK_ARGS=""
26− - RUN_INTEGRATION_TESTS=1
26+ - GHCVER=8.0 STACK_ARGS=""
27− - STACK_ARGS=""
28−
29− matrix:
30− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=7.10
31− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=7.10
32− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=7.10
33−
34− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.0
35− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.0
36− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.0
37−
38− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.0.2
39− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.0.2
40− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.0.2
41−
42− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.6.4
43− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.6.4
44− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.6.4
45−
46− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.8.2
47− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.8.2
48− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.8.2
49
27
50addons:
28addons:
51 apt:
29 apt:
@@ -57,7 +35,7 @@ before_install:
57 - sudo sh -c 'echo "deb https://apt.dockerproject.org/repo ubuntu-trusty main" > /etc/apt/sources.list.d/docker.list'
35 - sudo sh -c 'echo "deb https://apt.dockerproject.org/repo ubuntu-trusty main" > /etc/apt/sources.list.d/docker.list'
58 - sudo apt-key adv --keyserver hkp://p80.pool.sks-keyservers.net:80 --recv-keys 58118E89F3A912897C070ADBF76221572C52609D
36 - sudo apt-key adv --keyserver hkp://p80.pool.sks-keyservers.net:80 --recv-keys 58118E89F3A912897C070ADBF76221572C52609D
59 - sudo apt-get update
37 - sudo apt-get update
60− - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=$DOCKER_VERSION
38+ - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=1.12.3-0~trusty
61
39
62install:
40install:
63 - mkdir -p "$HOME"/.local/bin
41 - mkdir -p "$HOME"/.local/bin
CHANGELOG.md−71
@@ -1,76 +1,5 @@
1# CHANGELOG
1# CHANGELOG
2
2
3−## 0.6.0.3 (2020-02-17)
4−
5−- Support for ghc 8.8.2.
6−- Bump dependency version.
7−- Use MonadFail for later versions.
8−
9−## 0.6.0.1 (2019-05-23)
10−
11−- Support ghc 8.6.4.
12−- Bump containers version.
13−
14−## 0.6.0.0 (2018-06-28)
15−
16−- Rename DeleteOpts to ContainerDeleteOpts.
17−- Implement image deletion.
18−- Bump aeson version.
19−- Implement network aliases.
20−- Implement creating/deleting networks.
21−
22−## 0.5.1.1 (2018-03-09)
23−
24−- Bump aeson version.
25−
26−## 0.5.1.0 (2018-02-23)
27−
28−- Support http-conduit-2.3.0.
29−- Bump http-types versions.
30−
31−## 0.5.0.1 (2018-01-26)
32−
33−- Bumps upper bound for http-types (properly this time).
34−
35−## 0.5.0.0 (2018-01-24)
36−
37−- Added (some) contribution and general docs
38−- Fix case when stopping non-existent container
39−- Added more integration tests
40−- Fixed error while parsing list container endpoint output
41−- Changed State/Status data type (related to the above fix)
42−- Added tests against different docker version to travis CIA
43−- Fixed EnvVar JSON encoding
44−- Fixed NetworkMode parsing
45−- Allow http-types 0.11
46−
47−## 0.4.1.1 (2017-10-16)
48−
49−- Small change to add env var for skipping integration tests.
50− This is mostly to avoid running those on stackage.
51−
52−## 0.4.1.0 (2017-10-04)
53−
54−- Relaxed aeson, tls and time upper bounds
55−
56−
57−## 0.4.0.2 (2017-09-19)
58−
59−- Support LTS 9.4
60−
61−## 0.4.0.1 (2017-06-29)
62−
63−- fixes omKillDisable parsing from json
64−- adds Entrypoint data type and tests edge cases
65−- more tests
66−- small comsmetic changes
67−
68−## 0.4.0.0 (2017-03-20)
69−
70−- Adds streaming support via conduits (changes API a bit hence the major version release)
71−- Added support for streaming log output
72−- Added support for pulling images from the hub (and streaming the output)
73−
74## 0.3.0.1 (2016-09-07)
3## 0.3.0.1 (2016-09-07)
75
4
76- Small cosmetic changes and marking OVERLAPPING instance
5- Small cosmetic changes and marking OVERLAPPING instance
CONTRIBUTING.md+2−12
@@ -1,14 +1,4 @@
1−# Contributing
1+# TODO
2
2
3−If you wish to contribute please see [any issue on GitHub tagged with "help
3+Add basic guidelines here, things like style guide (using .configuration files from the repo) etc etc.
4−wanted"](https://github.com/denibertovic/docker-hs/issues?q=is%3Aopen+is%3Aissue+label%3A%22help+wanted%22).
5−Before starting to work, consider commenting on the issue you want to resolve or
6−open a new issue to discuss design decisions and implementation details. This is
7−so that no development cycles go to waste on implementing a feature that might
8−not get merged either because of implementation details or other reasons.
9
4
10−Make sure to submit your PR's against the `master` branch.
11−
12−## Project Setup
13−
14−See the `README.md` file on how to setup the project on your development machine.
LICENSE+1−1
@@ -1,4 +1,4 @@
1−Copyright (c) 2014, Deni Bertovic
1+Copyright (c) 2016, Deni Bertovic
2
2
3All rights reserved.
3All rights reserved.
4
4
Makefile+2−21
@@ -1,6 +1,4 @@
1−.PHONY: build repl test release help
1+.PHONY: build repl test release
2−
3−.DEFAULT_GOAL = help
4
2
5PROJECT_NAME ?= $(shell grep "^name" docker.cabal | cut -d " " -f17)
3PROJECT_NAME ?= $(shell grep "^name" docker.cabal | cut -d " " -f17)
6VERSION ?= $(shell grep "^version:" docker.cabal | cut -d " " -f14)
4VERSION ?= $(shell grep "^version:" docker.cabal | cut -d " " -f14)
@@ -8,35 +6,18 @@ RESOLVER ?= $(shell grep "^resolver:" stack.yaml | cut -d " " -f2)
8GHC_VERSION ?= $(shell stack ghc -- --version | cut -d " " -f8)
6GHC_VERSION ?= $(shell stack ghc -- --version | cut -d " " -f8)
9ARCH=$(shell uname -m)
7ARCH=$(shell uname -m)
10
8
11−## Run build
12build:
9build:
13 @stack build
10 @stack build
14
11
15−## Run repl
16repl:
12repl:
17 @stack repl
13 @stack repl
18
14
19−## Run tests. Example RUN_INTEGRATION_TESTS=1 make test
20test:
15test:
21− @RUN_INTEGRATION_TESTS=1 stack test
16+ @stack test
22
17
23−## Cut new release
24release:
18release:
25 @stack build --haddock
19 @stack build --haddock
26 @stack sdist
20 @stack sdist
27 @echo "\n\nDone. Now run: \n\nstack upload <path_to_tarball>\n"
21 @echo "\n\nDone. Now run: \n\nstack upload <path_to_tarball>\n"
28 @echo "\nAnd: \n\ngit tag ${VERSION} && git push --tags\n"
22 @echo "\nAnd: \n\ngit tag ${VERSION} && git push --tags\n"
29
23
30−## Show help screen.
31−help:
32− @echo "Please use \`make <target>' where <target> is one of\n\n"
33− @awk '/^[a-zA-Z\-\_0-9]+:/ { \
34− helpMessage = match(lastLine, /^## (.*)/); \
35− if (helpMessage) { \
36− helpCommand = substr($$1, 0, index($$1, ":")-1); \
37− helpMessage = substr(lastLine, RSTART + 3, RLENGTH); \
38− printf "%-30s %s\n", helpCommand, helpMessage; \
39− } \
40− } \
41− { lastLine = $$0 }' $(MAKEFILE_LIST)
42−
README.md+9−26
@@ -7,42 +7,25 @@
7
7
8## Current state
8## Current state
9
9
10+**API is still not stable.**
11+
10−Supported Docker Engine Api version: `v1.24` and onwards.
12+Supported Docker Engine Api version: `v1.24`
11
13
12Anything upward of that should work since Docker versions their API.
14Anything upward of that should work since Docker versions their API.
13Older docker version and engine api versions are not supported at the moment.
15Older docker version and engine api versions are not supported at the moment.
14
16
15−## Documentation
16−
17−The API-documentation is available at
18−[Hackage](https://hackage.haskell.org/package/docker). There are also some
19−usage-examples in the main library source file,
20−[`Client.hs`](https://hackage.haskell.org/package/docker/docs/Docker-Client.html).
21−
22## Contributing
17## Contributing
23
18
24−Please see [CONTRIBUTING.md](CONTRIBUTING.md).
19+If you wish to contribute please see any issue tagged with "help wanted".
25−
20+Make sure to submit your PR's against the `master` branch.
26−### Project Setup
27
21
28−For working on the library, you need the Haskell Tool Stack installed (see [the
22+Please consider filling an Issue first and discuss design decisions and implementation details before
29−Haskell Tool Stack
23+writing any code. This is so that no development cycles go to waste on implementing a feature that
30−website](https://docs.haskellstack.org/en/stable/install_and_upgrade/)). You
24+might not get merged either because of implementation details or other reasons.
31−also need `make` to use the `Makefile` included in the project. Run `make help`
32−to see the available commands (for building, running the tests and releasing).
33
25
34−### Tests
35−
36−Tests are located in the `tests` directory and can be run with `make test`. This
37−only runs the unit tests.
38−
39−To run integration tests, you need Docker installed and listening on Port `2375`
40−of `localhost` (docker only listens to a Unix socket by default, see the [Docker
41−documentation](https://docs.docker.com/engine/reference/commandline/dockerd/#daemon-socket-option)
42−for details). Set the environment variable `RUN_INTEGRATION_TESTS`, i.e.
43−`RUN_INTEGRATION_TESTS=1 make test`.
44
26
45## IRC
27## IRC
46
28
47If you have any questions or suggestions you can find the maintainers in `#docker-haskell`
29If you have any questions or suggestions you can find the maintainers in `#docker-haskell`
48on freenode.
30on freenode.
31+
docker.cabal+12−24
@@ -1,5 +1,5 @@
1name: docker
1name: docker
2−version: 0.6.0.3
2+version: 0.4.0.0
3synopsis: An API client for docker written in Haskell
3synopsis: An API client for docker written in Haskell
4description: See API documentation below.
4description: See API documentation below.
5homepage: https://github.com/denibertovic/docker-hs
5homepage: https://github.com/denibertovic/docker-hs
@@ -14,29 +14,25 @@ extra-source-files: README.md
14cabal-version: >=1.10
14cabal-version: >=1.10
15stability: experimental
15stability: experimental
16
16
17−-- Flag small-http-conduit
18−-- Description: Resolve whether http-conduit < 2.3.0.
19−-- Manual: False
20−-- Default: True
21−
22library
17library
23− default-extensions: DeriveGeneric, OverloadedStrings, ScopedTypeVariables, ExplicitForAll, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, RankNTypes, DeriveFunctor, FlexibleInstances, CPP
18+ default-extensions: DeriveGeneric, OverloadedStrings, ScopedTypeVariables, ExplicitForAll, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, RankNTypes, DeriveFunctor, FlexibleInstances
24 hs-source-dirs: src
19 hs-source-dirs: src
25 exposed-modules: Docker.Client, Docker.Client.Api, Docker.Client.Types, Docker.Client.Internal, Docker.Client.Http, Docker.Client.Utils
20 exposed-modules: Docker.Client, Docker.Client.Api, Docker.Client.Types, Docker.Client.Internal, Docker.Client.Http, Docker.Client.Utils
26 -- other-modules: Docker.Internal
21 -- other-modules: Docker.Internal
27 build-depends: base >= 4.7 && < 5
22 build-depends: base >= 4.7 && < 5
28− , aeson >= 0.9.0 && < 2.0.0
23+ , aeson >= 0.9.0 && < 1.1.0
29 , blaze-builder >= 0.4.0 && < 0.5.0
24 , blaze-builder >= 0.4.0 && < 0.5.0
30 , bytestring >= 0.10.0 && < 0.11.0
25 , bytestring >= 0.10.0 && < 0.11.0
31− , containers >= 0.5.0 && < 0.7.0
26+ , containers >= 0.5.0 && < 0.6.0
32 , data-default-class >= 0.0.1 && < 0.2.0
27 , data-default-class >= 0.0.1 && < 0.2.0
33− , http-client >= 0.4.0 && < 0.7.0
28+ , http-client >= 0.4.0 && < 0.5.0
34− , http-types >= 0.9 && < 0.13
29+ , http-types >= 0.9 && < 0.10.0
35 , vector
30 , vector
36 , conduit
31 , conduit
37 , conduit-combinators
32 , conduit-combinators
38 , conduit-extra
33 , conduit-extra
39 , exceptions
34 , exceptions
35+ , http-conduit
40 , monad-control
36 , monad-control
41 , resourcet
37 , resourcet
42 , transformers
38 , transformers
@@ -51,20 +47,13 @@ library
51 , mtl >= 2.0.0 && < 3.0.0
47 , mtl >= 2.0.0 && < 3.0.0
52 , network >= 2.6.0
48 , network >= 2.6.0
53 , text >= 1.0.0 && < 2.0.0
49 , text >= 1.0.0 && < 2.0.0
54− , time >= 1.5.0 && < 2.0.0
50+ , time >= 1.5.0 && < 1.7.0
55 , scientific >= 0.3.0 && < 0.4.0
51 , scientific >= 0.3.0 && < 0.4.0
56− , tls >= 1.3.7 && < 1.6.0
52+ , tls >= 1.3.7 && < 1.4.0
57 , unordered-containers >= 0.2.0 && < 0.3.0
53 , unordered-containers >= 0.2.0 && < 0.3.0
58− , x509 >= 1.6.0 && < 1.8.0
54+ , x509 >= 1.6.0 && < 1.7.0
59− , x509-store >= 1.6.0 && < 1.8.0
55+ , x509-store >= 1.6.0 && < 1.7.0
60− , x509-system >= 1.6.0 && < 1.8.0
56+ , x509-system >= 1.6.0 && < 1.7.0
61− , http-conduit
62− , unliftio-core >= 0.1.0.0 && < 0.2.0
63− -- if flag(small-http-conduit)
64− -- build-depends: http-conduit < 2.3.0
65− -- else
66− -- build-depends: http-conduit >= 2.3.0
67− -- , unliftio-core
68 default-language: Haskell2010
57 default-language: Haskell2010
69 ghc-options: -Wall -fno-warn-name-shadowing
58 ghc-options: -Wall -fno-warn-name-shadowing
70
59
@@ -73,7 +62,6 @@ test-suite docker-hs-tests
73 , bytestring
62 , bytestring
74 , connection
63 , connection
75 , docker
64 , docker
76− , directory
77 , aeson
65 , aeson
78 , containers
66 , containers
79 , unordered-containers
67 , unordered-containers
src/Docker/Client.hs+1−1
@@ -3,7 +3,7 @@
3
3
4{-|
4{-|
5Module : Docker.Client
5Module : Docker.Client
6−Copyright : (c) Deni Bertovic, 2014
6+Copyright : (c) Deni Bertovic, 2016
7License : BSD3
7License : BSD3
8Maintainer : deni@denibertovic.com
8Maintainer : deni@denibertovic.com
9Stability : experimental
9Stability : experimental
src/Docker/Client/Api.hs+3−21
@@ -18,12 +18,8 @@ module Docker.Client.Api (
18 , getContainerLogsStream
18 , getContainerLogsStream
19 -- * Images
19 -- * Images
20 , listImages
20 , listImages
21− , deleteImage
22 , buildImageFromDockerfile
21 , buildImageFromDockerfile
23 , pullImage
22 , pullImage
24− -- * Network
25− , createNetwork
26− , removeNetwork
27 -- * Other
23 -- * Other
28 , getDockerVersion
24 , getDockerVersion
29 ) where
25 ) where
@@ -47,7 +43,7 @@ import Docker.Client.Types
47import Docker.Client.Utils
43import Docker.Client.Utils
48
44
49requestUnit :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())
45requestUnit :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())
50−requestUnit verb endpoint = fmap (const ()) <$> requestHelper verb endpoint
46+requestUnit verb endpoint = const (Right ()) <$> requestHelper verb endpoint
51
47
52requestHelper :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError BSL.ByteString)
48requestHelper :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError BSL.ByteString)
53requestHelper verb endpoint = requestHelper' verb endpoint Conduit.sinkLbs
49requestHelper verb endpoint = requestHelper' verb endpoint Conduit.sinkLbs
@@ -94,12 +90,6 @@ listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseR
94listImages :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Image])
90listImages :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Image])
95listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
91listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
96
92
97−-- | Deletes an image with the given 'ImageID'.
98−-- See "ImageDeleteOpts" for options and use 'defaultImageDeleteOpts' for sane
99−-- defaults.
100−deleteImage :: forall m. (MonadIO m, MonadMask m) => ImageDeleteOpts -> ImageID -> DockerT m (Either DockerError ())
101−deleteImage dopts iid = requestUnit DELETE $ DeleteImageEndpoint dopts iid
102−
103-- | Creates a docker container but does __not__ start it. See
93-- | Creates a docker container but does __not__ start it. See
104-- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'
94-- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'
105-- for some sane defaults.
95-- for some sane defaults.
@@ -145,9 +135,9 @@ unpauseContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT
145unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid
135unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid
146
136
147-- | Deletes a container with the given 'ContainerID'.
137-- | Deletes a container with the given 'ContainerID'.
148−-- See "ContainerDeleteOpts" for options and use 'defaultContainerDeleteOpts' for sane
138+-- See "DeleteOpts" for options and use 'defaultDeleteOpts' for sane
149-- defaults.
139-- defaults.
150−deleteContainer :: forall m. (MonadIO m, MonadMask m) => ContainerDeleteOpts -> ContainerID -> DockerT m (Either DockerError ())
140+deleteContainer :: forall m. (MonadIO m, MonadMask m) => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())
151deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid
141deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid
152
142
153-- | Gets 'ContainerDetails' for a given 'ContainerID'.
143-- | Gets 'ContainerDetails' for a given 'ContainerID'.
@@ -217,11 +207,3 @@ buildImageFromDockerfile opts base = do
217pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)
207pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)
218pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing)
208pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing)
219
209
220−-- | Creates network
221−createNetwork :: forall m. (MonadIO m, MonadMask m) => CreateNetworkOpts -> DockerT m (Either DockerError NetworkID)
222−createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseResponse
223−
224−-- | Removes a network
225−removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())
226−removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid
227−
src/Docker/Client/Http.hs+7−40
@@ -5,9 +5,6 @@ module Docker.Client.Http where
5
5
6-- import Control.Monad.Base (MonadBase(..), liftBaseDefault)
6-- import Control.Monad.Base (MonadBase(..), liftBaseDefault)
7import Control.Monad.Catch (MonadMask (..))
7import Control.Monad.Catch (MonadMask (..))
8−#if MIN_VERSION_http_conduit(2,3,0)
9−import Control.Monad.IO.Unlift (MonadUnliftIO)
10−#endif
11import Control.Monad.Reader (ReaderT (..), runReaderT)
8import Control.Monad.Reader (ReaderT (..), runReaderT)
12import qualified Data.ByteString.Char8 as BSC
9import qualified Data.ByteString.Char8 as BSC
13import qualified Data.ByteString.Lazy as BL
10import qualified Data.ByteString.Lazy as BL
@@ -20,7 +17,7 @@ import Data.X509.CertificateStore (makeCertificateStore)
20import Data.X509.File (readKeyFile, readSignedObject)
17import Data.X509.File (readKeyFile, readSignedObject)
21import Network.HTTP.Client (defaultManagerSettings,
18import Network.HTTP.Client (defaultManagerSettings,
22 managerRawConnection, method,
19 managerRawConnection, method,
23− newManager, parseRequest,
20+ newManager, parseUrl,
24 requestBody, requestHeaders)
21 requestBody, requestHeaders)
25import qualified Network.HTTP.Client as HTTP
22import qualified Network.HTTP.Client as HTTP
26import Network.HTTP.Client.Internal (makeConnection)
23import Network.HTTP.Client.Internal (makeConnection)
@@ -97,7 +94,7 @@ runDockerT (opts, h) r = runReaderT (unDockerT r) (opts, h)
97mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
94mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
98mkHttpRequest verb e opts = request
95mkHttpRequest verb e opts = request
99 where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint (apiVer opts) e)
96 where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint (apiVer opts) e)
100− initialR = parseRequest fullE
97+ initialR = parseUrl fullE
101 request' = case initialR of
98 request' = case initialR of
102 Just ir ->
99 Just ir ->
103 return $ ir {method = (encodeUtf8 . T.pack $ show verb),
100 return $ ir {method = (encodeUtf8 . T.pack $ show verb),
@@ -107,30 +104,18 @@ mkHttpRequest verb e opts = request
107 requestHeaders = [("Content-Type", "application/json; charset=utf-8")]}) $ getEndpointRequestBody e) <$> request'
104 requestHeaders = [("Content-Type", "application/json; charset=utf-8")]}) $ getEndpointRequestBody e) <$> request'
108 -- Note: Do we need to set length header?
105 -- Note: Do we need to set length header?
109
106
110−defaultHttpHandler :: (
111−#if MIN_VERSION_http_conduit(2,3,0)
112− MonadUnliftIO m,
113−#endif
114− MonadIO m, MonadMask m) => m (HttpHandler m)
107+defaultHttpHandler :: (MonadIO m, MonadMask m) => m (HttpHandler m)
115defaultHttpHandler = do
108defaultHttpHandler = do
116 manager <- liftIO $ newManager defaultManagerSettings
109 manager <- liftIO $ newManager defaultManagerSettings
117 return $ httpHandler manager
110 return $ httpHandler manager
118
111
119−httpHandler :: (
120−#if MIN_VERSION_http_conduit(2,3,0)
121− MonadUnliftIO m,
122−#endif
123− MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m
112+httpHandler :: (MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m
124httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
113httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
125 let request = NHS.setRequestManager manager request'
114 let request = NHS.setRequestManager manager request'
126 try (NHS.httpSink request sink) >>= \res -> case res of
115 try (NHS.httpSink request sink) >>= \res -> case res of
127 Right res -> return res
116 Right res -> return res
128−#if MIN_VERSION_http_client(0,5,0)
129− Left e@(HTTP.HttpExceptionRequest _ HTTP.ConnectionFailure{}) -> return $ Left $ DockerConnectionError e
130−#else
131 Left e@HTTP.FailedConnectionException{} -> return $ Left $ DockerConnectionError e
117 Left e@HTTP.FailedConnectionException{} -> return $ Left $ DockerConnectionError e
132 Left e@HTTP.FailedConnectionException2{} -> return $ Left $ DockerConnectionError e
118 Left e@HTTP.FailedConnectionException2{} -> return $ Left $ DockerConnectionError e
133−#endif
134 Left e -> return $ Left $ GenericDockerError (T.pack $ show e)
119 Left e -> return $ Left $ GenericDockerError (T.pack $ show e)
135
120
136-- | Connect to a unix domain socket (the default docker socket is
121-- | Connect to a unix domain socket (the default docker socket is
@@ -138,11 +123,7 @@ httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
138--
123--
139-- Docker seems to ignore the hostname in requests sent over unix domain
124-- Docker seems to ignore the hostname in requests sent over unix domain
140-- sockets (and the port obviously doesn't matter either)
125-- sockets (and the port obviously doesn't matter either)
141−unixHttpHandler :: (
142−#if MIN_VERSION_http_conduit(2,3,0)
143− MonadUnliftIO m,
144−#endif
145− MonadIO m, MonadMask m) => FilePath -- ^ The socket to connect to
126+unixHttpHandler :: (MonadIO m, MonadMask m) => FilePath -- ^ The socket to connect to
146 -> m (HttpHandler m)
127 -> m (HttpHandler m)
147unixHttpHandler fp = do
128unixHttpHandler fp = do
148 let mSettings = defaultManagerSettings
129 let mSettings = defaultManagerSettings
@@ -156,7 +137,7 @@ unixHttpHandler fp = do
156 S.connect s (S.SockAddrUnix filePath)
137 S.connect s (S.SockAddrUnix filePath)
157 makeConnection (SBS.recv s 8096)
138 makeConnection (SBS.recv s 8096)
158 (SBS.sendAll s)
139 (SBS.sendAll s)
159− (S.close s)
140+ (S.sClose s)
160
141
161-- TODO:
142-- TODO:
162-- Move this to http-client-tls or network?
143-- Move this to http-client-tls or network?
@@ -273,18 +254,4 @@ statusCodeToError (CreateImageEndpoint _ _ _) st =
273 Nothing
254 Nothing
274 else
255 else
275 Just $ DockerInvalidStatusCode st
256 Just $ DockerInvalidStatusCode st
276−statusCodeToError (DeleteImageEndpoint _ _) st =
257+
277− if st == status200 then
278− Nothing
279− else
280− Just $ DockerInvalidStatusCode st
281−statusCodeToError (CreateNetworkEndpoint _) st =
282− if st == status201 then
283− Nothing
284− else
285− Just $ DockerInvalidStatusCode st
286−statusCodeToError (RemoveNetworkEndpoint _) st =
287− if st == status204 then
288− Nothing
289− else
290− Just $ DockerInvalidStatusCode st
src/Docker/Client/Internal.hs+3−11
@@ -5,13 +5,12 @@ import qualified Data.Aeson as JSON
5import Data.ByteString (ByteString)
5import Data.ByteString (ByteString)
6import qualified Data.ByteString.Char8 as BSC
6import qualified Data.ByteString.Char8 as BSC
7import qualified Data.Conduit.Binary as CB
7import qualified Data.Conduit.Binary as CB
8−import qualified Data.Text as T
8+import Data.Text as T
9import Data.Text.Encoding (decodeUtf8, encodeUtf8)
9import Data.Text.Encoding (decodeUtf8, encodeUtf8)
10import qualified Network.HTTP.Client as HTTP
10import qualified Network.HTTP.Client as HTTP
11import Network.HTTP.Conduit (requestBodySourceChunked)
11import Network.HTTP.Conduit (requestBodySourceChunked)
12import Network.HTTP.Types (Query, encodePath,
12import Network.HTTP.Types (Query, encodePath,
13 encodePathSegments)
13 encodePathSegments)
14−import Prelude hiding (all)
15
14
16import Docker.Client.Types
15import Docker.Client.Types
17
16
@@ -27,7 +26,7 @@ encodeQ = encodeUtf8 . T.pack
27
26
28getEndpoint :: ApiVersion -> Endpoint -> T.Text
27getEndpoint :: ApiVersion -> Endpoint -> T.Text
29getEndpoint v VersionEndpoint = encodeURL [v, "version"]
28getEndpoint v VersionEndpoint = encodeURL [v, "version"]
30−getEndpoint v (ListContainersEndpoint (ListOpts all)) = encodeURLWithQuery [v, "containers", "json"] [("all", Just (encodeQ $ show all))]
29+getEndpoint v (ListContainersEndpoint _) = encodeURL [v, "containers", "json"] -- Make use of lsOpts here
31getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
30getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
32getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
31getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
33 Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
32 Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
@@ -57,7 +56,7 @@ getEndpoint v (UnpauseContainerEndpoint cid) = encodeURL [v, "containers", fromC
57getEndpoint v (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
56getEndpoint v (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
58 encodeURLWithQuery [v, "containers", fromContainerID cid, "logs"] query
57 encodeURLWithQuery [v, "containers", fromContainerID cid, "logs"] query
59 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]
58 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]
60−getEndpoint v (DeleteContainerEndpoint (ContainerDeleteOpts removeVolumes force) cid) =
59+getEndpoint v (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
61 encodeURLWithQuery [v, "containers", fromContainerID cid] query
60 encodeURLWithQuery [v, "containers", fromContainerID cid] query
62 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
61 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
63getEndpoint v (InspectContainerEndpoint cid) =
62getEndpoint v (InspectContainerEndpoint cid) =
@@ -75,9 +74,6 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images"
75 where query = [("fromImage", Just n), ("tag", Just t)]
74 where query = [("fromImage", Just n), ("tag", Just t)]
76 n = encodeQ $ T.unpack name
75 n = encodeQ $ T.unpack name
77 t = encodeQ $ T.unpack tag
76 t = encodeQ $ T.unpack tag
78−getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid]
79−getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"]
80−getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
81
77
82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
78getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
83getEndpointRequestBody VersionEndpoint = Nothing
79getEndpointRequestBody VersionEndpoint = Nothing
@@ -97,10 +93,6 @@ getEndpointRequestBody (InspectContainerEndpoint _) = Nothing
97
93
98getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp
94getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp
99getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing
95getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing
100−getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing
101−
102−getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)
103−getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing
104
96
105getEndpointContentType :: Endpoint -> BSC.ByteString
97getEndpointContentType :: Endpoint -> BSC.ByteString
106getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
98getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
src/Docker/Client/Types.hs+41−149
@@ -11,9 +11,6 @@ module Docker.Client.Types (
11 , ImageID
11 , ImageID
12 , fromImageID
12 , fromImageID
13 , toImageID
13 , toImageID
14− , NetworkID
15− , fromNetworkID
16− , toNetworkID
17 , Timeout(..)
14 , Timeout(..)
18 , StatusCode(..)
15 , StatusCode(..)
19 , Signal(..)
16 , Signal(..)
@@ -26,7 +23,7 @@ module Docker.Client.Types (
26 , ContainerPortInfo(..)
23 , ContainerPortInfo(..)
27 , Container(..)
24 , Container(..)
28 , ContainerState(..)
25 , ContainerState(..)
29− , State(..)
26+ , Status(..)
30 , Digest
27 , Digest
31 , Label(..)
28 , Label(..)
32 , Tag
29 , Tag
@@ -40,16 +37,12 @@ module Docker.Client.Types (
40 , DetachKeys(..)
37 , DetachKeys(..)
41 , StartOpts(..)
38 , StartOpts(..)
42 , defaultStartOpts
39 , defaultStartOpts
43− , ContainerDeleteOpts(..)
40+ , DeleteOpts(..)
44− , defaultContainerDeleteOpts
41+ , defaultDeleteOpts
45− , ImageDeleteOpts(..)
46− , defaultImageDeleteOpts
47 , Timestamp
42 , Timestamp
48 , TailLogOpt(..)
43 , TailLogOpt(..)
49 , LogOpts(..)
44 , LogOpts(..)
50 , defaultLogOpts
45 , defaultLogOpts
51− , CreateNetworkOpts(..)
52− , defaultCreateNetworkOpts
53 , VolumePermission(..)
46 , VolumePermission(..)
54 , Bind(..)
47 , Bind(..)
55 , Volume(..)
48 , Volume(..)
@@ -75,8 +68,6 @@ module Docker.Client.Types (
75 , UTSMode(..)
68 , UTSMode(..)
76 , HostConfig(..)
69 , HostConfig(..)
77 , defaultHostConfig
70 , defaultHostConfig
78− , NetworkingConfig(..)
79− , EndpointConfig(..)
80 , Ulimit(..)
71 , Ulimit(..)
81 , ContainerResources(..)
72 , ContainerResources(..)
82 , defaultContainerResources
73 , defaultContainerResources
@@ -132,13 +123,10 @@ data Endpoint =
132 | UnpauseContainerEndpoint ContainerID
123 | UnpauseContainerEndpoint ContainerID
133 | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.
124 | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.
134 -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.
125 -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.
135− | DeleteContainerEndpoint ContainerDeleteOpts ContainerID
126+ | DeleteContainerEndpoint DeleteOpts ContainerID
136 | InspectContainerEndpoint ContainerID
127 | InspectContainerEndpoint ContainerID
137 | BuildImageEndpoint BuildOpts FilePath
128 | BuildImageEndpoint BuildOpts FilePath
138 | CreateImageEndpoint T.Text Tag (Maybe T.Text) -- ^ Either pull an image from docker hub or imports an image from a tarball (or URL)
129 | CreateImageEndpoint T.Text Tag (Maybe T.Text) -- ^ Either pull an image from docker hub or imports an image from a tarball (or URL)
139− | DeleteImageEndpoint ImageDeleteOpts ImageID
140− | CreateNetworkEndpoint CreateNetworkOpts
141− | RemoveNetworkEndpoint NetworkID
142 deriving (Eq, Show)
130 deriving (Eq, Show)
143
131
144-- | We should newtype this
132-- | We should newtype this
@@ -250,7 +238,7 @@ data ContainerDetails = ContainerDetails {
250 , processLabel :: Text
238 , processLabel :: Text
251 , resolveConfPath :: FilePath
239 , resolveConfPath :: FilePath
252 , restartCount :: Int
240 , restartCount :: Int
253− , containerDetailsState :: ContainerState
241+ , state :: ContainerState
254 , mounts :: [Mount]
242 , mounts :: [Mount]
255 }
243 }
256 deriving (Eq, Show, Generic)
244 deriving (Eq, Show, Generic)
@@ -258,11 +246,11 @@ data ContainerDetails = ContainerDetails {
258-- | Data type used for parsing the mount information from a container
246-- | Data type used for parsing the mount information from a container
259-- list.
247-- list.
260data Mount = Mount {
248data Mount = Mount {
261− mountName :: Maybe Text -- this is optional
249+ mountName :: Text
262 , mountSource :: FilePath
250 , mountSource :: FilePath
263 , mountDestination :: FilePath
251 , mountDestination :: FilePath
264− , mountDriver :: Maybe Text
252+ , mountDriver :: Text
265− -- , mountMode :: Maybe VolumePermission -- apparently this can be null
253+ , mountMode :: Maybe VolumePermission -- apparently this can be null
266 , mountRW :: Bool
254 , mountRW :: Bool
267 , mountPropogation :: Text
255 , mountPropogation :: Text
268 }
256 }
@@ -270,14 +258,14 @@ data Mount = Mount {
270
258
271instance FromJSON Mount where
259instance FromJSON Mount where
272 parseJSON (JSON.Object o) = do
260 parseJSON (JSON.Object o) = do
273− name <- o .:? "Name"
261+ name <- o .: "Name"
274 src <- o .: "Source"
262 src <- o .: "Source"
275 dest <- o .: "Destination"
263 dest <- o .: "Destination"
276− driver <- o .:? "Driver"
264+ driver <- o .: "Driver"
277− -- mode <- o .: "Mode"
265+ mode <- o .: "Mode"
278 rw <- o .: "RW"
266 rw <- o .: "RW"
279 prop <- o .: "Propagation"
267 prop <- o .: "Propagation"
280− return $ Mount name src dest driver rw prop
268+ return $ Mount name src dest driver mode rw prop
281 parseJSON _ = fail "Mount is not an object"
269 parseJSON _ = fail "Mount is not an object"
282
270
283-- | Data type used for parsing the container state from a list of
271-- | Data type used for parsing the container state from a list of
@@ -293,7 +281,7 @@ data ContainerState = ContainerState {
293 , restarting :: Bool
281 , restarting :: Bool
294 , running :: Bool
282 , running :: Bool
295 , startedAt :: UTCTime
283 , startedAt :: UTCTime
296− , state :: State
284+ , status :: Status
297 }
285 }
298 deriving (Eq, Show, Generic)
286 deriving (Eq, Show, Generic)
299
287
@@ -523,8 +511,7 @@ data Container = Container
523 , containerImageId :: ImageID
511 , containerImageId :: ImageID
524 , containerCommand :: Text
512 , containerCommand :: Text
525 , containerCreatedAt :: Int
513 , containerCreatedAt :: Int
526− , containerState :: State
527− , containerStatus :: Maybe Text
514+ , containerStatus :: Status
528 , containerPorts :: [ContainerPortInfo]
515 , containerPorts :: [ContainerPortInfo]
529 , containerLabels :: [Label]
516 , containerLabels :: [Label]
530 , containerNetworks :: [Network]
517 , containerNetworks :: [Network]
@@ -532,14 +519,13 @@ data Container = Container
532 } deriving (Show, Eq)
519 } deriving (Show, Eq)
533
520
534instance FromJSON Container where
521instance FromJSON Container where
535− parseJSON o@(JSON.Object v) =
522+ parseJSON (JSON.Object v) =
536− Container <$> parseJSON o
523+ Container <$> (v .: "Id")
537 <*> (v .: "Names")
524 <*> (v .: "Names")
538 <*> (v .: "Image")
525 <*> (v .: "Image")
539− <*> (v .: "ImageID") -- Doesn't exist anymore
526+ <*> (v .: "ImageID")
540− <*> (v .: "Command") -- Doesn't exist anymore
527+ <*> (v .: "Command")
541 <*> (v .: "Created")
528 <*> (v .: "Created")
542− <*> (v .: "State")
543 <*> (v .: "Status")
529 <*> (v .: "Status")
544 <*> (v .: "Ports")
530 <*> (v .: "Ports")
545 <*> (v .: "Labels")
531 <*> (v .: "Labels")
@@ -549,20 +535,21 @@ instance FromJSON Container where
549 parseNetworks (JSON.Object v) =
535 parseNetworks (JSON.Object v) =
550 (v .: "Networks") >>= parseJSON
536 (v .: "Networks") >>= parseJSON
551 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
537 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
538+
552 parseJSON _ = fail "Container: Not a JSON object."
539 parseJSON _ = fail "Container: Not a JSON object."
553
540
554−-- | Represents the state of the container life cycle.
541+-- | Represents the status of the container life cycle.
555−data State = Created | Restarting | Running | Paused | Exited | Dead
542+data Status = Created | Restarting | Running | Paused | Exited | Dead
556 deriving (Eq, Show, Generic)
543 deriving (Eq, Show, Generic)
557
544
558−instance FromJSON State where
545+instance FromJSON Status where
559 parseJSON (JSON.String "running") = return Running
546 parseJSON (JSON.String "running") = return Running
560 parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.
547 parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.
561 parseJSON (JSON.String "restarting") = return Restarting
548 parseJSON (JSON.String "restarting") = return Restarting
562 parseJSON (JSON.String "paused") = return Paused
549 parseJSON (JSON.String "paused") = return Paused
563 parseJSON (JSON.String "exited") = return Exited
550 parseJSON (JSON.String "exited") = return Exited
564 parseJSON (JSON.String "dead") = return Dead
551 parseJSON (JSON.String "dead") = return Dead
565− parseJSON s = fail $ "Unknown Status: " ++ show s
552+ parseJSON _ = fail "Unknown Status"
566
553
567-- | Alias for representing a RepoDigest. We could newtype this and add
554-- | Alias for representing a RepoDigest. We could newtype this and add
568-- some validation.
555-- some validation.
@@ -623,46 +610,20 @@ instance FromJSON Image where
623 return $ DockerImage imageId imageCreated imageParentId imageRepoTags imageRepoDigests imageSize imageVirtualSize imageLabels
610 return $ DockerImage imageId imageCreated imageParentId imageRepoTags imageRepoDigests imageSize imageVirtualSize imageLabels
624 parseJSON _ = fail "Failed to parse DockerImage."
611 parseJSON _ = fail "Failed to parse DockerImage."
625
612
626−-- | Alias for Aliases.
627−type Alias = Text
628−
629−-- | EndpointsConfig is container configuration for a specific network
630−newtype EndpointConfig = EndpointConfig [Alias] deriving (Eq, Show)
631−
632−instance ToJSON EndpointConfig where
633− toJSON (EndpointConfig aliases) = JSON.object
634− [ "Aliases" .= aliases
635− ]
636−
637−-- | Alias for endpoint name
638−type EndpointName = Text
639−
640−-- | Data type for the NetworkingConfig section of the container settings
641−newtype NetworkingConfig = NetworkingConfig
642− { endpointsConfig :: HM.HashMap EndpointName EndpointConfig
643− } deriving (Eq, Show)
644−
645−instance ToJSON NetworkingConfig where
646− toJSON (NetworkingConfig endpointsConfig) = JSON.object
647− [ "EndpointsConfig" .= endpointsConfig
648− ]
649
613
650-- | Options used for creating a Container.
614-- | Options used for creating a Container.
651data CreateOpts = CreateOpts {
615data CreateOpts = CreateOpts {
652− containerConfig :: ContainerConfig
616+ containerConfig :: ContainerConfig
653− , hostConfig :: HostConfig
617+ , hostConfig :: HostConfig
654− , networkingConfig :: NetworkingConfig
655 } deriving (Eq, Show)
618 } deriving (Eq, Show)
656
619
657instance ToJSON CreateOpts where
620instance ToJSON CreateOpts where
658− toJSON (CreateOpts cc hc nc) = do
621+ toJSON (CreateOpts cc hc) = do
659 let ccJSON = toJSON cc
622 let ccJSON = toJSON cc
660 let hcJSON = toJSON hc
623 let hcJSON = toJSON hc
661 case ccJSON of
624 case ccJSON of
662 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
625 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
663− let o1 = HM.insert "HostConfig" hcJSON o
626+ JSON.Object $ HM.insert "HostConfig" hcJSON o
664− let o2 = HM.insert "NetworkingConfig" (toJSON nc) o1
665− JSON.Object o2
666 _ -> error "ContainerConfig is not an object." -- This should never happen.
627 _ -> error "ContainerConfig is not an object." -- This should never happen.
667
628
668-- | Container configuration used for creating a container with sensible
629-- | Container configuration used for creating a container with sensible
@@ -697,7 +658,7 @@ defaultHostConfig = HostConfig {
697 binds=[]
658 binds=[]
698 , containerIDFile=Nothing
659 , containerIDFile=Nothing
699 , logConfig=LogDriverConfig JsonFile []
660 , logConfig=LogDriverConfig JsonFile []
700− , networkMode=NetworkBridge
661+ , networkMode=Bridge
701 , portBindings=[]
662 , portBindings=[]
702 , restartPolicy=RestartOff
663 , restartPolicy=RestartOff
703 , volumeDriver=Nothing
664 , volumeDriver=Nothing
@@ -737,18 +698,14 @@ defaultContainerResources = ContainerResources {
737 , memory=Nothing
698 , memory=Nothing
738 , memoryReservation=Nothing
699 , memoryReservation=Nothing
739 , memorySwap=Nothing
700 , memorySwap=Nothing
740− , oomKillDisable=Just False
701+ , oomKillDisable=False
741 , ulimits=[]
702 , ulimits=[]
742 }
703 }
743
704
744-- | Default create options when creating a container. You only need to
705-- | Default create options when creating a container. You only need to
745-- specify an image name and the rest is all sensible defaults.
706-- specify an image name and the rest is all sensible defaults.
746defaultCreateOpts :: T.Text -> CreateOpts
707defaultCreateOpts :: T.Text -> CreateOpts
747−defaultCreateOpts imageName = CreateOpts
748− { containerConfig = defaultContainerConfig imageName
708+defaultCreateOpts imageName = CreateOpts { containerConfig = defaultContainerConfig imageName, hostConfig = defaultHostConfig }
749− , hostConfig = defaultHostConfig
750− , networkingConfig = NetworkingConfig HM.empty
751− }
752
709
753-- | Override the key sequence for detaching a container.
710-- | Override the key sequence for detaching a container.
754-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
711-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
@@ -762,7 +719,7 @@ defaultStartOpts :: StartOpts
762defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
719defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
763
720
764-- | Options for deleting a container.
721-- | Options for deleting a container.
765−data ContainerDeleteOpts = ContainerDeleteOpts {
722+data DeleteOpts = DeleteOpts {
766 deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.
723 deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.
767 , force :: Bool -- ^ If the container is still running force deletion anyway.
724 , force :: Bool -- ^ If the container is still running force deletion anyway.
768 } deriving (Eq, Show)
725 } deriving (Eq, Show)
@@ -792,15 +749,8 @@ defaultBuildOpts nameTag = BuildOpts { buildImageName = nameTag
792-- | Default options for deleting a container. Most of the time we DON'T
749-- | Default options for deleting a container. Most of the time we DON'T
793-- want to delete the container's volumes or force delete it if it's
750-- want to delete the container's volumes or force delete it if it's
794-- running.
751-- running.
795−defaultContainerDeleteOpts :: ContainerDeleteOpts
752+defaultDeleteOpts :: DeleteOpts
796−defaultContainerDeleteOpts = ContainerDeleteOpts { deleteVolumes = False, force = False }
753+defaultDeleteOpts = DeleteOpts { deleteVolumes = False, force = False }
797−
798−-- | Image delete opts
799−data ImageDeleteOpts = ImageDeleteOpts deriving (Eq, Show)
800−
801−-- | Sane image deletion defaults
802−defaultImageDeleteOpts :: ImageDeleteOpts
803−defaultImageDeleteOpts = ImageDeleteOpts
804
754
805-- | Timestamp alias.
755-- | Timestamp alias.
806type Timestamp = Integer
756type Timestamp = Integer
@@ -828,36 +778,6 @@ defaultLogOpts = LogOpts { stdout = True
828 , tail = All
778 , tail = All
829 }
779 }
830
780
831−-- | Options for creating a network
832−data CreateNetworkOpts = CreateNetworkOpts
833− { createNetworkName :: Text -- ^ The network's name
834− , createNetworkCheckDuplicate :: Bool -- ^ Check for networks with duplicate names.
835− , createNetworkDriver :: Text -- ^ Name of the network driver plugin to use.
836− , createNetworkInternal :: Bool -- ^ Restrict external access to the network.
837− , createNetworkEnableIPv6 :: Bool -- ^ Enable IPv6 on the network.
838− } deriving (Eq, Show)
839−
840−-- | Sensible defalut for create network options
841−defaultCreateNetworkOpts :: Text -> CreateNetworkOpts
842−defaultCreateNetworkOpts name =
843− CreateNetworkOpts
844− { createNetworkName = name
845− , createNetworkCheckDuplicate = False
846− , createNetworkDriver = "bridge"
847− , createNetworkInternal = True
848− , createNetworkEnableIPv6 = False
849− }
850−
851−instance ToJSON CreateNetworkOpts where
852− toJSON opts =
853− object
854− [ "Name" .= createNetworkName opts
855− , "CheckDuplicate" .= createNetworkCheckDuplicate opts
856− , "Driver" .= createNetworkDriver opts
857− , "Internal" .= createNetworkInternal opts
858− , "EnableIPv6" .= createNetworkEnableIPv6 opts
859− ]
860−
861-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
781-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
862-- | Set permissions on volumes that you mount in the container.
782-- | Set permissions on volumes that you mount in the container.
863data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
783data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
@@ -869,8 +789,6 @@ instance ToJSON VolumePermission where
869instance FromJSON VolumePermission where
789instance FromJSON VolumePermission where
870 parseJSON "rw" = return ReadWrite
790 parseJSON "rw" = return ReadWrite
871 parseJSON "ro" = return ReadOnly
791 parseJSON "ro" = return ReadOnly
872− parseJSON "RW" = return ReadWrite
873− parseJSON "RO" = return ReadOnly
874 parseJSON _ = fail "Failed to parse VolumePermission"
792 parseJSON _ = fail "Failed to parse VolumePermission"
875
793
876-- | Used for marking a directory in the container as "exposed" hence
794-- | Used for marking a directory in the container as "exposed" hence
@@ -1017,41 +935,19 @@ instance FromJSON LogDriverConfig where
1017 parseJSON _ = fail "LogDriverConfig is not an object"
935 parseJSON _ = fail "LogDriverConfig is not an object"
1018
936
1019-- TODO: Add container:<name|id> mode
937-- TODO: Add container:<name|id> mode
1020−data NetworkMode = NetworkBridge | NetworkHost | NetworkDisabled | NetworkNamed Text
938+data NetworkMode = Bridge | Host | NetworkDisabled
1021 deriving (Eq, Show, Ord)
939 deriving (Eq, Show, Ord)
1022
940
1023instance FromJSON NetworkMode where
941instance FromJSON NetworkMode where
1024− parseJSON (JSON.String "bridge") = return NetworkBridge
942+ parseJSON (JSON.String "bridge") = return Bridge
1025− parseJSON (JSON.String "host") = return NetworkHost -- Note: Guessing on these.
943+ parseJSON (JSON.String "host") = return Host -- Note: Guessing on these.
1026 parseJSON (JSON.String "none") = return NetworkDisabled
944 parseJSON (JSON.String "none") = return NetworkDisabled
1027− parseJSON (JSON.String n) = return $ NetworkNamed n
1028 parseJSON _ = fail "Unknown NetworkMode"
945 parseJSON _ = fail "Unknown NetworkMode"
1029
946
1030instance ToJSON NetworkMode where
947instance ToJSON NetworkMode where
1031− toJSON NetworkBridge = JSON.String "bridge"
948+ toJSON Bridge = JSON.String "bridge"
1032− toJSON NetworkHost = JSON.String "host"
949+ toJSON Host = JSON.String "host"
1033− toJSON NetworkDisabled = JSON.String "none"
950+ toJSON NetworkDisabled = JSON.String "none"
1034− toJSON (NetworkNamed n) = JSON.String n
1035−
1036−newtype NetworkID = NetworkID Text
1037− deriving (Eq, Show)
1038−
1039−-- | Used for extracting the id of the container from the newtype
1040−fromNetworkID :: NetworkID -> Text
1041−fromNetworkID (NetworkID t) = t
1042−
1043−-- | Used for parsing a Text value into a NetworkID.
1044−toNetworkID :: Text -> Maybe NetworkID
1045−toNetworkID t = Just $ NetworkID t
1046−
1047−instance FromJSON NetworkID where
1048− parseJSON (JSON.Object o) = do
1049− nid <- o .: "Id"
1050− return $ NetworkID nid
1051− parseJSON _ = fail "NetworkID is not an object."
1052−
1053−instance ToJSON NetworkID where
1054− toJSON (NetworkID nid) = object ["Id" .= nid]
1055
951
1056data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)
952data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)
1057
953
@@ -1414,7 +1310,7 @@ data ContainerResources = ContainerResources {
1414 , memoryReservation :: Maybe MemoryConstraint
1310 , memoryReservation :: Maybe MemoryConstraint
1415 , memorySwap :: Maybe MemoryConstraint
1311 , memorySwap :: Maybe MemoryConstraint
1416 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1312 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1417− , oomKillDisable :: Maybe Bool
1313+ , oomKillDisable :: Bool
1418 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1314 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1419 , ulimits :: [Ulimit]
1315 , ulimits :: [Ulimit]
1420 -- TODO: Missing from 1.24
1316 -- TODO: Missing from 1.24
@@ -1452,7 +1348,7 @@ instance FromJSON EnvVar where
1452 parseJSON _ = fail "EnvVar is not a string"
1348 parseJSON _ = fail "EnvVar is not a string"
1453
1349
1454instance ToJSON EnvVar where
1350instance ToJSON EnvVar where
1455− toJSON (EnvVar n v) = JSON.String $ n <> T.pack "=" <> v
1351+ toJSON (EnvVar n v) = object [n .= v]
1456
1352
1457-- | ExposedPort represents a port (and it's type)
1353-- | ExposedPort represents a port (and it's type)
1458-- that a container should expose to other containers or the host system.
1354-- that a container should expose to other containers or the host system.
@@ -1564,11 +1460,7 @@ instance FromJSON ContainerConfig where
1564 macAddress labels stopSignal
1460 macAddress labels stopSignal
1565 parseJSON _ = fail "NetworkSettings is not an object."
1461 parseJSON _ = fail "NetworkSettings is not an object."
1566
1462
1567−#if MIN_VERSION_base(4,13,0)
1568−parseIntegerText :: (MonadFail m) => Text -> m Integer
1569−#else
1570parseIntegerText :: (Monad m) => Text -> m Integer
1463parseIntegerText :: (Monad m) => Text -> m Integer
1571−#endif
1572parseIntegerText t = case readMaybe $ T.unpack t of
1464parseIntegerText t = case readMaybe $ T.unpack t of
1573 Nothing ->
1465 Nothing ->
1574 fail "Could not parse Integer"
1466 fail "Could not parse Integer"
stack-7.10.yaml+5−5
@@ -1,20 +1,20 @@
1# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
1# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
2
2
3# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.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-6.30
4+resolver: lts-5.18
5
5
6# Local packages, usually specified by relative directory name
6# Local packages, usually specified by relative directory name
7packages:
7packages:
8- '.'
8- '.'
9
9
10+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
11+extra-deps: [directory-1.2.7.0]
12+
10# Override default flag values for local packages and extra-deps
13# Override default flag values for local packages and extra-deps
11flags: {}
14flags: {}
12
15
13# Extra package databases containing global packages
16# Extra package databases containing global packages
14−extra-deps:
17+extra-package-dbs: []
15−- directory-1.2.7.0
16−- unliftio-core-0.1.1.0
17−- process-1.6.5.1
18
18
19# Control whether we use the GHC we find on the path
19# Control whether we use the GHC we find on the path
20# system-ghc: true
20# system-ghc: true
stack-8.0.2.yamldeleted−4
@@ -1,4 +0,0 @@
1−resolver: lts-9.4
2−packages:
3−- '.'
4−extra-deps: []
stack-8.0.yaml+1−2
@@ -1,5 +1,4 @@
1resolver: lts-7.12
1resolver: lts-7.12
2packages:
2packages:
3- '.'
3- '.'
4−extra-deps:
4+extra-deps: []
5−- unliftio-core-0.1.1.0
stack-8.6.4.yamldeleted−4
@@ -1,4 +0,0 @@
1−resolver: lts-13.19
2−packages:
3−- '.'
4−extra-deps: []
stack-8.8.2.yamldeleted−5
@@ -1,5 +0,0 @@
1−resolver: lts-15.0
2−packages:
3−- '.'
4−extra-deps: []
5−
stack.yaml+1−1
@@ -1 +1 @@
1−stack-8.6.4.yaml
1+stack-7.10.yaml
tests/Dockerfile+1−1
@@ -1,4 +1,4 @@
1FROM debian:jessie
1FROM debian:jessie
2
2
3−CMD ["/bin/bash", "-c", "echo $TEST"]
3+CMD ["/bin/bash", "-c", "echo 123"]
4
4
tests/tests.hs+13−117
@@ -2,8 +2,6 @@
2
2
3module Main where
3module Main where
4
4
5−import Data.Either (rights)
6−import Prelude hiding (all)
7import qualified Test.QuickCheck.Monadic as QCM
5import qualified Test.QuickCheck.Monadic as QCM
8import Test.Tasty
6import Test.Tasty
9import Test.Tasty.HUnit
7import Test.Tasty.HUnit
@@ -11,11 +9,9 @@ import Test.Tasty.QuickCheck (testProperty)
11
9
12import Control.Concurrent (threadDelay)
10import Control.Concurrent (threadDelay)
13import Control.Lens ((^.), (^?))
11import Control.Lens ((^.), (^?))
14−import Control.Monad (forM_)
15import Control.Monad.IO.Class
12import Control.Monad.IO.Class
16import Control.Monad.Trans.Class (lift)
13import Control.Monad.Trans.Class (lift)
17import qualified Data.Aeson as JSON
14import qualified Data.Aeson as JSON
18−import Data.Aeson ((.=))
19import Data.Aeson.Lens (key, _Array, _Null, _Object,
15import Data.Aeson.Lens (key, _Array, _Null, _Object,
20 _String, _Value)
16 _String, _Value)
21import qualified Data.ByteString as B
17import qualified Data.ByteString as B
@@ -24,7 +20,7 @@ import qualified Data.ByteString.Lazy as BL
24import qualified Data.HashMap.Strict as HM
20import qualified Data.HashMap.Strict as HM
25import Data.Int (Int)
21import Data.Int (Int)
26import qualified Data.Map as M
22import qualified Data.Map as M
27−import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)
23+import Data.Maybe (fromJust, isJust)
28import Data.Monoid
24import Data.Monoid
29import Data.Text (Text, unpack)
25import Data.Text (Text, unpack)
30import qualified Data.Vector as V
26import qualified Data.Vector as V
@@ -32,15 +28,12 @@ import Network.Connection (TLSSettings (..))
32import Network.HTTP.Client (newManager)
28import Network.HTTP.Client (newManager)
33import Network.HTTP.Client.TLS
29import Network.HTTP.Client.TLS
34import Network.HTTP.Types.Status
30import Network.HTTP.Types.Status
35−import System.Directory (getCurrentDirectory)
36−import System.Environment (lookupEnv)
37import System.Process (system)
31import System.Process (system)
38
32
39import Docker.Client
33import Docker.Client
40
34
41-- opts = defaultClientOpts
35-- opts = defaultClientOpts
42−testImageName = "docker-hs/test"
36+testImageName = "docker-hs-test"
43−imageToDeleteFullName = "hello-world:latest"
44
37
45toStrict1 = B.concat . BL.toChunks
38toStrict1 = B.concat . BL.toChunks
46
39
@@ -60,89 +53,33 @@ testDockerVersion =
60 do v <- getDockerVersion
53 do v <- getDockerVersion
61 lift $ assert $ isRight v
54 lift $ assert $ isRight v
62
55
63−testStopNonexisting :: IO ()
64−testStopNonexisting = runDocker $ do
65− res <- stopContainer DefaultTimeout $ fromJust $ toContainerID "thisshouldnotexist"
66− lift $ assert $ isLeft res
67−
68testFindImage :: IO ()
56testFindImage :: IO ()
69testFindImage =
57testFindImage =
70 runDocker $
58 runDocker $
71 do images <- listImages defaultListOpts >>= fromRight
59 do images <- listImages defaultListOpts >>= fromRight
72− let xs = filter (elem imageFullName . imageRepoTags) images
60+ let xs = filter ((== [imageFullName]) . imageRepoTags) images
73 lift $ assert $ length xs == 1
61 lift $ assert $ length xs == 1
74 where
62 where
75 imageFullName = testImageName <> ":latest"
63 imageFullName = testImageName <> ":latest"
76
64
77−testDeleteImage :: IO ()
78−testDeleteImage = runDocker $ do
79− img <- fmap fromJust findTestImage
80− result <- deleteImage defaultImageDeleteOpts (imageId img)
81− lift $ assert $ isRight result
82− maybeTestImageAfter <- findTestImage
83− lift $ assert $ isNothing maybeTestImageAfter
84− where
85− findTestImage =
86− do
87− images <- listImages defaultListOpts >>= fromRight
88− return $ listToMaybe
89− $ filter (elem imageToDeleteFullName . imageRepoTags) images
90−
91−testListContainers :: IO ()
92−testListContainers =
93− runDocker $
94− do containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
95− c <- fromRight containerId
96− res <- listContainers $ ListOpts { all=True }
97− deleteContainer (ContainerDeleteOpts True True) c
98− lift $ assert $ isRight res
99−
100−testBuildFromDockerfile :: IO ()
101−testBuildFromDockerfile = do
102− cur <- getCurrentDirectory
103− let ctxDir = cur ++ "/tests"
104− runDocker $ do
105− r <- buildImageFromDockerfile (defaultBuildOpts "docker-hs/dockerfile-test") ctxDir
106− lift $ assert $ isRight r
107−
108−
109testRunAndReadLog :: IO ()
65testRunAndReadLog :: IO ()
110−testRunAndReadLog = testRunAndReadLogHelper $ NetworkingConfig HM.empty
66+testRunAndReadLog =
111−
112−testRunAndReadLogWithNetworking :: IO ()
113−testRunAndReadLogWithNetworking = testRunAndReadLogHelper $ NetworkingConfig $ HM.fromList [("test-network", EndpointConfig ["cellar-door"])]
114−
115−testRunAndReadLogHelper :: NetworkingConfig -> IO ()
116−testRunAndReadLogHelper networkingConfig =
117 runDocker $
67 runDocker $
118− do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
68+ do containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
119− createdNetworks <- rights <$> mapM createNetworkWithName networkNames
120− containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
121 c <- fromRight containerId
69 c <- fromRight containerId
122 status1 <- startContainer defaultStartOpts c
70 status1 <- startContainer defaultStartOpts c
123 _ <- inspectContainer c >>= fromRight
71 _ <- inspectContainer c >>= fromRight
124 lift $ threadDelay 300000 -- give 300ms for the application to finish
72 lift $ threadDelay 300000 -- give 300ms for the application to finish
125− lift $ assertBool ("starting the container, unexpected status: " ++ show status1) $ isRightUnit status1
73+ lift $ assert $ isRightUnit status1
74+ status2 <- killContainer SIGTERM c
126 logs <- getContainerLogs defaultLogOpts c >>= fromRight
75 logs <- getContainerLogs defaultLogOpts c >>= fromRight
76+ lift $ assert $ isRightUnit status2
127 lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
77 lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
128− status3 <- deleteContainer (ContainerDeleteOpts True True) c
78+ status3 <- deleteContainer (DeleteOpts True True) c
129− lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3
79+ lift $ assert $ isRightUnit status3
130− mapM_ removeNetwork createdNetworks
131 where
80 where
132 isRightUnit (Right ()) = True
81 isRightUnit (Right ()) = True
133 isRightUnit _ = False
82 isRightUnit _ = False
134− networkNames = HM.keys $ endpointsConfig networkingConfig
135− createNetworkWithName name = createNetwork $
136− (defaultCreateNetworkOpts name) { createNetworkCheckDuplicate = True }
137−
138−testCreateRemoveNetwork :: IO ()
139−testCreateRemoveNetwork = do
140− runDocker $ do
141− createStatus <- createNetwork $ defaultCreateNetworkOpts "test-network"
142− lift $ assertBool ("creating a network, unexpected status: " ++ show createStatus) $ isRight createStatus
143− nid <- fromRight createStatus
144− removeStatus <- removeNetwork nid
145− lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus
146
83
147testLogDriverOptionsJson :: TestTree
84testLogDriverOptionsJson :: TestTree
148testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
85testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
@@ -213,42 +150,13 @@ testEntrypointJson = testGroup "Testing ContainerConfig JSON" [testSample1, test
213 Just (Entrypoint sampleEntrypointArr)
150 Just (Entrypoint sampleEntrypointArr)
214 sampleEntrypointArr = ["cmd", "--some-flag", "--some-flag2"]
151 sampleEntrypointArr = ["cmd", "--some-flag", "--some-flag2"]
215
152
216−testEnvVarJson :: TestTree
217−testEnvVarJson = testGroup "Testing EnvVar JSON" [testSampleEncode, testSampleDecode]
218− where
219− testSampleEncode =
220− testCase "Test toJSON" $ assert $ JSON.toJSON (EnvVar "cellar" "door") == JSON.String "cellar=door"
221− testSampleDecode =
222− testCase "Test fromJSON" $ assert $ (JSON.decode "\"cellar=door\"" :: Maybe EnvVar) ==
223− Just (EnvVar "cellar" "door")
224−
225−testNetworkingConfigJson :: TestTree
226−testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSampleEncode]
227− where
228− testSampleEncode =
229− let networkingConfig = NetworkingConfig $ HM.fromList [("custom-network", EndpointConfig ["cellar", "door"])]
230− in testCase "Test toJSON" $ assert $ JSON.toJSON networkingConfig ==
231− JSON.object
232− [ "EndpointsConfig" .= JSON.object
233− [ "custom-network" .= JSON.object
234− [ "Aliases" .= (["cellar", "door"] :: [Text])
235− ]
236− ]
237− ]
238−
239integrationTests :: TestTree
153integrationTests :: TestTree
240integrationTests =
154integrationTests =
241 testGroup
155 testGroup
242 "Integration Tests"
156 "Integration Tests"
243 [ testCase "Get docker version" testDockerVersion
157 [ testCase "Get docker version" testDockerVersion
244− , testCase "Build image from Dockerfile" testBuildFromDockerfile
245 , testCase "Find image by name" testFindImage
158 , testCase "Find image by name" testFindImage
246− , testCase "Delete image" testDeleteImage
247− , testCase "List containers" testListContainers
248 , testCase "Run a dummy container and read its log" testRunAndReadLog
159 , testCase "Run a dummy container and read its log" testRunAndReadLog
249− , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
250− , testCase "Try to stop a container that doesn't exist" testStopNonexisting
251− , testCase "Create and remove a network" testCreateRemoveNetwork
252 ]
160 ]
253
161
254jsonTests :: TestTree
162jsonTests :: TestTree
@@ -260,18 +168,10 @@ jsonTests =
260 , testLabelsJson
168 , testLabelsJson
261 , testLogDriverOptionsJson
169 , testLogDriverOptionsJson
262 , testEntrypointJson
170 , testEntrypointJson
263− , testEnvVarJson
264− , testNetworkingConfigJson
265 ]
171 ]
266
172
267setup :: IO ()
173setup :: IO ()
268−setup =
269− mapM_ system
270− [ "docker pull " ++ unpack imageToDeleteFullName
271− , "docker build -t " ++ unpack testImageName ++ " tests"
174+setup = system ("docker build -t " ++ unpack testImageName ++ " tests") >> return ()
272− ]
273−
274−isLeft = not . isRight
275
175
276isRight (Left _) = False
176isRight (Left _) = False
277isRight (Right _) = True
177isRight (Right _) = True
@@ -286,9 +186,5 @@ fromRight (Right r) = return r
286
186
287main :: IO ()
187main :: IO ()
288main = do
188main = do
289− stackage <- lookupEnv "RUN_INTEGRATION_TESTS"
290− case stackage of
291− Nothing -> defaultMain $ testGroup "Tests" [jsonTests]
292− Just _ -> do
293− setup
189+ setup
294− defaultMain $ testGroup "Tests" [jsonTests, integrationTests]
190+ defaultMain $ testGroup "Tests" [jsonTests, integrationTests]