master..ffe1210 · docker-hs

git.iko.soy/docker-hs

on ffe1210 help sign in

.gitignore−1

since splitsnapshots

unifiedsplit

@@ -4,4 +4,3 @@

4*~

5.stack-work/

6dist-newstyle

7−/cabal.project.local

.travis.yml+3−31

@@ -1,12 +1,6 @@

1sudo: required

2dist: trusty

4−# Only build master and release tags

5−branches:

6− only:

7− - master

8− - /^v\d+\.\d+(\.\d+)?(-\S*)?$/

9−

10# Choose a lightweight base image; we provide our own build tools.

4# Choose a lightweight base image; we provide our own build tools.

11language:

5language:

12 c

6 c

@@ -22,30 +16,8 @@ services:

22 - docker

16 - docker

24env:

18env:

25− global:

19+ - GHCVER=7.10 STACK_ARGS=""

26− - RUN_INTEGRATION_TESTS=1

20+ - 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

50addons:

22addons:

51 apt:

23 apt:

@@ -57,7 +29,7 @@ before_install:

57 - 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'

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

59 - sudo apt-get update

31 - sudo apt-get update

60− - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=$DOCKER_VERSION

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

62install:

34install:

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

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

CHANGELOG.md−71

@@ -1,76 +1,5 @@

1# CHANGELOG

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)

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

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.

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

3All rights reserved.

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

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)

11−## Run build

12build:

9build:

13 @stack build

10 @stack build

15−## Run repl

16repl:

12repl:

17 @stack repl

13 @stack repl

19−## Run tests. Example RUN_INTEGRATION_TESTS=1 make test

20test:

15test:

21− @RUN_INTEGRATION_TESTS=1 stack test

16+ @stack test

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"

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+10−37

@@ -1,48 +1,21 @@

1# An API client for docker written in Haskell

3−| Master |

3+| Master | Dev |

4−| -------|

4+| -------| ---- |

5−| [![master](https://travis-ci.org/denibertovic/docker-hs.svg?branch=master)](https://travis-ci.org/denibertovic/docker-hs) |

5+| [![master](https://travis-ci.org/denibertovic/docker-hs.svg?branch=master)](https://travis-ci.org/denibertovic/docker-hs) | [![dev](https://travis-ci.org/denibertovic/docker-hs.svg?branch=dev)](https://travis-ci.org/denibertovic/docker-hs) |

8## Current state

10−Supported Docker Engine Api version: `v1.24` and onwards.

10+**API is still not stable.**

11−

11+We're looking to stabilize the API after the next release (0.4.0.0)

12−Anything upward of that should work since Docker versions their API.

13−Older docker version and engine api versions are not supported at the moment.

14−

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

22## Contributing

13## Contributing

24−Please see [CONTRIBUTING.md](CONTRIBUTING.md).

15+If you wish to contribute please see any issue tagged with "help wanted".

25−

16+Make sure to submit your PR's against the `dev` branch.

26−### Project Setup

27−

28−For working on the library, you need the Haskell Tool Stack installed (see [the

29−Haskell Tool Stack

30−website](https://docs.haskellstack.org/en/stable/install_and_upgrade/)). You

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−

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`.

45−## IRC

18+Please consider filling an Issue first and discuss design decisions and implementation details before

19+writing any code. This is so that no development cycles go to waste on implementing a feature that

20+might not get merged either because of implementation details or other reasons.

47−If you have any questions or suggestions you can find the maintainers in `#docker-haskell`

48−on freenode.

docker.cabal+12−26

@@ -1,5 +1,5 @@

1name: docker

2−version: 0.6.0.3

2+version: 0.3.0.1

3synopsis: An API client for docker written in Haskell

4description: See API documentation below.

5homepage: https://github.com/denibertovic/docker-hs

@@ -14,29 +14,24 @@ extra-source-files: README.md

14cabal-version: >=1.10

15stability: experimental

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

36 , conduit

30 , conduit

37 , conduit-combinators

31 , conduit-combinators

38 , conduit-extra

32 , conduit-extra

39 , exceptions

33 , exceptions

34+ , http-conduit

40 , monad-control

35 , monad-control

41 , resourcet

36 , resourcet

42 , transformers

37 , transformers

@@ -51,20 +46,13 @@ library

51 , mtl >= 2.0.0 && < 3.0.0

46 , mtl >= 2.0.0 && < 3.0.0

52 , network >= 2.6.0

47 , network >= 2.6.0

53 , text >= 1.0.0 && < 2.0.0

48 , text >= 1.0.0 && < 2.0.0

54− , time >= 1.5.0 && < 2.0.0

49+ , time >= 1.5.0 && < 1.7.0

55 , scientific >= 0.3.0 && < 0.4.0

50 , scientific >= 0.3.0 && < 0.4.0

56− , tls >= 1.3.7 && < 1.6.0

51+ , tls >= 1.3.7 && < 1.4.0

57 , unordered-containers >= 0.2.0 && < 0.3.0

52 , unordered-containers >= 0.2.0 && < 0.3.0

58− , x509 >= 1.6.0 && < 1.8.0

53+ , x509 >= 1.6.0 && < 1.7.0

59− , x509-store >= 1.6.0 && < 1.8.0

54+ , x509-store >= 1.6.0 && < 1.7.0

60− , x509-system >= 1.6.0 && < 1.8.0

55+ , 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

56 default-language: Haskell2010

69 ghc-options: -Wall -fno-warn-name-shadowing

57 ghc-options: -Wall -fno-warn-name-shadowing

@@ -73,7 +61,6 @@ test-suite docker-hs-tests

73 , bytestring

61 , bytestring

74 , connection

62 , connection

75 , docker

63 , docker

76− , directory

77 , aeson

64 , aeson

78 , containers

65 , containers

79 , unordered-containers

66 , unordered-containers

@@ -89,7 +76,6 @@ test-suite docker-hs-tests

89 , transformers

76 , transformers

90 , QuickCheck

77 , QuickCheck

91 , process

78 , process

92− , vector

93 type: exitcode-stdio-1.0

79 type: exitcode-stdio-1.0

94 main-is: tests.hs

80 main-is: tests.hs

95 hs-source-dirs: tests

81 hs-source-dirs: tests

examples/Example.hs+43−52

@@ -1,64 +1,55 @@

1import Docker.Client

3runNginxContainer :: IO ContainerID

4−runNginxContainer = do

5− h <- defaultHttpHandler

6− runDockerT (defaultClientOpts, h) $

4+runNginxContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

7− do let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]

5+ let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]

8− let myCreateOpts = addPortBinding pb $ defaultCreateOpts "nginx:latest"

6+ let myCreateOpts = addPortBinding pb $ defaultCreateOpts "nginx:latest"

9− cid <- createContainer myCreateOpts (Just "myNginxContainer")

7+ cid <- createContainer myCreateOpts (Just "myNginxContainer")

10− case cid of

8+ case cid of

11− Left err -> error $ show err

9+ Left err -> error $ show err

12− Right i -> do

10+ Right i -> do

13− _ <- startContainer defaultStartOpts i

11+ _ <- startContainer defaultStartOpts i

14− return i

12+ return i

16stopNginxContainer :: ContainerID -> IO ()

14stopNginxContainer :: ContainerID -> IO ()

17−stopNginxContainer cid = do

18− h <- defaultHttpHandler

19− runDockerT (defaultClientOpts, h) $

15+stopNginxContainer cid = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

20− do r <- stopContainer DefaultTimeout cid

16+ r <- stopContainer DefaultTimeout cid

21− case r of

17+ case r of

22− Left _ -> error "I failed to stop the container"

18+ Left _ -> error "I failed to stop the container"

23− Right _ -> return ()

19+ Right _ -> return ()

25runPostgresContainer :: IO ContainerID

21runPostgresContainer :: IO ContainerID

26−runPostgresContainer = do

27− h <- defaultHttpHandler

28− runDockerT (defaultClientOpts, h) $

22+runPostgresContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

29− do let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

23+ let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

30− let b = Bind "/tmp" "/tmp" Nothing

24+ let b = Bind "/tmp" "/tmp" Nothing

31− let myCreateOpts = addBind b $ addPortBinding pb $ defaultCreateOpts "postgres:9.5"

25+ let myCreateOpts = addBind b $ addPortBinding pb $ defaultCreateOpts "postgres:9.5"

32− cid <- createContainer myCreateOpts Nothing

26+ cid <- createContainer myCreateOpts Nothing

33− case cid of

27+ case cid of

34− Left err -> error $ show err

28+ Left err -> error $ show err

35− Right i -> do

29+ Right i -> do

36− _ <- startContainer defaultStartOpts i

30+ _ <- startContainer defaultStartOpts i

37− return i

31+ return i

39-- | Example of how we can start a database container while hosting it's

33-- | Example of how we can start a database container while hosting it's

40-- data in a data volume living inside another container.

34-- data in a data volume living inside another container.

41runPostgresWithDataContainer :: IO ContainerID

35runPostgresWithDataContainer :: IO ContainerID

42−runPostgresWithDataContainer = do

36+runPostgresWithDataContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

43− h <- defaultHttpHandler

44− runDockerT (defaultClientOpts, h) $

45− -- We use a dummy command like /bin/true because we don't want to start

37+ -- We use a dummy command like /bin/true because we don't want to start

46− -- the postgres database in the data container we just want it to

38+ -- the postgres database in the data container we just want it to

47− -- create a container filesystem for us.

39+ -- create a container filesystem for us.

48− do let dataOpts = setCmd "/bin/true" $ defaultCreateOpts "postgres:9.5"

40+ let dataOpts = setCmd "/bin/true" $ defaultCreateOpts "postgres:9.5"

49− cid <- createContainer dataOpts (Just "myDataContainer")

41+ cid <- createContainer dataOpts (Just "myDataContainer")

50− _ <-

51− case cid of

42+ _ <- case cid of

52− Left err -> error $ show err

43+ Left err -> error $ show err

53− Right i -> startContainer defaultStartOpts i

44+ Right i -> startContainer defaultStartOpts i

54− let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

45+ let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

55− -- Default permission is read-write if we don't specify anything

46+ -- Default permission is read-write if we don't specify anything

56− let vf = VolumeFrom "myDataContainer" Nothing

47+ let vf = VolumeFrom "myDataContainer" Nothing

57− let myCreateOpts = addVolumeFrom vf $ addPortBinding pb $ defaultCreateOpts "postgres:9.5"

48+ let myCreateOpts = addVolumeFrom vf $ addPortBinding pb $ defaultCreateOpts "postgres:9.5"

58− ccid <- createContainer myCreateOpts (Just "pgContainer")

49+ ccid <- createContainer myCreateOpts (Just "pgContainer")

59− case ccid of

50+ case ccid of

60− Left err -> error $ show err

51+ Left err -> error $ show err

61− Right i -> do

52+ Right i -> do

62− _ <- startContainer defaultStartOpts i

53+ _ <- startContainer defaultStartOpts i

63− return i

54+ return i

src/Docker/Client.hs+5−12

@@ -3,7 +3,7 @@

4{-|

5Module : Docker.Client

6−Copyright : (c) Deni Bertovic, 2014

6+Copyright : (c) Deni Bertovic, 2016

7License : BSD3

8Maintainer : deni@denibertovic.com

9Stability : experimental

@@ -20,9 +20,7 @@ the host.

20import Docker.Client

22runNginxContainer :: IO ContainerID

23−runNginxContainer = do

24− h <- defaultHttpHandler

25− runDockerT (defaultClientOpts, h) $ do

23+runNginxContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

26 let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]

24 let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]

27 let myCreateOpts = addPortBinding pb $ defaultCreateOpts "nginx:latest"

25 let myCreateOpts = addPortBinding pb $ defaultCreateOpts "nginx:latest"

28 cid <- createContainer myCreateOpts

26 cid <- createContainer myCreateOpts

@@ -44,9 +42,7 @@ Let's stop the container now:

45@

43@

46stopNginxContainer :: ContainerID -> IO ()

44stopNginxContainer :: ContainerID -> IO ()

47−stopNginxContainer cid = do

48− h <- defaultHttpHandler

49− runDockerT (defaultClientOpts, h) $ do

45+stopNginxContainer cid = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

50 r <- stopContainer DefaultTimeout cid

46 r <- stopContainer DefaultTimeout cid

51 case r of

47 case r of

52 Left err -> error "I failed to stop the container"

48 Left err -> error "I failed to stop the container"

@@ -61,9 +57,7 @@ persist on the host file system.

62@

58@

63runPostgresContainer :: IO ContainerID

59runPostgresContainer :: IO ContainerID

64−runPostgresContainer = do

65− h <- defaultHttpHandler

66− runDockerT (defaultClientOpts, h) $ do

60+runPostgresContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

67 let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

61 let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

68 let myCreateOpts = addBinds [Bind "\/tmp" "\/tmp" Nothing] $ addPortBinding pb $ defaultCreateOpts "postgres:9.5"

62 let myCreateOpts = addBinds [Bind "\/tmp" "\/tmp" Nothing] $ addPortBinding pb $ defaultCreateOpts "postgres:9.5"

69 cid <- createContainer myCreateOpts

63 cid <- createContainer myCreateOpts

@@ -76,8 +70,7 @@ runPostgresContainer = do

77= Get Docker API Version

71= Get Docker API Version

79−>>> h <- defaultHttpHandler

80−>>> runDockerT (defaultClientOpts, h) $ getDockerVersion

73+>>> runDockerT (defaultClientOpts, defaultHttpHandler) $ getDockerVersion

81Right (DockerVersion {version = "1.12.0", apiVersion = "1.24", gitCommit = "8eab29e", goVersion = "go1.6.3", os = "linux", arch = "amd64", kernelVersion = "4.6.0-1-amd64", buildTime = "2016-07-28T21:46:40.664812891+00:00"})

74Right (DockerVersion {version = "1.12.0", apiVersion = "1.24", gitCommit = "8eab29e", goVersion = "go1.6.3", os = "linux", arch = "amd64", kernelVersion = "4.6.0-1-amd64", buildTime = "2016-07-28T21:46:40.664812891+00:00"})

83= Setup SSL Authentication

76= Setup SSL Authentication

src/Docker/Client/Api.hs+14−66

@@ -18,17 +18,12 @@ module Docker.Client.Api (

18 , getContainerLogsStream

19 -- * Images

20 , listImages

21− , deleteImage

22 , buildImageFromDockerfile

21 , buildImageFromDockerfile

23− , pullImage

24− -- * Network

25− , createNetwork

26− , removeNetwork

27 -- * Other

22 -- * Other

28 , getDockerVersion

23 , getDockerVersion

29 ) where

24 ) where

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

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

32import Control.Monad.IO.Class

27import Control.Monad.IO.Class

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

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

34import Data.Aeson (FromJSON, eitherDecode')

29import Data.Aeson (FromJSON, eitherDecode')

@@ -36,18 +31,17 @@ import qualified Data.ByteString as BS

36import qualified Data.ByteString.Lazy as BSL

31import qualified Data.ByteString.Lazy as BSL

37import Data.Conduit (Sink)

32import Data.Conduit (Sink)

38import qualified Data.Conduit.Binary as Conduit

33import qualified Data.Conduit.Binary as Conduit

39−import qualified Data.Text as T

40import qualified Data.Text as Text

34import qualified Data.Text as Text

41−import Network.HTTP.Client (responseStatus)

35+import Network.HTTP.Client (responseStatus)

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

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

43−import System.Exit (ExitCode (..))

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

45import Docker.Client.Http

39import Docker.Client.Http

46import Docker.Client.Types

40import Docker.Client.Types

47import Docker.Client.Utils

41import Docker.Client.Utils

49requestUnit :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())

43requestUnit :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError ())

50−requestUnit verb endpoint = fmap (const ()) <$> requestHelper verb endpoint

44+requestUnit verb endpoint = const (Right ()) <$> requestHelper verb endpoint

52requestHelper :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError BSL.ByteString)

46requestHelper :: (MonadIO m, MonadMask m) => HttpVerb -> Endpoint -> DockerT m (Either DockerError BSL.ByteString)

53requestHelper verb endpoint = requestHelper' verb endpoint Conduit.sinkLbs

47requestHelper verb endpoint = requestHelper' verb endpoint Conduit.sinkLbs

@@ -60,8 +54,8 @@ requestHelper' verb endpoint sink = do

60 return $ Left $ DockerInvalidRequest endpoint

54 return $ Left $ DockerInvalidRequest endpoint

61 Just request -> do

55 Just request -> do

62 -- JP: Do we need runResourceT?

56 -- JP: Do we need runResourceT?

63− -- lift $ NHS.httpSink request $ \response ->

57+ -- lift $ NHS.httpSink request $ \response ->

64− lift $ httpHandler request $ \response ->

58+ lift $ httpHandler request $ \response ->

65 -- Check status code.

59 -- Check status code.

66 let status = responseStatus response in

60 let status = responseStatus response in

67 case statusCodeToError endpoint status of

61 case statusCodeToError endpoint status of

@@ -94,12 +88,6 @@ listContainers opts = requestHelper GET (ListContainersEndpoint opts) >>= parseR

94listImages :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Image])

