master..09fb912 · docker-hs

git.iko.soy/docker-hs

on 09fb912 help sign in

.travis.yml+4−25

since splitsnapshots

unifiedsplit

@@ -22,30 +22,9 @@ services:

22 - docker

24env:

25− global:

26− - RUN_INTEGRATION_TESTS=1

25+ - RUN_INTEGRATION_TESTS=1 GHCVER=7.10 STACK_ARGS=""

27− - STACK_ARGS=""

26+ - RUN_INTEGRATION_TESTS=1 GHCVER=8.0 STACK_ARGS=""

28−

27+ - RUN_INTEGRATION_TESTS=1 GHCVER=8.0.2 STACK_ARGS=""

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:

29addons:

51 apt:

30 apt:

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

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

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

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

59 - sudo apt-get update

38 - sudo apt-get update

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

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

62install:

41install:

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

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

CHANGELOG.md−44

@@ -1,49 +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)

3## 0.4.1.1 (2017-10-16)

49- Small change to add env var for skipping integration tests.

5- Small change to add env var for skipping integration tests.

docker.cabal+8−19

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

1name: docker

2−version: 0.6.0.3

2+version: 0.4.1.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,25 @@ 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, CPP

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.3.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.6.0

34− , http-types >= 0.9 && < 0.13

29+ , http-types >= 0.9 && < 0.10.0

35 , vector

30 , vector

36 , conduit

31 , conduit

37 , conduit-combinators

32 , conduit-combinators

38 , conduit-extra

33 , conduit-extra

39 , exceptions

34 , exceptions

35+ , http-conduit

40 , monad-control

36 , monad-control

41 , resourcet

37 , resourcet

42 , transformers

38 , transformers

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

51 , mtl >= 2.0.0 && < 3.0.0

47 , mtl >= 2.0.0 && < 3.0.0

52 , network >= 2.6.0

48 , network >= 2.6.0

53 , text >= 1.0.0 && < 2.0.0

49 , text >= 1.0.0 && < 2.0.0

54− , time >= 1.5.0 && < 2.0.0

50+ , time >= 1.5.0 && < 1.9.0

55 , scientific >= 0.3.0 && < 0.4.0

51 , scientific >= 0.3.0 && < 0.4.0

56− , tls >= 1.3.7 && < 1.6.0

52+ , tls >= 1.3.7 && < 1.5.0

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

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

58 , x509 >= 1.6.0 && < 1.8.0

54 , x509 >= 1.6.0 && < 1.8.0

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

55 , x509-store >= 1.6.0 && < 1.8.0

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

56 , x509-system >= 1.6.0 && < 1.8.0

61− , http-conduit

62− , unliftio-core >= 0.1.0.0 && < 0.2.0

63− -- if flag(small-http-conduit)

64− -- build-depends: http-conduit < 2.3.0

65− -- else

66− -- build-depends: http-conduit >= 2.3.0

67− -- , unliftio-core

68 default-language: Haskell2010

57 default-language: Haskell2010

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

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

src/Docker/Client/Api.hs+2−20

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

18 , getContainerLogsStream

19 -- * Images

20 , listImages

21− , deleteImage

22 , buildImageFromDockerfile

21 , buildImageFromDockerfile

23 , pullImage

22 , pullImage

24− -- * Network

25− , createNetwork

26− , removeNetwork

27 -- * Other

23 -- * Other

28 , getDockerVersion

24 , getDockerVersion

29 ) where

25 ) where

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

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

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

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

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

97−-- | Deletes an image with the given 'ImageID'.

98−-- See "ImageDeleteOpts" for options and use 'defaultImageDeleteOpts' for sane

99−-- defaults.

100−deleteImage :: forall m. (MonadIO m, MonadMask m) => ImageDeleteOpts -> ImageID -> DockerT m (Either DockerError ())

101−deleteImage dopts iid = requestUnit DELETE $ DeleteImageEndpoint dopts iid

102−

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

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

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

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

105-- for some sane defaults.

95-- for some sane defaults.

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

145unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

135unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

146

136

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

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

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

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

149-- defaults.

139-- defaults.

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

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

151deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

141deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

152

142

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

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

@@ -217,11 +207,3 @@ buildImageFromDockerfile opts base = do

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

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

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

208pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing)

219

209

220−-- | Creates network

221−createNetwork :: forall m. (MonadIO m, MonadMask m) => CreateNetworkOpts -> DockerT m (Either DockerError NetworkID)

222−createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseResponse

223−

224−-- | Removes a network

225−removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())

226−removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

227−

src/Docker/Client/Http.hs+4−33

@@ -5,9 +5,6 @@ module Docker.Client.Http where

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

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

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

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

10−#endif

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

8import Control.Monad.Reader (ReaderT (..), runReaderT)

12import qualified Data.ByteString.Char8 as BSC

9import qualified Data.ByteString.Char8 as BSC

13import qualified Data.ByteString.Lazy as BL

10import qualified Data.ByteString.Lazy as BL

@@ -107,20 +104,12 @@ mkHttpRequest verb e opts = request

107 requestHeaders = [("Content-Type", "application/json; charset=utf-8")]}) $ getEndpointRequestBody e) <$> request'

104 requestHeaders = [("Content-Type", "application/json; charset=utf-8")]}) $ getEndpointRequestBody e) <$> request'

108 -- Note: Do we need to set length header?

105 -- Note: Do we need to set length header?

109

106

110−defaultHttpHandler :: (

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

112− MonadUnliftIO m,

113−#endif

114− MonadIO m, MonadMask m) => m (HttpHandler m)

107+defaultHttpHandler :: (MonadIO m, MonadMask m) => m (HttpHandler m)

115defaultHttpHandler = do

108defaultHttpHandler = do

116 manager <- liftIO $ newManager defaultManagerSettings

109 manager <- liftIO $ newManager defaultManagerSettings

117 return $ httpHandler manager

110 return $ httpHandler manager

118

111