88listImages :: forall m. (MonadIO m, MonadMask m) => ListOpts -> DockerT m (Either DockerError [Image])

95listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse

89listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse

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

91-- | Creates a docker container but does __not__ start it. See

104-- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'

92-- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'

105-- for some sane defaults.

93-- for some sane defaults.

@@ -145,9 +133,9 @@ unpauseContainer :: forall m. (MonadIO m, MonadMask m) => ContainerID -> DockerT

145unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

133unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

146

134

147-- | Deletes a container with the given 'ContainerID'.

135-- | Deletes a container with the given 'ContainerID'.

148−-- See "ContainerDeleteOpts" for options and use 'defaultContainerDeleteOpts' for sane

136+-- See "DeleteOpts" for options and use 'defaultDeleteOpts' for sane

149-- defaults.

137-- defaults.

150−deleteContainer :: forall m. (MonadIO m, MonadMask m) => ContainerDeleteOpts -> ContainerID -> DockerT m (Either DockerError ())

138+deleteContainer :: forall m. (MonadIO m, MonadMask m) => DeleteOpts -> ContainerID -> DockerT m (Either DockerError ())

151deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

139deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

152

140

153-- | Gets 'ContainerDetails' for a given 'ContainerID'.

141-- | Gets 'ContainerDetails' for a given 'ContainerID'.

@@ -161,67 +149,27 @@ inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= pars

161-- See 'LogOpts' for options that you can pass and

149-- See 'LogOpts' for options that you can pass and

162-- 'defaultLogOpts' for sane defaults.

150-- 'defaultLogOpts' for sane defaults.

163--

151--

152+-- __NOTE__: Currently streaming logs is

164−-- __NOTE__: his function will fetch the entire log that the

153+-- not supported and this function will fetch the entire log that the

165-- container produced in the json-file on disk. Depending on the logging

154-- container produced in the json-file on disk. Depending on the logging

166-- setup of the process in your container this can be a significant amount

155-- setup of the process in your container this can be a significant amount

167-- which might block your application...so use with caution.

156-- which might block your application...so use with caution.

168--

157--

169−-- If you want to stream the logs from the container continuosly then use

170−-- 'getContainerLogsStream'

171−--

172−-- __NOTE__: It's recommended to use one of the other 'LogDriverType's available (like

158+-- The recommended method is to use one of the other 'LogDriverType's available (like

173-- syslog) for creating your containers.

159-- syslog) for creating your containers.

174getContainerLogs :: forall m. (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)

160getContainerLogs :: forall m. (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString)

175getContainerLogs logopts cid = requestHelper GET (ContainerLogsEndpoint logopts False cid)

161getContainerLogs logopts cid = requestHelper GET (ContainerLogsEndpoint logopts False cid)

176

162

177−{-| Continuously gets the container's logs as a stream. Uses conduit.

178−

179−__Example__:

180−

181−@

182−>>> import Docker.Client

183−>>> import Data.Maybe

184−>>> import Conduit

185−>>> h <- defaultHttpHanlder

186−>>> let cid = fromJust $ toContainerID "fee86e1d522b"

187−>>> runDockerT (defaultClientOpts, h) $ getContainerLogsStream defaultLogOpts cid stdoutC

188−@

189−

190−-}

191getContainerLogsStream :: forall m b . (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)

163getContainerLogsStream :: forall m b . (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)

192−getContainerLogsStream logopts cid = requestHelper' GET (ContainerLogsEndpoint logopts True cid)

164+getContainerLogsStream logopts cid sink = requestHelper' GET (ContainerLogsEndpoint logopts True cid) sink

193-- JP: Should the second (follow) argument be True? XXX

165-- JP: Should the second (follow) argument be True? XXX

194

166

195−-- | Build an Image from a Dockerfile

196−--

197-- TODO: Add X-Registry-Config

167-- TODO: Add X-Registry-Config

198−--

199-- TODO: Add support for remote URLs to a Dockerfile

168-- TODO: Add support for remote URLs to a Dockerfile

200−--

201-- TODO: Clean up temp tar.gz file after the image is built

169-- TODO: Clean up temp tar.gz file after the image is built

202buildImageFromDockerfile :: forall m. (MonadIO m, MonadMask m) => BuildOpts -> FilePath -> DockerT m (Either DockerError ())

170buildImageFromDockerfile :: forall m. (MonadIO m, MonadMask m) => BuildOpts -> FilePath -> DockerT m (Either DockerError ())

203buildImageFromDockerfile opts base = do

171buildImageFromDockerfile opts base = do

204 ctx <- makeBuildContext $ BuildContextRootDir base

172 ctx <- makeBuildContext $ BuildContextRootDir base

205 case ctx of

173 case ctx of

206− Left e -> return $ Left e

174+ Left e -> return $ Left e

207 Right c -> requestUnit POST (BuildImageEndpoint opts c)

175 Right c -> requestUnit POST (BuildImageEndpoint opts c)

208−

209−-- | Pulls an image from Docker Hub (by default).

210−--

211−-- TODO: Add support for X-Registry-Auth and pulling from private docker

212−-- registries.

213−--

214−-- TODO: Implement importImage function that uses he same

215−-- CreateImageEndpoint but rather than pulling from docker hub it imports

216−-- the image from a tarball or a URL.

217−pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b)

218−pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing)

219−

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+13−51

@@ -4,11 +4,8 @@

4module Docker.Client.Http where

6-- import Control.Monad.Base (MonadBase(..), liftBaseDefault)

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

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

8−#if MIN_VERSION_http_conduit(2,3,0)

9−import Control.Monad.IO.Unlift (MonadUnliftIO)

10−#endif

11−import Control.Monad.Reader (ReaderT (..), runReaderT)

8+import 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

14import Data.Conduit (Sink)

11import Data.Conduit (Sink)

@@ -20,13 +17,13 @@ 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)

27−import qualified Network.HTTP.Simple as NHS

28import Network.HTTP.Types (StdMethod, status101, status200,

24import Network.HTTP.Types (StdMethod, status101, status200,

29 status201, status204)

25 status201, status204)

26+import qualified Network.HTTP.Simple as NHS

30import Network.TLS (ClientHooks (..),

27import Network.TLS (ClientHooks (..),

31 ClientParams (..), Shared (..),

28 ClientParams (..), Shared (..),

32 Supported (..),

29 Supported (..),

@@ -48,7 +45,7 @@ import Docker.Client.Internal (getEndpoint,

48 getEndpointContentType,

45 getEndpointContentType,

49 getEndpointRequestBody)

46 getEndpointRequestBody)

50import Docker.Client.Types (DockerClientOpts, Endpoint (..),

47import Docker.Client.Types (DockerClientOpts, Endpoint (..),

51− apiVer, baseUrl)

48+ baseUrl)

53type Request = HTTP.Request

50type Request = HTTP.Request

54type Response = HTTP.Response BL.ByteString

51type Response = HTTP.Response BL.ByteString

@@ -96,8 +93,8 @@ runDockerT (opts, h) r = runReaderT (unDockerT r) (opts, h)

96-- benefit from testing that on all of our Endpoints

93-- benefit from testing that on all of our Endpoints

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

124−httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..

113+httpHandler 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?

@@ -268,23 +249,4 @@ statusCodeToError (BuildImageEndpoint _ _) st =

268 Nothing

249 Nothing

269 else

250 else

270 Just $ DockerInvalidStatusCode st

251 Just $ DockerInvalidStatusCode st

271−statusCodeToError (CreateImageEndpoint _ _ _) st =

252+

272− if st == status200 then

273− Nothing

274− else

275− Just $ DockerInvalidStatusCode st

276−statusCodeToError (DeleteImageEndpoint _ _) st =

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+25−39

@@ -5,13 +5,12 @@ import qualified Data.Aeson as JSON

5import Data.ByteString (ByteString)

6import qualified Data.ByteString.Char8 as BSC

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)

10import qualified Network.HTTP.Client as HTTP

11import Network.HTTP.Conduit (requestBodySourceChunked)

12import Network.HTTP.Types (Query, encodePath,

13 encodePathSegments)

14−import Prelude hiding (all)

16import Docker.Client.Types

15import Docker.Client.Types

@@ -25,44 +24,44 @@ encodeURLWithQuery ps q = decodeUtf8 $ toByteString $ encodePath ps q

25encodeQ :: String -> ByteString

24encodeQ :: String -> ByteString

26encodeQ = encodeUtf8 . T.pack

25encodeQ = encodeUtf8 . T.pack

28−getEndpoint :: ApiVersion -> Endpoint -> T.Text

27+getEndpoint :: Endpoint -> T.Text

29−getEndpoint v VersionEndpoint = encodeURL [v, "version"]

28+getEndpoint VersionEndpoint = encodeURL ["version"]

30−getEndpoint v (ListContainersEndpoint (ListOpts all)) = encodeURLWithQuery [v, "containers", "json"] [("all", Just (encodeQ $ show all))]

29+getEndpoint (ListContainersEndpoint _) = encodeURL ["containers", "json"] -- Make use of lsOpts here

31−getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here

30+getEndpoint (ListImagesEndpoint _) = encodeURL ["images", "json"] -- Make use of lsOpts here

32−getEndpoint v (CreateContainerEndpoint _ cn) = case cn of

31+getEndpoint (CreateContainerEndpoint _ cn) = case cn of

33− Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]

32+ Just cn -> encodeURLWithQuery ["containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]

34− Nothing -> encodeURL [v, "containers", "create"]

33+ Nothing -> encodeURL ["containers", "create"]

35−getEndpoint v (StartContainerEndpoint startOpts cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "start"] query

34+getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query

36 where query = case (detachKeys startOpts) of

35 where query = case (detachKeys startOpts) of

37 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]

36 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]

38 WithoutCtrl c -> [("detachKeys", Just (encodeQ [c]))]

37 WithoutCtrl c -> [("detachKeys", Just (encodeQ [c]))]

39 DefaultDetachKey -> []

38 DefaultDetachKey -> []

40 ctrl = ['c', 't', 'r', 'l', '-']

39 ctrl = ['c', 't', 'r', 'l', '-']

41−getEndpoint v (StopContainerEndpoint t cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "stop"] query

40+getEndpoint (StopContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "stop"] query

42 where query = case t of

41 where query = case t of

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

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

44 DefaultTimeout -> []

43 DefaultTimeout -> []

45−getEndpoint v (WaitContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "wait"]

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

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

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

47 where query = case s of

46 where query = case s of

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

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

49− _ -> [("signal", Just (encodeQ $ show s))]

48+ _ -> [("signal", Just (encodeQ $ show s))]

50−getEndpoint v (RestartContainerEndpoint t cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "restart"] query

49+getEndpoint (RestartContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "restart"] query

51 where query = case t of

50 where query = case t of

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

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

53 DefaultTimeout -> []

52 DefaultTimeout -> []

54−getEndpoint v (PauseContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "pause"]

53+getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "pause"]

55−getEndpoint v (UnpauseContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "unpause"]

54+getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "unpause"]

56-- Make use of since/timestamps/tail logopts here instead of ignoreing them

55-- Make use of since/timestamps/tail logopts here instead of ignoreing them