119−httpHandler :: (

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

121− MonadUnliftIO m,

122−#endif

123− MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m

112+httpHandler :: (MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m

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

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

125 let request = NHS.setRequestManager manager request'

114 let request = NHS.setRequestManager manager request'

126 try (NHS.httpSink request sink) >>= \res -> case res of

115 try (NHS.httpSink request sink) >>= \res -> case res of

@@ -138,11 +127,7 @@ httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..

138--

127--

139-- Docker seems to ignore the hostname in requests sent over unix domain

128-- Docker seems to ignore the hostname in requests sent over unix domain

140-- sockets (and the port obviously doesn't matter either)

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

130+unixHttpHandler :: (MonadIO m, MonadMask m) => FilePath -- ^ The socket to connect to

146 -> m (HttpHandler m)

131 -> m (HttpHandler m)

147unixHttpHandler fp = do

132unixHttpHandler fp = do

148 let mSettings = defaultManagerSettings

133 let mSettings = defaultManagerSettings

@@ -273,18 +258,4 @@ statusCodeToError (CreateImageEndpoint _ _ _) st =

273 Nothing

258 Nothing

274 else

259 else

275 Just $ DockerInvalidStatusCode st

260 Just $ DockerInvalidStatusCode st

276−statusCodeToError (DeleteImageEndpoint _ _) st =

261+

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+1−8

@@ -57,7 +57,7 @@ getEndpoint v (UnpauseContainerEndpoint cid) = encodeURL [v, "containers", fromC

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

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

59 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]

60−getEndpoint v (DeleteContainerEndpoint (ContainerDeleteOpts removeVolumes force) cid) =

60+getEndpoint v (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =

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

62 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]

63getEndpoint v (InspectContainerEndpoint cid) =

@@ -75,9 +75,6 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images"

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

79getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

83getEndpointRequestBody VersionEndpoint = Nothing

80getEndpointRequestBody VersionEndpoint = Nothing

@@ -97,10 +94,6 @@ getEndpointRequestBody (InspectContainerEndpoint _) = Nothing

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

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

99getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing

96getEndpointRequestBody (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

98getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

src/Docker/Client/Types.hs+26−133

@@ -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,7 +23,7 @@ module Docker.Client.Types (

26 , ContainerPortInfo(..)

23 , ContainerPortInfo(..)

27 , Container(..)

24 , Container(..)

28 , ContainerState(..)

25 , ContainerState(..)

29− , State(..)

26+ , Status(..)

30 , Digest

27 , Digest

31 , Label(..)

28 , Label(..)

32 , Tag

29 , Tag

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

40 , DetachKeys(..)

37 , DetachKeys(..)

41 , StartOpts(..)

38 , StartOpts(..)

42 , defaultStartOpts

39 , defaultStartOpts

43− , ContainerDeleteOpts(..)

40+ , DeleteOpts(..)

44− , defaultContainerDeleteOpts

41+ , defaultDeleteOpts

45− , ImageDeleteOpts(..)

46− , defaultImageDeleteOpts

47 , Timestamp

42 , Timestamp

48 , TailLogOpt(..)

43 , TailLogOpt(..)

49 , LogOpts(..)

44 , LogOpts(..)

50 , defaultLogOpts

45 , defaultLogOpts

51− , CreateNetworkOpts(..)

52− , defaultCreateNetworkOpts

53 , VolumePermission(..)

46 , VolumePermission(..)

54 , Bind(..)

47 , Bind(..)

55 , Volume(..)

48 , Volume(..)

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

75 , UTSMode(..)

68 , UTSMode(..)

76 , HostConfig(..)

69 , HostConfig(..)

77 , defaultHostConfig

70 , defaultHostConfig

78− , NetworkingConfig(..)

79− , EndpointConfig(..)

80 , Ulimit(..)

71 , Ulimit(..)

81 , ContainerResources(..)

72 , ContainerResources(..)

82 , defaultContainerResources

73 , defaultContainerResources

@@ -132,13 +123,10 @@ data Endpoint =

132 | UnpauseContainerEndpoint ContainerID

123 | UnpauseContainerEndpoint ContainerID

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

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

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

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

135− | DeleteContainerEndpoint ContainerDeleteOpts ContainerID

126+ | DeleteContainerEndpoint DeleteOpts ContainerID

136 | InspectContainerEndpoint ContainerID

127 | InspectContainerEndpoint ContainerID

137 | BuildImageEndpoint BuildOpts FilePath

128 | BuildImageEndpoint BuildOpts FilePath

138 | CreateImageEndpoint T.Text Tag (Maybe T.Text) -- ^ Either pull an image from docker hub or imports an image from a tarball (or URL)

129 | CreateImageEndpoint T.Text Tag (Maybe T.Text) -- ^ Either pull an image from docker hub or imports an image from a tarball (or URL)

139− | DeleteImageEndpoint ImageDeleteOpts ImageID

140− | CreateNetworkEndpoint CreateNetworkOpts

141− | RemoveNetworkEndpoint NetworkID

142 deriving (Eq, Show)

130 deriving (Eq, Show)

143

131

144-- | We should newtype this

132-- | We should newtype this

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

250 , processLabel :: Text

238 , processLabel :: Text

251 , resolveConfPath :: FilePath

239 , resolveConfPath :: FilePath

252 , restartCount :: Int

240 , restartCount :: Int

253− , containerDetailsState :: ContainerState

241+ , state :: ContainerState

254 , mounts :: [Mount]

242 , mounts :: [Mount]

255 }

243 }

256 deriving (Eq, Show, Generic)

244 deriving (Eq, Show, Generic)

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

293 , restarting :: Bool

281 , restarting :: Bool

294 , running :: Bool

282 , running :: Bool

295 , startedAt :: UTCTime

283 , startedAt :: UTCTime

296− , state :: State

284+ , status :: Status

297 }

285 }

298 deriving (Eq, Show, Generic)

286 deriving (Eq, Show, Generic)

299

287

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

523 , containerImageId :: ImageID

511 , containerImageId :: ImageID

524 , containerCommand :: Text

512 , containerCommand :: Text

525 , containerCreatedAt :: Int

513 , containerCreatedAt :: Int

526− , containerState :: State

527− , containerStatus :: Maybe Text

514+ , containerStatus :: Status

528 , containerPorts :: [ContainerPortInfo]

515 , containerPorts :: [ContainerPortInfo]

529 , containerLabels :: [Label]

516 , containerLabels :: [Label]

530 , containerNetworks :: [Network]

517 , containerNetworks :: [Network]

@@ -540,7 +527,6 @@ instance FromJSON Container where

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

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

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

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

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

529 <*> (v .: "State")

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

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

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

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

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

546 <*> (v .: "NetworkSettings" >>= parseNetworks)

532 <*> (v .: "NetworkSettings" >>= parseNetworks)

@@ -551,11 +537,11 @@ instance FromJSON Container where

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

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

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

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

553

539

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

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

541+data Status = ContainerStatus T.Text

556 deriving (Eq, Show, Generic)

542 deriving (Eq, Show, Generic)

557

543

558−instance FromJSON State where

544+instance FromJSON Status where

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

545 parseJSON (JSON.String "running") = return Running

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

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

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

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

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

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

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

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

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

625

611

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

612

650-- | Options used for creating a Container.

613-- | Options used for creating a Container.

651data CreateOpts = CreateOpts {

614data CreateOpts = CreateOpts {

652− containerConfig :: ContainerConfig

615+ containerConfig :: ContainerConfig

653− , hostConfig :: HostConfig

616+ , hostConfig :: HostConfig

654− , networkingConfig :: NetworkingConfig

655 } deriving (Eq, Show)

617 } deriving (Eq, Show)

656

618

657instance ToJSON CreateOpts where

619instance ToJSON CreateOpts where

658− toJSON (CreateOpts cc hc nc) = do

620+ toJSON (CreateOpts cc hc) = do

659 let ccJSON = toJSON cc

621 let ccJSON = toJSON cc

660 let hcJSON = toJSON hc

622 let hcJSON = toJSON hc

661 case ccJSON of

623 case ccJSON of

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

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

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

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

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

667

627

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

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

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

697 binds=[]

657 binds=[]

698 , containerIDFile=Nothing

658 , containerIDFile=Nothing

699 , logConfig=LogDriverConfig JsonFile []

659 , logConfig=LogDriverConfig JsonFile []

700− , networkMode=NetworkBridge

660+ , networkMode=Bridge

701 , portBindings=[]

661 , portBindings=[]

702 , restartPolicy=RestartOff

662 , restartPolicy=RestartOff

703 , volumeDriver=Nothing

663 , volumeDriver=Nothing

@@ -744,11 +704,7 @@ defaultContainerResources = ContainerResources {

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

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

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

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

746defaultCreateOpts :: T.Text -> CreateOpts

706defaultCreateOpts :: T.Text -> CreateOpts

747−defaultCreateOpts imageName = CreateOpts

748− { containerConfig = defaultContainerConfig imageName

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

749− , hostConfig = defaultHostConfig

750− , networkingConfig = NetworkingConfig HM.empty

751− }

752

708

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

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

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

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

762defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }

718defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }

763

719

764-- | Options for deleting a container.

720-- | Options for deleting a container.

765−data ContainerDeleteOpts = ContainerDeleteOpts {

721+data DeleteOpts = DeleteOpts {

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

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

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

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

768 } deriving (Eq, Show)

724 } deriving (Eq, Show)

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

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

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

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

794-- running.

750-- running.

795−defaultContainerDeleteOpts :: ContainerDeleteOpts

751+defaultDeleteOpts :: DeleteOpts

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

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

753

805-- | Timestamp alias.

754-- | Timestamp alias.

806type Timestamp = Integer

755type Timestamp = Integer

@@ -828,36 +777,6 @@ defaultLogOpts = LogOpts { stdout = True

828 , tail = All

777 , tail = All

829 }

778 }

830

779

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

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

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

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

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

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

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

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

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

1018

937

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

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

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

939+data NetworkMode = Bridge | Host | NetworkDisabled

1021 deriving (Eq, Show, Ord)

940 deriving (Eq, Show, Ord)

1022

941

1023instance FromJSON NetworkMode where

942instance FromJSON NetworkMode where

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

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

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

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

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

945 parseJSON (JSON.String "none") = return NetworkDisabled

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

1028 parseJSON _ = fail "Unknown NetworkMode"

946 parseJSON _ = fail "Unknown NetworkMode"

1029

947

1030instance ToJSON NetworkMode where

948instance ToJSON NetworkMode where

1031− toJSON NetworkBridge = JSON.String "bridge"

949+ toJSON Bridge = JSON.String "bridge"

1032− toJSON NetworkHost = JSON.String "host"

950+ toJSON Host = JSON.String "host"

1033− toJSON NetworkDisabled = JSON.String "none"

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

952

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

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

1057

954

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

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

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

1453

1350

1454instance ToJSON EnvVar where

1351instance ToJSON EnvVar where

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

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

1456

1353

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

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

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

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

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

1564 macAddress labels stopSignal

1461 macAddress labels stopSignal

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

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

1566

1463

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

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

1569−#else

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

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

1571−#endif

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

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

1573 Nothing ->

1466 Nothing ->