57−getEndpoint v (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =

56+getEndpoint (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =

58− encodeURLWithQuery [v, "containers", fromContainerID cid, "logs"] query

57+ encodeURLWithQuery ["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 (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =

61− encodeURLWithQuery [v, "containers", fromContainerID cid] query

60+ encodeURLWithQuery ["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))]

63−getEndpoint v (InspectContainerEndpoint cid) =

62+getEndpoint (InspectContainerEndpoint cid) =

64− encodeURLWithQuery [v, "containers", fromContainerID cid, "json"] []

63+ encodeURLWithQuery ["containers", fromContainerID cid, "json"] []

65−getEndpoint v (BuildImageEndpoint o _) = encodeURLWithQuery [v, "build"] query

64+getEndpoint (BuildImageEndpoint o _) = encodeURLWithQuery ["build"] query

66 where query = [("t", Just t), ("dockerfile", Just dockerfile), ("q", Just q), ("nocache", Just nocache), ("rm", Just rm), ("forcerm", Just forcerm), ("pull", Just pull)]

65 where query = [("t", Just t), ("dockerfile", Just dockerfile), ("q", Just q), ("nocache", Just nocache), ("rm", Just rm), ("forcerm", Just forcerm), ("pull", Just pull)]

67 t = encodeQ $ T.unpack $ buildImageName o

66 t = encodeQ $ T.unpack $ buildImageName o

68 dockerfile = encodeQ $ T.unpack $ buildDockerfileName o

67 dockerfile = encodeQ $ T.unpack $ buildDockerfileName o

@@ -71,13 +70,6 @@ getEndpoint v (BuildImageEndpoint o _) = encodeURLWithQuery [v, "build"] query

71 rm = encodeQ $ show $ buildRemoveItermediate o

70 rm = encodeQ $ show $ buildRemoveItermediate o

72 forcerm = encodeQ $ show $ buildForceRemoveIntermediate o

71 forcerm = encodeQ $ show $ buildForceRemoveIntermediate o

73 pull = encodeQ $ show $ buildPullParent o

72 pull = encodeQ $ show $ buildPullParent o

74−getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images", "create"] query

75− where query = [("fromImage", Just n), ("tag", Just t)]

76− n = encodeQ $ T.unpack name

77− 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]

82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

74getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

83getEndpointRequestBody VersionEndpoint = Nothing

75getEndpointRequestBody VersionEndpoint = Nothing

@@ -94,13 +86,7 @@ getEndpointRequestBody (UnpauseContainerEndpoint _) = Nothing

94getEndpointRequestBody (ContainerLogsEndpoint _ _ _) = Nothing

86getEndpointRequestBody (ContainerLogsEndpoint _ _ _) = Nothing

95getEndpointRequestBody (DeleteContainerEndpoint _ _) = Nothing

87getEndpointRequestBody (DeleteContainerEndpoint _ _) = Nothing

96getEndpointRequestBody (InspectContainerEndpoint _) = Nothing

88getEndpointRequestBody (InspectContainerEndpoint _) = Nothing

97−

98getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp

89getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp

99−getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing

100−getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing

101−

102−getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)

103−getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

104

105getEndpointContentType :: Endpoint -> BSC.ByteString

91getEndpointContentType :: Endpoint -> BSC.ByteString

106getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"

92getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"

src/Docker/Client/Types.hs+89−215

@@ -11,9 +11,6 @@ module Docker.Client.Types (

11 , ImageID

12 , fromImageID

13 , toImageID

14− , NetworkID

15− , fromNetworkID

16− , toNetworkID

17 , Timeout(..)

14 , Timeout(..)

18 , StatusCode(..)

15 , StatusCode(..)

19 , Signal(..)

16 , Signal(..)

@@ -26,12 +23,11 @@ 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

33 , Image(..)

30 , Image(..)

34− , Entrypoint(..)

35 , dropImagePrefix

31 , dropImagePrefix

36 , CreateOpts(..)

32 , CreateOpts(..)

37 , BuildOpts(..)

33 , BuildOpts(..)

@@ -40,16 +36,12 @@ module Docker.Client.Types (

40 , DetachKeys(..)

36 , DetachKeys(..)

41 , StartOpts(..)

37 , StartOpts(..)

42 , defaultStartOpts

38 , defaultStartOpts

43− , ContainerDeleteOpts(..)

39+ , DeleteOpts(..)

44− , defaultContainerDeleteOpts

40+ , defaultDeleteOpts

45− , ImageDeleteOpts(..)

46− , defaultImageDeleteOpts

47 , Timestamp

41 , Timestamp

48 , TailLogOpt(..)

42 , TailLogOpt(..)

49 , LogOpts(..)

43 , LogOpts(..)

50 , defaultLogOpts

44 , defaultLogOpts

51− , CreateNetworkOpts(..)

52− , defaultCreateNetworkOpts

53 , VolumePermission(..)

45 , VolumePermission(..)

54 , Bind(..)

46 , Bind(..)

55 , Volume(..)

47 , Volume(..)

@@ -75,8 +67,6 @@ module Docker.Client.Types (

75 , UTSMode(..)

67 , UTSMode(..)

76 , HostConfig(..)

68 , HostConfig(..)

77 , defaultHostConfig

69 , defaultHostConfig

78− , NetworkingConfig(..)

79− , EndpointConfig(..)

80 , Ulimit(..)

70 , Ulimit(..)

81 , ContainerResources(..)

71 , ContainerResources(..)

82 , defaultContainerResources

72 , defaultContainerResources

@@ -112,7 +102,6 @@ import Data.Scientific (floatingOrInteger)

112import Data.Text (Text)

102import Data.Text (Text)

113import qualified Data.Text as T

103import qualified Data.Text as T

114import Data.Time.Clock (UTCTime)

104import Data.Time.Clock (UTCTime)

115−import qualified Data.Vector as V

116import GHC.Generics (Generic)

105import GHC.Generics (Generic)

117import Prelude hiding (all, tail)

106import Prelude hiding (all, tail)

118import Text.Read (readMaybe)

107import Text.Read (readMaybe)

@@ -132,13 +121,9 @@ data Endpoint =

132 | UnpauseContainerEndpoint ContainerID

121 | UnpauseContainerEndpoint ContainerID

133 | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.

122 | 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.

123 -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.

135− | DeleteContainerEndpoint ContainerDeleteOpts ContainerID

124+ | DeleteContainerEndpoint DeleteOpts ContainerID

136 | InspectContainerEndpoint ContainerID

125 | InspectContainerEndpoint ContainerID

137 | BuildImageEndpoint BuildOpts FilePath

126 | 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)

139− | DeleteImageEndpoint ImageDeleteOpts ImageID

140− | CreateNetworkEndpoint CreateNetworkOpts

141− | RemoveNetworkEndpoint NetworkID

142 deriving (Eq, Show)

127 deriving (Eq, Show)

143

128

144-- | We should newtype this

129-- | We should newtype this

@@ -213,16 +198,16 @@ data Signal = SIGHUP

213

198

214instance FromJSON Signal where

199instance FromJSON Signal where

215 parseJSON (JSON.String "SIGTERM") = return SIGTERM

200 parseJSON (JSON.String "SIGTERM") = return SIGTERM

216− parseJSON (JSON.String "SIGHUP") = return SIGHUP -- Note: Guessing on the string values for these.

201+ parseJSON (JSON.String "SIGHUP") = return SIGHUP -- Note: Guessing on the string values for these.

217− parseJSON (JSON.String "SIGINT") = return SIGINT

202+ parseJSON (JSON.String "SIGINT") = return SIGINT

218 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT

203 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT

219 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP

204 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP

220 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1

205 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1

221− parseJSON _ = fail "Unknown Signal"

206+ parseJSON _ = fail "Unknown Signal"

222

207

223instance ToJSON Signal where

208instance ToJSON Signal where

224− toJSON SIGHUP = "SIGHUP"

209+ toJSON SIGHUP = "SIGHUP"

225− toJSON SIGINT = "SIGINT"

210+ toJSON SIGINT = "SIGINT"

226 toJSON SIGQUIT = "SIGQUIT"

211 toJSON SIGQUIT = "SIGQUIT"

227 toJSON SIGSTOP = "SIGSTOP"

212 toJSON SIGSTOP = "SIGSTOP"

228 toJSON SIGTERM = "SIGTERM"

213 toJSON SIGTERM = "SIGTERM"

@@ -250,7 +235,7 @@ data ContainerDetails = ContainerDetails {

250 , processLabel :: Text

235 , processLabel :: Text

251 , resolveConfPath :: FilePath

236 , resolveConfPath :: FilePath

252 , restartCount :: Int

237 , restartCount :: Int

253− , containerDetailsState :: ContainerState

238+ , state :: ContainerState

254 , mounts :: [Mount]

239 , mounts :: [Mount]

255 }

240 }

256 deriving (Eq, Show, Generic)

241 deriving (Eq, Show, Generic)

@@ -258,11 +243,11 @@ data ContainerDetails = ContainerDetails {

258-- | Data type used for parsing the mount information from a container

243-- | Data type used for parsing the mount information from a container

259-- list.

244-- list.

260data Mount = Mount {

245data Mount = Mount {

261− mountName :: Maybe Text -- this is optional

246+ mountName :: Text

262 , mountSource :: FilePath

247 , mountSource :: FilePath

263 , mountDestination :: FilePath

248 , mountDestination :: FilePath

264− , mountDriver :: Maybe Text

249+ , mountDriver :: Text

265− -- , mountMode :: Maybe VolumePermission -- apparently this can be null

250+ , mountMode :: Maybe VolumePermission -- apparently this can be null

266 , mountRW :: Bool

251 , mountRW :: Bool

267 , mountPropogation :: Text

252 , mountPropogation :: Text

268 }

253 }

@@ -270,14 +255,14 @@ data Mount = Mount {

270

255

271instance FromJSON Mount where

256instance FromJSON Mount where

272 parseJSON (JSON.Object o) = do

257 parseJSON (JSON.Object o) = do

273− name <- o .:? "Name"

258+ name <- o .: "Name"

274 src <- o .: "Source"

259 src <- o .: "Source"

275 dest <- o .: "Destination"

260 dest <- o .: "Destination"

276− driver <- o .:? "Driver"

261+ driver <- o .: "Driver"

277− -- mode <- o .: "Mode"

262+ mode <- o .: "Mode"

278 rw <- o .: "RW"

263 rw <- o .: "RW"

279 prop <- o .: "Propagation"

264 prop <- o .: "Propagation"

280− return $ Mount name src dest driver rw prop

265+ return $ Mount name src dest driver mode rw prop

281 parseJSON _ = fail "Mount is not an object"

266 parseJSON _ = fail "Mount is not an object"

282

267

283-- | Data type used for parsing the container state from a list of

268-- | Data type used for parsing the container state from a list of

@@ -293,7 +278,7 @@ data ContainerState = ContainerState {

293 , restarting :: Bool

278 , restarting :: Bool

294 , running :: Bool

279 , running :: Bool

295 , startedAt :: UTCTime

280 , startedAt :: UTCTime

296− , state :: State

281+ , status :: Status

297 }

282 }

298 deriving (Eq, Show, Generic)

283 deriving (Eq, Show, Generic)

299

284

@@ -523,8 +508,7 @@ data Container = Container

523 , containerImageId :: ImageID

508 , containerImageId :: ImageID

524 , containerCommand :: Text

509 , containerCommand :: Text

525 , containerCreatedAt :: Int

510 , containerCreatedAt :: Int

526− , containerState :: State

527− , containerStatus :: Maybe Text

511+ , containerStatus :: Status

528 , containerPorts :: [ContainerPortInfo]

512 , containerPorts :: [ContainerPortInfo]

529 , containerLabels :: [Label]

513 , containerLabels :: [Label]

530 , containerNetworks :: [Network]

514 , containerNetworks :: [Network]

@@ -532,14 +516,13 @@ data Container = Container

532 } deriving (Show, Eq)

516 } deriving (Show, Eq)

533

517

534instance FromJSON Container where

518instance FromJSON Container where

535− parseJSON o@(JSON.Object v) =

519+ parseJSON (JSON.Object v) =

536− Container <$> parseJSON o

520+ Container <$> (v .: "Id")

537 <*> (v .: "Names")

521 <*> (v .: "Names")

538 <*> (v .: "Image")

522 <*> (v .: "Image")

539− <*> (v .: "ImageID") -- Doesn't exist anymore

523+ <*> (v .: "ImageID")

540− <*> (v .: "Command") -- Doesn't exist anymore

524+ <*> (v .: "Command")

541 <*> (v .: "Created")

525 <*> (v .: "Created")

542− <*> (v .: "State")

543 <*> (v .: "Status")

526 <*> (v .: "Status")

544 <*> (v .: "Ports")

527 <*> (v .: "Ports")

545 <*> (v .: "Labels")

528 <*> (v .: "Labels")

@@ -549,20 +532,21 @@ instance FromJSON Container where

549 parseNetworks (JSON.Object v) =

532 parseNetworks (JSON.Object v) =

550 (v .: "Networks") >>= parseJSON

533 (v .: "Networks") >>= parseJSON

551 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."

534 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."

535+

552 parseJSON _ = fail "Container: Not a JSON object."

536 parseJSON _ = fail "Container: Not a JSON object."

553

537

554−-- | Represents the state of the container life cycle.

538+-- | Represents the status of the container life cycle.

556 deriving (Eq, Show, Generic)

540 deriving (Eq, Show, Generic)

557

541

558−instance FromJSON State where

542+instance FromJSON Status where

559− parseJSON (JSON.String "running") = return Running

543+ parseJSON (JSON.String "running") = return Running

560− parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.

544+ parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.

561 parseJSON (JSON.String "restarting") = return Restarting

545 parseJSON (JSON.String "restarting") = return Restarting

562− parseJSON (JSON.String "paused") = return Paused

546+ parseJSON (JSON.String "paused") = return Paused

563− parseJSON (JSON.String "exited") = return Exited

547+ parseJSON (JSON.String "exited") = return Exited

564− parseJSON (JSON.String "dead") = return Dead

548+ parseJSON (JSON.String "dead") = return Dead

565− parseJSON s = fail $ "Unknown Status: " ++ show s

549+ parseJSON _ = fail "Unknown Status"

566

550

567-- | Alias for representing a RepoDigest. We could newtype this and add

551-- | Alias for representing a RepoDigest. We could newtype this and add

568-- some validation.

552-- some validation.

@@ -623,46 +607,20 @@ instance FromJSON Image where

623 return $ DockerImage imageId imageCreated imageParentId imageRepoTags imageRepoDigests imageSize imageVirtualSize imageLabels

607 return $ DockerImage imageId imageCreated imageParentId imageRepoTags imageRepoDigests imageSize imageVirtualSize imageLabels

624 parseJSON _ = fail "Failed to parse DockerImage."

608 parseJSON _ = fail "Failed to parse DockerImage."

625

609

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

610

650-- | Options used for creating a Container.

611-- | Options used for creating a Container.

651data CreateOpts = CreateOpts {

612data CreateOpts = CreateOpts {

652− containerConfig :: ContainerConfig

613+ containerConfig :: ContainerConfig

653− , hostConfig :: HostConfig

614+ , hostConfig :: HostConfig

654− , networkingConfig :: NetworkingConfig

655 } deriving (Eq, Show)

615 } deriving (Eq, Show)

656

616

657instance ToJSON CreateOpts where

617instance ToJSON CreateOpts where

658− toJSON (CreateOpts cc hc nc) = do

618+ toJSON (CreateOpts cc hc) = do

659 let ccJSON = toJSON cc

619 let ccJSON = toJSON cc

660 let hcJSON = toJSON hc

620 let hcJSON = toJSON hc

661 case ccJSON of

621 case ccJSON of

662 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do

622 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do

663− let o1 = HM.insert "HostConfig" hcJSON o

623+ 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.

624 _ -> error "ContainerConfig is not an object." -- This should never happen.

667

625

668-- | Container configuration used for creating a container with sensible

626-- | Container configuration used for creating a container with sensible

@@ -684,7 +642,7 @@ defaultContainerConfig imageName = ContainerConfig {

684 , cmd=[]

642 , cmd=[]

685 , volumes=[]

643 , volumes=[]

686 , workingDir=Nothing

644 , workingDir=Nothing

687− , entrypoint=Entrypoint []

645+ , entrypoint=Nothing

688 , networkDisabled=Nothing

646 , networkDisabled=Nothing

689 , macAddress=Nothing

647 , macAddress=Nothing

690 , labels=[]

648 , labels=[]

@@ -697,7 +655,7 @@ defaultHostConfig = HostConfig {

697 binds=[]

655 binds=[]

698 , containerIDFile=Nothing

656 , containerIDFile=Nothing

699 , logConfig=LogDriverConfig JsonFile []

657 , logConfig=LogDriverConfig JsonFile []

700− , networkMode=NetworkBridge

658+ , networkMode=Bridge

701 , portBindings=[]

659 , portBindings=[]

702 , restartPolicy=RestartOff

660 , restartPolicy=RestartOff

703 , volumeDriver=Nothing

661 , volumeDriver=Nothing

@@ -737,18 +695,14 @@ defaultContainerResources = ContainerResources {

737 , memory=Nothing

695 , memory=Nothing

738 , memoryReservation=Nothing

696 , memoryReservation=Nothing

739 , memorySwap=Nothing

697 , memorySwap=Nothing

740− , oomKillDisable=Just False

698+ , oomKillDisable=False

741 , ulimits=[]

699 , ulimits=[]

742 }

700 }

743

701

744-- | Default create options when creating a container. You only need to

702-- | Default create options when creating a container. You only need to

745-- specify an image name and the rest is all sensible defaults.

703-- specify an image name and the rest is all sensible defaults.

746defaultCreateOpts :: T.Text -> CreateOpts

704defaultCreateOpts :: T.Text -> CreateOpts

747−defaultCreateOpts imageName = CreateOpts

748− { containerConfig = defaultContainerConfig imageName

705+defaultCreateOpts imageName = CreateOpts { containerConfig = defaultContainerConfig imageName, hostConfig = defaultHostConfig }

749− , hostConfig = defaultHostConfig

750− , networkingConfig = NetworkingConfig HM.empty

751− }

752

706

753-- | Override the key sequence for detaching a container.

707-- | 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 _.

708-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.

@@ -762,7 +716,7 @@ defaultStartOpts :: StartOpts

762defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }

716defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }

763

717

764-- | Options for deleting a container.

718-- | Options for deleting a container.

765−data ContainerDeleteOpts = ContainerDeleteOpts {

719+data DeleteOpts = DeleteOpts {

766 deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.

720 deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.

767 , force :: Bool -- ^ If the container is still running force deletion anyway.

721 , force :: Bool -- ^ If the container is still running force deletion anyway.

768 } deriving (Eq, Show)

722 } deriving (Eq, Show)

@@ -792,15 +746,8 @@ defaultBuildOpts nameTag = BuildOpts { buildImageName = nameTag

792-- | Default options for deleting a container. Most of the time we DON'T

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

747-- want to delete the container's volumes or force delete it if it's

794-- running.

748-- running.

795−defaultContainerDeleteOpts :: ContainerDeleteOpts

749+defaultDeleteOpts :: DeleteOpts

796−defaultContainerDeleteOpts = ContainerDeleteOpts { deleteVolumes = False, force = False }

750+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

751

805-- | Timestamp alias.

752-- | Timestamp alias.

806type Timestamp = Integer

753type Timestamp = Integer

@@ -828,50 +775,18 @@ defaultLogOpts = LogOpts { stdout = True

828 , tail = All

775 , tail = All

829 }

776 }

830

777

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")

778-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")

862-- | Set permissions on volumes that you mount in the container.

779-- | Set permissions on volumes that you mount in the container.

863data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)

780data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)

864

781

865instance ToJSON VolumePermission where

782instance ToJSON VolumePermission where

866 toJSON ReadWrite = "rw"

783 toJSON ReadWrite = "rw"

867− toJSON ReadOnly = "ro"

784+ toJSON ReadOnly = "ro"

868

785

869instance FromJSON VolumePermission where

786instance FromJSON VolumePermission where

870 parseJSON "rw" = return ReadWrite

787 parseJSON "rw" = return ReadWrite

871 parseJSON "ro" = return ReadOnly

788 parseJSON "ro" = return ReadOnly

872− parseJSON "RW" = return ReadWrite

873− parseJSON "RO" = return ReadOnly

874− parseJSON _ = fail "Failed to parse VolumePermission"

789+ parseJSON _ = fail "Failed to parse VolumePermission"

875

790

876-- | Used for marking a directory in the container as "exposed" hence

791-- | Used for marking a directory in the container as "exposed" hence

877-- taking it outside of the COW filesystem and making it mountable

792-- taking it outside of the COW filesystem and making it mountable

@@ -893,8 +808,8 @@ instance {-# OVERLAPPING #-} ToJSON [Volume] where

893

808

894instance {-# OVERLAPPING #-} FromJSON [Volume] where

809instance {-# OVERLAPPING #-} FromJSON [Volume] where

895 parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o

810 parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o

896− parseJSON (JSON.Null) = return []

811+ parseJSON (JSON.Null) = return []

897− parseJSON _ = fail "Volume is not an object"

812+ parseJSON _ = fail "Volume is not an object"

898

813

899

814

900data Bind = Bind { hostSrc :: Text

815data Bind = Bind { hostSrc :: Text

@@ -904,10 +819,10 @@ data Bind = Bind { hostSrc :: Text

904

819

905instance FromJSON Bind where

820instance FromJSON Bind where

906 parseJSON (JSON.String t) = case T.split (== ':') t of

821 parseJSON (JSON.String t) = case T.split (== ':') t of

907− [src, dest] -> return $ Bind src dest Nothing

822+ [src, dest] -> return $ Bind src dest Nothing

908 [src, dest, "rw"] -> return $ Bind src dest $ Just ReadWrite

823 [src, dest, "rw"] -> return $ Bind src dest $ Just ReadWrite

909 [src, dest, "ro"] -> return $ Bind src dest $ Just ReadOnly

824 [src, dest, "ro"] -> return $ Bind src dest $ Just ReadOnly

910− _ -> fail "Could not parse Bind"

825+ _ -> fail "Could not parse Bind"

911 parseJSON _ = fail "Bind is not a string"

826 parseJSON _ = fail "Bind is not a string"

912

827

913data Device = Device {

828data Device = Device {

@@ -930,15 +845,15 @@ data VolumeFrom = VolumeFrom ContainerName (Maybe VolumePermission) deriving (Eq

930

845

931instance FromJSON VolumeFrom where

846instance FromJSON VolumeFrom where

932 parseJSON (JSON.String t) = case T.split (== ':') t of

847 parseJSON (JSON.String t) = case T.split (== ':') t of

933− [vol] -> return $ VolumeFrom vol Nothing

848+ [vol] -> return $ VolumeFrom vol Nothing

934 [vol, "rw"] -> return $ VolumeFrom vol $ Just ReadWrite

849 [vol, "rw"] -> return $ VolumeFrom vol $ Just ReadWrite

935 [vol, "ro"] -> return $ VolumeFrom vol $ Just ReadOnly

850 [vol, "ro"] -> return $ VolumeFrom vol $ Just ReadOnly

936− _ -> fail "Could not parse VolumeFrom"

851+ _ -> fail "Could not parse VolumeFrom"

937 parseJSON _ = fail "VolumeFrom is not a string"

852 parseJSON _ = fail "VolumeFrom is not a string"

938

853

939instance ToJSON VolumeFrom where

854instance ToJSON VolumeFrom where

940 toJSON (VolumeFrom n p) = case p of

855 toJSON (VolumeFrom n p) = case p of

941− Nothing -> toJSON $ n <> ":" <> "rw"

856+ Nothing -> toJSON $ n <> ":" <> "rw"

942 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)

857 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)

943

858

944instance ToJSON Bind where

859instance ToJSON Bind where

@@ -950,40 +865,40 @@ data Link = Link Text (Maybe Text) deriving (Eq, Show)

950

865

951instance FromJSON Link where

866instance FromJSON Link where

952 parseJSON (JSON.String t) = case T.split (== ':') t of

867 parseJSON (JSON.String t) = case T.split (== ':') t of

953− [f] -> return $ Link f Nothing

868+ [f] -> return $ Link f Nothing

954 [f,s] -> return $ Link f $ Just s

869 [f,s] -> return $ Link f $ Just s

955− _ -> fail "Could not parse Link"

870+ _ -> fail "Could not parse Link"

956 parseJSON _ = fail "Link is not a string"

871 parseJSON _ = fail "Link is not a string"

957

872

958instance ToJSON Link where

873instance ToJSON Link where

959 toJSON (Link n1 n2) = toJSON $ case n2 of

874 toJSON (Link n1 n2) = toJSON $ case n2 of

960 Nothing -> T.concat[n1, ":", n1] -- use same name in container

875 Nothing -> T.concat[n1, ":", n1] -- use same name in container

961− Just n -> T.concat[n1, ":", n] -- used specified name in container

876+ Just n -> T.concat[n1, ":", n] -- used specified name in container

962

877

963-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }

878-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }

965

880

966instance FromJSON LogDriverType where

881instance FromJSON LogDriverType where

967 parseJSON (JSON.String "json-file") = return JsonFile

882 parseJSON (JSON.String "json-file") = return JsonFile

968− parseJSON (JSON.String "syslog") = return Syslog

883+ parseJSON (JSON.String "syslog") = return Syslog

969− parseJSON (JSON.String "journald") = return Journald

884+ parseJSON (JSON.String "journald") = return Journald

970− parseJSON (JSON.String "gelf") = return Gelf

885+ parseJSON (JSON.String "gelf") = return Gelf

971− parseJSON (JSON.String "fluentd") = return Fluentd

886+ parseJSON (JSON.String "fluentd") = return Fluentd

972− parseJSON (JSON.String "awslogs") = return AwsLogs

887+ parseJSON (JSON.String "awslogs") = return AwsLogs

973− parseJSON (JSON.String "splunk") = return Splunk

888+ parseJSON (JSON.String "splunk") = return Splunk

974− parseJSON (JSON.String "etwlogs") = return Etwlogs

889+ parseJSON (JSON.String "etwlogs") = return Etwlogs

975− parseJSON (JSON.String "none") = return LoggingDisabled

890+ parseJSON (JSON.String "none") = return LoggingDisabled

976− parseJSON _ = fail "Unknown LogDriverType"

891+ parseJSON _ = fail "Unknown LogDriverType"

977

892

978instance ToJSON LogDriverType where

893instance ToJSON LogDriverType where

979− toJSON JsonFile = JSON.String "json-file"

894+ toJSON JsonFile = JSON.String "json-file"

980− toJSON Syslog = JSON.String "syslog"

895+ toJSON Syslog = JSON.String "syslog"

981− toJSON Journald = JSON.String "journald"

896+ toJSON Journald = JSON.String "journald"

982− toJSON Gelf = JSON.String "gelf"

897+ toJSON Gelf = JSON.String "gelf"

983− toJSON Fluentd = JSON.String "fluentd"

898+ toJSON Fluentd = JSON.String "fluentd"

984− toJSON AwsLogs = JSON.String "awslogs"

899+ toJSON AwsLogs = JSON.String "awslogs"

985− toJSON Splunk = JSON.String "splunk"

900+ toJSON Splunk = JSON.String "splunk"

986− toJSON Etwlogs = JSON.String "etwlogs"

901+ toJSON Etwlogs = JSON.String "etwlogs"

987 toJSON LoggingDisabled = JSON.String "none"

902 toJSON LoggingDisabled = JSON.String "none"

988

903

989data LogDriverOption = LogDriverOption Name Value deriving (Eq, Show)

904data LogDriverOption = LogDriverOption Name Value deriving (Eq, Show)

@@ -1017,41 +932,19 @@ instance FromJSON LogDriverConfig where

1017 parseJSON _ = fail "LogDriverConfig is not an object"

932 parseJSON _ = fail "LogDriverConfig is not an object"

1018

933

1019-- TODO: Add container:<name|id> mode

934-- TODO: Add container:<name|id> mode

1020−data NetworkMode = NetworkBridge | NetworkHost | NetworkDisabled | NetworkNamed Text

935+data NetworkMode = Bridge | Host | NetworkDisabled

1021 deriving (Eq, Show, Ord)

936 deriving (Eq, Show, Ord)

1022

937

1023instance FromJSON NetworkMode where

938instance FromJSON NetworkMode where

1024− parseJSON (JSON.String "bridge") = return NetworkBridge

939+ parseJSON (JSON.String "bridge") = return Bridge

1025− parseJSON (JSON.String "host") = return NetworkHost -- Note: Guessing on these.

940+ parseJSON (JSON.String "host") = return Host -- Note: Guessing on these.

1026− parseJSON (JSON.String "none") = return NetworkDisabled

941+ parseJSON (JSON.String "none") = return NetworkDisabled

1027− parseJSON (JSON.String n) = return $ NetworkNamed n

1028− parseJSON _ = fail "Unknown NetworkMode"

942+ parseJSON _ = fail "Unknown NetworkMode"

1029

943

1030instance ToJSON NetworkMode where

944instance ToJSON NetworkMode where

1031− toJSON NetworkBridge = JSON.String "bridge"

945+ toJSON Bridge = JSON.String "bridge"

1032− toJSON NetworkHost = JSON.String "host"

946+ toJSON Host = JSON.String "host"

1033 toJSON NetworkDisabled = JSON.String "none"

947 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

948

1056data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)

949data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)

1057

950

@@ -1067,7 +960,7 @@ instance FromJSON PortType where

1067 parseJSON val = case val of

960 parseJSON val = case val of

1068 "tcp" -> return TCP

961 "tcp" -> return TCP

1069 "udp" -> return UDP

962 "udp" -> return UDP

1070− _ -> fail "PortType: Invalid port type."

963+ _ -> fail "PortType: Invalid port type."

1071

964

1072-- newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)

965-- newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)

1073--

966--

@@ -1197,7 +1090,7 @@ instance FromJSON RestartPolicy where

1197 "on-failure" -> do

1090 "on-failure" -> do

1198 retry <- o .: "MaximumRetryCount"

1091 retry <- o .: "MaximumRetryCount"

1199 return $ RestartOnFailure retry

1092 return $ RestartOnFailure retry

1200− "no" -> return RestartOff

1093+ "off" -> return RestartOff

1201 _ -> fail "Could not parse RestartPolicy"

1094 _ -> fail "Could not parse RestartPolicy"

1202 parseJSON _ = fail "RestartPolicy is not an object"

1095 parseJSON _ = fail "RestartPolicy is not an object"

1203

1096

@@ -1205,7 +1098,7 @@ instance ToJSON RestartPolicy where

1205 toJSON RestartAlways = object ["Name" .= JSON.String "always"]

1098 toJSON RestartAlways = object ["Name" .= JSON.String "always"]

1206 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]