1574 fail "Could not parse Integer"

1467 fail "Could not parse Integer"

stack-7.10.yaml+1−4

@@ -11,10 +11,7 @@ packages:

11flags: {}

13# Extra package databases containing global packages

14−extra-deps:

15−- directory-1.2.7.0

14+extra-deps: [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

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

20# system-ghc: true

17# system-ghc: true

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+14−82

@@ -2,7 +2,6 @@

3module Main where

5−import Data.Either (rights)

6import Prelude hiding (all)

5import Prelude hiding (all)

7import qualified Test.QuickCheck.Monadic as QCM

6import qualified Test.QuickCheck.Monadic as QCM

8import Test.Tasty

7import Test.Tasty

@@ -15,7 +14,6 @@ import Control.Monad (forM_)

15import Control.Monad.IO.Class

14import Control.Monad.IO.Class

16import Control.Monad.Trans.Class (lift)

15import Control.Monad.Trans.Class (lift)

17import qualified Data.Aeson as JSON

16import qualified Data.Aeson as JSON

18−import Data.Aeson ((.=))

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

17import Data.Aeson.Lens (key, _Array, _Null, _Object,

20 _String, _Value)

18 _String, _Value)

21import qualified Data.ByteString as B

19import qualified Data.ByteString as B

@@ -24,7 +22,7 @@ import qualified Data.ByteString.Lazy as BL

24import qualified Data.HashMap.Strict as HM

22import qualified Data.HashMap.Strict as HM

25import Data.Int (Int)

23import Data.Int (Int)

26import qualified Data.Map as M

24import qualified Data.Map as M

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

25+import Data.Maybe (fromJust, isJust)

28import Data.Monoid

26import Data.Monoid

29import Data.Text (Text, unpack)

27import Data.Text (Text, unpack)

30import qualified Data.Vector as V

28import qualified Data.Vector as V

@@ -40,7 +38,6 @@ import Docker.Client

41-- opts = defaultClientOpts

39-- opts = defaultClientOpts

42testImageName = "docker-hs/test"

40testImageName = "docker-hs/test"

43−imageToDeleteFullName = "hello-world:latest"

45toStrict1 = B.concat . BL.toChunks

42toStrict1 = B.concat . BL.toChunks

@@ -74,28 +71,17 @@ testFindImage =

74 where

71 where

75 imageFullName = testImageName <> ":latest"

72 imageFullName = testImageName <> ":latest"

77−testDeleteImage :: IO ()

78−testDeleteImage = runDocker $ do

79− img <- fmap fromJust findTestImage

80− result <- deleteImage defaultImageDeleteOpts (imageId img)

81− lift $ assert $ isRight result

82− maybeTestImageAfter <- findTestImage

83− lift $ assert $ isNothing maybeTestImageAfter

84− where

85− findTestImage =

86− do

87− images <- listImages defaultListOpts >>= fromRight

88− return $ listToMaybe

89− $ filter (elem imageToDeleteFullName . imageRepoTags) images

90−

91testListContainers :: IO ()

74testListContainers :: IO ()

92testListContainers =

75testListContainers =

93− runDocker $

76+ runDocker $ do

94− do containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing

95− c <- fromRight containerId

96− res <- listContainers $ ListOpts { all=True }

77+ res <- listContainers $ ListOpts { all=True }

97− deleteContainer (ContainerDeleteOpts True True) c

78+ case res of

79+ Right cs -> do

80+ forM_ cs $ \r -> do

81+ lift $ print (containerNetworks r)

82+ lift $ print (containerStatus r)

83+ Left e -> lift $ print e

98− lift $ assert $ isRight res

84+ lift $ assert $ isRight res

100testBuildFromDockerfile :: IO ()

86testBuildFromDockerfile :: IO ()

101testBuildFromDockerfile = do

87testBuildFromDockerfile = do

@@ -105,19 +91,10 @@ testBuildFromDockerfile = do

105 r <- buildImageFromDockerfile (defaultBuildOpts "docker-hs/dockerfile-test") ctxDir

91 r <- buildImageFromDockerfile (defaultBuildOpts "docker-hs/dockerfile-test") ctxDir

106 lift $ assert $ isRight r

92 lift $ assert $ isRight r

107

108−

109testRunAndReadLog :: IO ()

94testRunAndReadLog :: IO ()