1099 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]

1207 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]

1100 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]

1208− toJSON RestartOff = object ["Name" .= JSON.String "no"]

1101+ toJSON RestartOff = object ["Name" .= JSON.String "off"]

1209

1102

1210data Isolation = Default | Process | Hyperv deriving (Eq, Show)

1103data Isolation = Default | Process | Hyperv deriving (Eq, Show)

1211

1104

@@ -1383,7 +1276,7 @@ data MemoryConstraintSize = B | MB | GB deriving (Eq, Show)

1383data MemoryConstraint = MemoryConstraint Integer MemoryConstraintSize deriving (Eq, Show)

1276data MemoryConstraint = MemoryConstraint Integer MemoryConstraintSize deriving (Eq, Show)

1384

1277

1385instance ToJSON MemoryConstraint where

1278instance ToJSON MemoryConstraint where

1386− toJSON (MemoryConstraint x B) = toJSON x

1279+ toJSON (MemoryConstraint x B) = toJSON x

1387 toJSON (MemoryConstraint x MB) = toJSON $ x * 1024 * 1024

1280 toJSON (MemoryConstraint x MB) = toJSON $ x * 1024 * 1024

1388 toJSON (MemoryConstraint x GB) = toJSON $ x * 1024 * 1024 * 1024

1281 toJSON (MemoryConstraint x GB) = toJSON $ x * 1024 * 1024 * 1024

1389

1282