110−testRunAndReadLog = testRunAndReadLogHelper $ NetworkingConfig HM.empty

95+testRunAndReadLog =

111−

112−testRunAndReadLogWithNetworking :: IO ()

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

114−

115−testRunAndReadLogHelper :: NetworkingConfig -> IO ()

116−testRunAndReadLogHelper networkingConfig =

117 runDocker $

96 runDocker $

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

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

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

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

121 c <- fromRight containerId

98 c <- fromRight containerId

122 status1 <- startContainer defaultStartOpts c

99 status1 <- startContainer defaultStartOpts c

123 _ <- inspectContainer c >>= fromRight

100 _ <- inspectContainer c >>= fromRight

@@ -125,24 +102,11 @@ testRunAndReadLogHelper networkingConfig =

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

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

126 logs <- getContainerLogs defaultLogOpts c >>= fromRight

103 logs <- getContainerLogs defaultLogOpts c >>= fromRight

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

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

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

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

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

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

130− mapM_ removeNetwork createdNetworks

131 where

107 where

132 isRightUnit (Right ()) = True

108 isRightUnit (Right ()) = True

133 isRightUnit _ = False

109 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

110

147testLogDriverOptionsJson :: TestTree

111testLogDriverOptionsJson :: TestTree

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

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

@@ -213,29 +177,6 @@ testEntrypointJson = testGroup "Testing ContainerConfig JSON" [testSample1, test

213 Just (Entrypoint sampleEntrypointArr)

177 Just (Entrypoint sampleEntrypointArr)

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

178 sampleEntrypointArr = ["cmd", "--some-flag", "--some-flag2"]

215

179

216−testEnvVarJson :: TestTree

217−testEnvVarJson = testGroup "Testing EnvVar JSON" [testSampleEncode, testSampleDecode]

218− where

219− testSampleEncode =

220− testCase "Test toJSON" $ assert $ JSON.toJSON (EnvVar "cellar" "door") == JSON.String "cellar=door"

221− testSampleDecode =

222− testCase "Test fromJSON" $ assert $ (JSON.decode "\"cellar=door\"" :: Maybe EnvVar) ==

223− Just (EnvVar "cellar" "door")

224−

225−testNetworkingConfigJson :: TestTree

226−testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSampleEncode]

227− where

228− testSampleEncode =

229− let networkingConfig = NetworkingConfig $ HM.fromList [("custom-network", EndpointConfig ["cellar", "door"])]

230− in testCase "Test toJSON" $ assert $ JSON.toJSON networkingConfig ==

231− JSON.object

232− [ "EndpointsConfig" .= JSON.object

233− [ "custom-network" .= JSON.object

234− [ "Aliases" .= (["cellar", "door"] :: [Text])

235− ]

236− ]

237− ]

238−

239integrationTests :: TestTree

180integrationTests :: TestTree

240integrationTests =

181integrationTests =

241 testGroup

182 testGroup

@@ -243,12 +184,9 @@ integrationTests =

243 [ testCase "Get docker version" testDockerVersion

184 [ testCase "Get docker version" testDockerVersion

244 , testCase "Build image from Dockerfile" testBuildFromDockerfile

185 , testCase "Build image from Dockerfile" testBuildFromDockerfile

245 , testCase "Find image by name" testFindImage

186 , testCase "Find image by name" testFindImage

246− , testCase "Delete image" testDeleteImage

247 , testCase "List containers" testListContainers

187 , testCase "List containers" testListContainers

248 , testCase "Run a dummy container and read its log" testRunAndReadLog

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

189 , testCase "Try to stop a container that doesn't exist" testStopNonexisting

251− , testCase "Create and remove a network" testCreateRemoveNetwork

252 ]

190 ]

253

191

254jsonTests :: TestTree

192jsonTests :: TestTree

@@ -260,16 +198,10 @@ jsonTests =

260 , testLabelsJson

198 , testLabelsJson

261 , testLogDriverOptionsJson

199 , testLogDriverOptionsJson

262 , testEntrypointJson

200 , testEntrypointJson

263− , testEnvVarJson

264− , testNetworkingConfigJson

265 ]

201 ]

266

202

267setup :: IO ()

203setup :: IO ()

268−setup =

269− mapM_ system

270− [ "docker pull " ++ unpack imageToDeleteFullName

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

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

272− ]

273

205

274isLeft = not . isRight

206isLeft = not . isRight

275

207