@@ -1414,7 +1307,7 @@ data ContainerResources = ContainerResources {

1414 , memoryReservation :: Maybe MemoryConstraint

1307 , memoryReservation :: Maybe MemoryConstraint

1415 , memorySwap :: Maybe MemoryConstraint

1308 , memorySwap :: Maybe MemoryConstraint

1416 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.

1309 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.

1417− , oomKillDisable :: Maybe Bool

1310+ , oomKillDisable :: Bool

1418 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.

1311 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.

1419 , ulimits :: [Ulimit]

1312 , ulimits :: [Ulimit]

1420 -- TODO: Missing from 1.24

1313 -- TODO: Missing from 1.24

@@ -1452,7 +1345,7 @@ instance FromJSON EnvVar where

1452 parseJSON _ = fail "EnvVar is not a string"

1345 parseJSON _ = fail "EnvVar is not a string"

1453

1346

1454instance ToJSON EnvVar where

1347instance ToJSON EnvVar where

1455− toJSON (EnvVar n v) = JSON.String $ n <> T.pack "=" <> v

1348+ toJSON (EnvVar n v) = object [n .= v]

1456

1349

1457-- | ExposedPort represents a port (and it's type)

1350-- | ExposedPort represents a port (and it's type)

1458-- that a container should expose to other containers or the host system.

1351-- that a container should expose to other containers or the host system.

@@ -1492,21 +1385,6 @@ instance {-# OVERLAPPING #-} ToJSON [ExposedPort] where

1492 where key (ExposedPort p t) = show p <> slash <> show t

1385 where key (ExposedPort p t) = show p <> slash <> show t

1493 slash = T.unpack "/"

1386 slash = T.unpack "/"

1494

1387

1495−data Entrypoint = Entrypoint [T.Text] deriving (Eq, Show, Generic)

1496−

1497−instance ToJSON Entrypoint where

1498− toJSON (Entrypoint (e:es)) = toJSON (e:es)

1499− toJSON (Entrypoint []) = JSON.Null

1500−

1501−instance FromJSON Entrypoint where

1502− parseJSON (JSON.String e) = return $ Entrypoint [e]

1503− parseJSON (JSON.Array ar) = do

1504− arr <- mapM parseJSON (V.toList ar)

1505− return $ Entrypoint arr

1506− parseJSON JSON.Null = return $ Entrypoint []

1507− parseJSON _ = fail "Failed to parse Entrypoint"

1508−

1509−

1510data ContainerConfig = ContainerConfig {

1388data ContainerConfig = ContainerConfig {

1511 hostname :: Maybe Text

1389 hostname :: Maybe Text

1512 , domainname :: Maybe Text

1390 , domainname :: Maybe Text

@@ -1525,7 +1403,7 @@ data ContainerConfig = ContainerConfig {

1525 , image :: Text

1403 , image :: Text

1526 , volumes :: [Volume]

1404 , volumes :: [Volume]

1527 , workingDir :: Maybe FilePath

1405 , workingDir :: Maybe FilePath

1528− , entrypoint :: Entrypoint

1406+ , entrypoint :: Maybe Text -- Can be null?

1529 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?

1407 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?

1530 , macAddress :: Maybe Text

1408 , macAddress :: Maybe Text

1531 -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.

1409 -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.

@@ -1533,7 +1411,6 @@ data ContainerConfig = ContainerConfig {

1533 , stopSignal :: Signal

1411 , stopSignal :: Signal

1534 } deriving (Eq, Show, Generic)

1412 } deriving (Eq, Show, Generic)

1535

1413

1536−

1537instance ToJSON ContainerConfig where

1414instance ToJSON ContainerConfig where

1538 toJSON = genericToJSON defaultOptions {

1415 toJSON = genericToJSON defaultOptions {

1539 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}

1416 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}

@@ -1555,7 +1432,7 @@ instance FromJSON ContainerConfig where

1555 image <- o .: "Image"

1432 image <- o .: "Image"

1556 volumes <- o .: "Volumes"

1433 volumes <- o .: "Volumes"

1557 workingDir <- o .:? "WorkingDir"

1434 workingDir <- o .:? "WorkingDir"

1558− entrypoint <- o .: "Entrypoint"

1435+ entrypoint <- o .:? "Entrypoint"

1559 networkDisabled <- o .:? "networkDisabled"

1436 networkDisabled <- o .:? "networkDisabled"

1560 macAddress <- o .:? "MacAddress"

1437 macAddress <- o .:? "MacAddress"

1561 labels <- o .:? "Labels" .!= []

1438 labels <- o .:? "Labels" .!= []

@@ -1564,11 +1441,7 @@ instance FromJSON ContainerConfig where

1564 macAddress labels stopSignal

1441 macAddress labels stopSignal

1565 parseJSON _ = fail "NetworkSettings is not an object."

1442 parseJSON _ = fail "NetworkSettings is not an object."

1566

1443

1567−#if MIN_VERSION_base(4,13,0)

1568−parseIntegerText :: (MonadFail m) => Text -> m Integer

1569−#else

1570parseIntegerText :: (Monad m) => Text -> m Integer

1444parseIntegerText :: (Monad m) => Text -> m Integer

1571−#endif

1572parseIntegerText t = case readMaybe $ T.unpack t of

1445parseIntegerText t = case readMaybe $ T.unpack t of

1573 Nothing ->

1446 Nothing ->

1574 fail "Could not parse Integer"

1447 fail "Could not parse Integer"

@@ -1590,3 +1463,4 @@ toJsonKeyVal vs getKey getVal = JSON.Object $ foldl f HM.empty vs

1590-- | Helper function that return an empty dictionary "{}"

1463-- | Helper function that return an empty dictionary "{}"

1591emptyJsonObject :: JSON.Value

1464emptyJsonObject :: JSON.Value

1592emptyJsonObject = JSON.Object HM.empty

1465emptyJsonObject = JSON.Object HM.empty

1466+

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

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

6# Local packages, usually specified by relative directory name

7packages:

8- '.'

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: {}

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

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

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

2packages:

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

3−CMD ["/bin/bash", "-c", "echo $TEST"]

3+CMD ["/bin/bash", "-c", "echo 123"]

tests/tests.hs+80−231

@@ -2,8 +2,6 @@

3module Main where

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,284 +9,135 @@ import Test.Tasty.QuickCheck (testProperty)

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

15+import Data.Aeson.Lens (key, _Object, _String, _Value)

19−import Data.Aeson.Lens (key, _Array, _Null, _Object,

20− _String, _Value)

21import qualified Data.ByteString as B

16import qualified Data.ByteString as B

22import qualified Data.ByteString.Char8 as C

17import qualified Data.ByteString.Char8 as C

23import qualified Data.ByteString.Lazy as BL

18import qualified Data.ByteString.Lazy as BL

24import qualified Data.HashMap.Strict as HM

19import qualified Data.HashMap.Strict as HM

25import Data.Int (Int)

20import Data.Int (Int)

26import qualified Data.Map as M

21import qualified Data.Map as M

27−import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)

22+import Data.Maybe (fromJust, isJust)

28import Data.Monoid

23import Data.Monoid

29import Data.Text (Text, unpack)

24import Data.Text (Text, unpack)

30−import qualified Data.Vector as V

31import Network.Connection (TLSSettings (..))

25import Network.Connection (TLSSettings (..))

32import Network.HTTP.Client (newManager)

26import Network.HTTP.Client (newManager)

33import Network.HTTP.Client.TLS

27import Network.HTTP.Client.TLS

34import Network.HTTP.Types.Status

28import Network.HTTP.Types.Status

35−import System.Directory (getCurrentDirectory)

36−import System.Environment (lookupEnv)

37import System.Process (system)

29import System.Process (system)

39import Docker.Client

31import Docker.Client

41-- opts = defaultClientOpts

33-- opts = defaultClientOpts

34+

42−testImageName = "docker-hs/test"

35+testImageName = "docker-hs-test"

43−imageToDeleteFullName = "hello-world:latest"

45toStrict1 = B.concat . BL.toChunks

37toStrict1 = B.concat . BL.toChunks

47−runDocker f

39+runDocker f = do

48− -- let opts = defaultClientOpts {baseUrl = "https://127.0.0.1:2376/"}

40+ -- let opts = defaultClientOpts {baseUrl = "https://127.0.0.1:2376/"}

49− -- params' <- clientParamsWithClientAuthentication "127.0.0.1" 2376 "~/.docker/test-client-key.pem" "~/.docker/test-client-cert.pem" >>= fromRight

41+ -- params' <- clientParamsWithClientAuthentication "127.0.0.1" 2376 "~/.docker/test-client-key.pem" "~/.docker/test-client-cert.pem" >>= fromRight

50− -- params <- clientParamsSetCA params' "~/.docker/test-ca.pem"

42+ -- params <- clientParamsSetCA params' "~/.docker/test-ca.pem"

51− -- let settings = mkManagerSettings (TLSSettings params) Nothing

43+ -- let settings = mkManagerSettings (TLSSettings params) Nothing

52− -- mgr <- newManager settings

44+ -- mgr <- newManager settings

53− = do

54− h <- defaultHttpHandler

45+ h <- defaultHttpHandler

55− runDockerT (defaultClientOpts, h) f

46+ runDockerT (defaultClientOpts, h) f

57testDockerVersion :: IO ()

48testDockerVersion :: IO ()

58−testDockerVersion =

49+testDockerVersion = runDocker $ do

59− runDocker $

60− do v <- getDockerVersion

50+ v <- getDockerVersion

61− lift $ assert $ isRight v

51+ lift $ assert $ isRight v

62−

63−testStopNonexisting :: IO ()

64−testStopNonexisting = runDocker $ do

65− res <- stopContainer DefaultTimeout $ fromJust $ toContainerID "thisshouldnotexist"

66− lift $ assert $ isLeft res

68testFindImage :: IO ()

53testFindImage :: IO ()

69−testFindImage =

54+testFindImage = runDocker $ do

70− runDocker $

71− do images <- listImages defaultListOpts >>= fromRight

72− let xs = filter (elem imageFullName . imageRepoTags) images

73− lift $ assert $ length xs == 1

74− where

75− imageFullName = testImageName <> ":latest"

76−

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

55 images <- listImages defaultListOpts >>= fromRight

88− return $ listToMaybe

89− $ filter (elem imageToDeleteFullName . imageRepoTags) images

56+ let xs = filter ((== [imageFullName]) . imageRepoTags) images

90−

57+ lift $ assert $ length xs == 1

91−testListContainers :: IO ()

58+ where imageFullName = testImageName <> ":latest"

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

60testRunAndReadLog :: IO ()

110−testRunAndReadLog = testRunAndReadLogHelper $ NetworkingConfig HM.empty

61+testRunAndReadLog = runDocker $ do

111−

62+ containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing

112−testRunAndReadLogWithNetworking :: IO ()

113−testRunAndReadLogWithNetworking = testRunAndReadLogHelper $ NetworkingConfig $ HM.fromList [("test-network", EndpointConfig ["cellar-door"])]

114−

115−testRunAndReadLogHelper :: NetworkingConfig -> IO ()

116−testRunAndReadLogHelper networkingConfig =

117− runDocker $

118− do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}

119− createdNetworks <- rights <$> mapM createNetworkWithName networkNames

120− containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing

121− c <- fromRight containerId

63+ c <- fromRight containerId

122− status1 <- startContainer defaultStartOpts c

64+ status1 <- startContainer defaultStartOpts c

123− _ <- inspectContainer c >>= fromRight

65+ _ <- inspectContainer c >>= fromRight

124− lift $ threadDelay 300000 -- give 300ms for the application to finish

66+ lift $ threadDelay 300000 -- give 300ms for the application to finish

125− lift $ assertBool ("starting the container, unexpected status: " ++ show status1) $ isRightUnit status1

67+ lift $ assert $ isRightUnit status1

68+ status2 <- killContainer SIGTERM c

126− logs <- getContainerLogs defaultLogOpts c >>= fromRight

69+ logs <- getContainerLogs defaultLogOpts c >>= fromRight

70+ lift $ assert $ isRightUnit status2

127− lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)

71+ lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)

128− status3 <- deleteContainer (ContainerDeleteOpts True True) c

72+ status3 <- deleteContainer (DeleteOpts True True) c

129− lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3

73+ lift $ assert $ isRightUnit status3

130− mapM_ removeNetwork createdNetworks

74+

131− where

75+ where

132− isRightUnit (Right ()) = True

76+ isRightUnit (Right ()) = True

133− isRightUnit _ = False

77+ 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

147testLogDriverOptionsJson :: TestTree

79testLogDriverOptionsJson :: TestTree

148−testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]

80+testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [ test1, test2, test3 ]

149− where

81+ where

150− test1 = testCase "Driver option 1" $ assert $ JSON.toJSON sample ^. key key1 . _String == val1

82+ test1 = testCase "Driver option 1" $ assert $ JSON.toJSON sample ^. key key1 . _String == val1

151− test2 = testCase "Driver option 2" $ assert $ JSON.toJSON sample ^. key key2 . _String == val2

83+ test2 = testCase "Driver option 2" $ assert $ JSON.toJSON sample ^. key key2 . _String == val2

152− test3 =

153− testCase "Test override" $ assert $ JSON.toJSON sample2 ^. key key1 . _String == "override"

84+ test3 = testCase "Test override" $ assert $ JSON.toJSON sample2 ^. key key1 . _String == "override"

154− sample = [LogDriverOption key1 val1, LogDriverOption key2 val2]

85+ sample = [LogDriverOption key1 val1, LogDriverOption key2 val2]

155− sample2 = [LogDriverOption key1 val1, LogDriverOption key1 "override"]

86+ sample2 = [LogDriverOption key1 val1, LogDriverOption key1 "override"]

156− key1 = "some-key"

87+ key1 = "some-key"

157− val1 = "some-val"

88+ val1 = "some-val"

158− key2 = "some-key2"

89+ key2 = "some-key2"

159− val2 = "some-key2"

90+ val2 = "some-key2"

160

161testExposedPortsJson :: TestTree

92testExposedPortsJson :: TestTree

162−testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [testTCP, testUDP]

93+testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]

163− where

94+ where

164− testTCP = testCase "tcp port" $ assert $ JSON.toJSON sampleEP ^. key "80/tcp" . _Object == HM.empty

95+ testTCP = testCase "tcp port" $ assert $ JSON.toJSON sampleEP ^. key "80/tcp" . _Object == HM.empty

165− testUDP =

166− testCase "udp port" $ assert $ JSON.toJSON sampleEP ^. key "1337/tcp" . _Object == HM.empty

96+ testUDP = testCase "udp port" $ assert $ JSON.toJSON sampleEP ^. key "1337/tcp" . _Object == HM.empty

167− sampleEP = [ExposedPort 80 TCP, ExposedPort 1337 UDP]

97+ sampleEP = [ExposedPort 80 TCP, ExposedPort 1337 UDP]

168

169testLabelsJson :: TestTree

99testLabelsJson :: TestTree

170−testLabelsJson = testGroup "Testing Labels JSON" [testLS1, testLS2, testOverride]

100+testLabelsJson = testGroup "Testing Labels JSON" [ testLS1, testLS2, testOverride ]

171− where

101+ where

172− testLS1 = testCase "test label key1" $ assert $ JSON.toJSON sampleLS ^. key key1 . _String == val1

102+ testLS1 = testCase "test label key1" $ assert $ JSON.toJSON sampleLS ^. key key1 . _String == val1

173− testLS2 = testCase "test label key2" $ assert $ JSON.toJSON sampleLS ^. key key2 . _String == val2

103+ testLS2 = testCase "test label key2" $ assert $ JSON.toJSON sampleLS ^. key key2 . _String == val2

174− testOverride =

175− testCase "test label override" $ assert $ JSON.toJSON [Label key1 val1, Label key1 "override"] ^.

104+ testOverride = testCase "test label override" $ assert $ JSON.toJSON [Label key1 val1, Label key1 "override"] ^. key key1 . _String == "override"

176− key key1 .

177− _String ==

178− "override"

179− sampleLS = [Label key1 val1, Label key2 val2]

105+ sampleLS = [Label key1 val1, Label key2 val2]

180− key1 = "com.example.some-label"

106+ key1 = "com.example.some-label"

181− val1 = "some-value"

107+ val1 = "some-value"

182− key2 = "something"

108+ key2 = "something"

183− val2 = "value"

109+ val2 = "value"

184

110

185testVolumesJson :: TestTree

111testVolumesJson :: TestTree

186−testVolumesJson = testGroup "Testing Volumes JSON" [testSample1, testSample2]

112+testVolumesJson = testGroup "Testing Volumes JSON" [ testSample1, testSample2 ]

187− where

113+ where

188− testSample1 =

189− testCase "Test exposing volume: /tmp" $ assert $ JSON.toJSON sampleVolumes ^. key "/tmp" . _Object ==

114+ testSample1 = testCase "Test exposing volume: /tmp" $ assert $ JSON.toJSON sampleVolumes ^. key "/tmp" . _Object == HM.empty

190− HM.empty

191− testSample2 =

192− testCase "Test exposing volume: /opt" $ assert $ JSON.toJSON sampleVolumes ^. key "/opt" . _Object ==

115+ testSample2 = testCase "Test exposing volume: /opt" $ assert $ JSON.toJSON sampleVolumes ^. key "/opt" . _Object == HM.empty

193− HM.empty

194− sampleVolumes = [Volume "/tmp", Volume "/opt"]

116+ sampleVolumes = [Volume "/tmp", Volume "/opt"]

195−

196−testEntrypointJson :: TestTree

197−testEntrypointJson = testGroup "Testing ContainerConfig JSON" [testSample1, testSample2, testSample3, testSample4, testSample5]

198− where

199− testSample1 =

200− testCase "Test toJSON with empty entrypoint (null)" $ assert $ JSON.toJSON (Entrypoint []) ^. _Null == ()

201− testSample2 =

202− testCase "Test toJSON with entrypoint as Array" $ assert $

203− JSON.toJSON (Entrypoint sampleEntrypointArr) ==

204− JSON.toJSON sampleEntrypointArr

205− testSample3 =

206− testCase "Test decoding entrypoint as string" $ assert $ (JSON.decode "\"cmd\"") ==

207− Just (Entrypoint ["cmd"])

208− testSample4 =

209− testCase "Test decoding as null" $ assert $ (JSON.decode "null" :: Maybe Entrypoint) ==

210− Just (Entrypoint [])

211− testSample5 =

212− testCase "Test decoding as array" $ assert $ (JSON.decode (JSON.encode sampleEntrypointArr) :: Maybe Entrypoint) ==

213− Just (Entrypoint sampleEntrypointArr)

214− sampleEntrypointArr = ["cmd", "--some-flag", "--some-flag2"]

215−

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

117

239integrationTests :: TestTree

118integrationTests :: TestTree

240−integrationTests =

119+integrationTests = testGroup "Integration Tests" [

241− testGroup

242− "Integration Tests"

243− [ testCase "Get docker version" testDockerVersion

120+ testCase "Get docker version" testDockerVersion,

244− , testCase "Build image from Dockerfile" testBuildFromDockerfile

245− , testCase "Find image by name" testFindImage

121+ 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

122+ 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− ]

253

123

254jsonTests :: TestTree

124jsonTests :: TestTree

255−jsonTests =

125+jsonTests = testGroup "JSON Tests" [testExposedPortsJson, testVolumesJson, testLabelsJson, testLogDriverOptionsJson]

256− testGroup

257− "JSON Tests"

258− [ testExposedPortsJson

259− , testVolumesJson

260− , testLabelsJson

261− , testLogDriverOptionsJson

262− , testEntrypointJson

263− , testEnvVarJson

264− , testNetworkingConfigJson

265− ]

266

126

267setup :: IO ()

127setup :: IO ()

268−setup =

269− mapM_ system

270− [ "docker pull " ++ unpack imageToDeleteFullName

271− , "docker build -t " ++ unpack testImageName ++ " tests"

128+setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()

272− ]

273−

274−isLeft = not . isRight

275

129

276−isRight (Left _) = False

130+isRight (Left _) = False

277isRight (Right _) = True

131isRight (Right _) = True

278

132

279−fromRight

280− :: (MonadIO m, Show l)

133+fromRight :: (MonadIO m, Show l) => Either l r -> m r

281− => Either l r -> m r

282fromRight (Left l) = do

134fromRight (Left l) = do

283− liftIO $ assertFailure $ "Left: " ++ show l

135+ liftIO $ assertFailure $ "Left: " ++ show l

284− undefined

136+ undefined

285fromRight (Right r) = return r

137fromRight (Right r) = return r

286

138

287main :: IO ()

139main :: IO ()

288main = do

140main = do

289− stackage <- lookupEnv "RUN_INTEGRATION_TESTS"

290− case stackage of

291− Nothing -> defaultMain $ testGroup "Tests" [jsonTests]

292− Just _ -> do

293− setup

141+ setup

294− defaultMain $ testGroup "Tests" [jsonTests, integrationTests]

142+ defaultMain $ testGroup "Tests" [jsonTests, integrationTests]

143+