master..3ba8757 · docker-hs

git.iko.soy/docker-hs

12 files changed+21−100

unifiedsplit

.travis.yml−8 CHANGELOG.md+1−14 docker.cabal+5−5 src/Docker/Client/Api.hs+2−9 src/Docker/Client/Http.hs+1−5 src/Docker/Client/Internal.hs+1−4 src/Docker/Client/Types.hs+6−20 stack-7.10.yaml−1 stack-8.6.4.yaml−4 stack-8.8.2.yaml−5 stack.yaml+1−1 tests/tests.hs+4−24

.travis.yml−8

@@ -39,14 +39,6 @@ env:

3939 - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.0.2

4040 - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.0.2

4141

42− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.6.4

43− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.6.4

44− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.6.4

45−

46− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.8.2

47− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.8.2

48− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.8.2

49−

5042addons:

5143 apt:

5244 packages:

CHANGELOG.md+1−14

@@ -1,20 +1,7 @@

11# CHANGELOG

3−## 0.6.0.3 (2020-02-17)

3+## 0.5.2.0 (2018-06-22)

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.

185- Bump aeson version.

196- Implement network aliases.

207- Implement creating/deleting networks.

docker.cabal+5−5

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

11name: docker

2−version: 0.6.0.3

2+version: 0.5.2.0

33synopsis: An API client for docker written in Haskell

44description: See API documentation below.

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

@@ -28,9 +28,9 @@ library

2828 , aeson >= 0.9.0 && < 2.0.0

2929 , blaze-builder >= 0.4.0 && < 0.5.0

3030 , bytestring >= 0.10.0 && < 0.11.0

31− , containers >= 0.5.0 && < 0.7.0

31+ , containers >= 0.5.0 && < 0.6.0

3232 , data-default-class >= 0.0.1 && < 0.2.0

33− , http-client >= 0.4.0 && < 0.7.0

33+ , http-client >= 0.4.0 && < 0.6.0

3434 , http-types >= 0.9 && < 0.13

3535 , vector

3636 , conduit

@@ -51,9 +51,9 @@ library

5151 , mtl >= 2.0.0 && < 3.0.0

5252 , network >= 2.6.0

5353 , text >= 1.0.0 && < 2.0.0

54− , time >= 1.5.0 && < 2.0.0

54+ , time >= 1.5.0 && < 1.9.0

5555 , scientific >= 0.3.0 && < 0.4.0

56− , tls >= 1.3.7 && < 1.6.0

56+ , tls >= 1.3.7 && < 1.5.0

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

5858 , x509 >= 1.6.0 && < 1.8.0

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

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

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

1818 , getContainerLogsStream

1919 -- * Images

2020 , listImages

21− , deleteImage

2221 , buildImageFromDockerfile

2322 , pullImage

2423 -- * Network

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

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

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

9695

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−

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

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

10598-- for some sane defaults.

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

145138unpauseContainer cid = requestUnit GET $ UnpauseContainerEndpoint cid

146139

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

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

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

149142-- defaults.

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

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

151144deleteContainer dopts cid = requestUnit DELETE $ DeleteContainerEndpoint dopts cid

152145

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

src/Docker/Client/Http.hs+1−5

@@ -273,11 +273,6 @@ statusCodeToError (CreateImageEndpoint _ _ _) st =

273273 Nothing

274274 else

275275 Just $ DockerInvalidStatusCode st

276−statusCodeToError (DeleteImageEndpoint _ _) st =

277− if st == status200 then

278− Nothing

279− else

280− Just $ DockerInvalidStatusCode st

281276statusCodeToError (CreateNetworkEndpoint _) st =

282277 if st == status201 then

283278 Nothing

@@ -288,3 +283,4 @@ statusCodeToError (RemoveNetworkEndpoint _) st =

288283 Nothing

289284 else

290285 Just $ DockerInvalidStatusCode st

286+

src/Docker/Client/Internal.hs+1−4

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

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

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

5959 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) =

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

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

6363getEndpoint v (InspectContainerEndpoint cid) =

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

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

7676 n = encodeQ $ T.unpack name

7777 t = encodeQ $ T.unpack tag

78−getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid]

7978getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"]

8079getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]

8180

@@ -97,8 +96,6 @@ getEndpointRequestBody (InspectContainerEndpoint _) = Nothing

9796

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

9998getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing

100−getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing

101−

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

103100getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

104101

src/Docker/Client/Types.hs+6−20

@@ -40,10 +40,8 @@ module Docker.Client.Types (

4040 , DetachKeys(..)

4141 , StartOpts(..)

4242 , defaultStartOpts

43− , ContainerDeleteOpts(..)

44− , defaultContainerDeleteOpts

45− , ImageDeleteOpts(..)

46− , defaultImageDeleteOpts

43+ , DeleteOpts(..)

44+ , defaultDeleteOpts

4745 , Timestamp

4846 , TailLogOpt(..)

4947 , LogOpts(..)

@@ -132,11 +130,10 @@ data Endpoint =

132130 | UnpauseContainerEndpoint ContainerID

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

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

135− | DeleteContainerEndpoint ContainerDeleteOpts ContainerID

133+ | DeleteContainerEndpoint DeleteOpts ContainerID

136134 | InspectContainerEndpoint ContainerID

137135 | BuildImageEndpoint BuildOpts FilePath

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

140137 | CreateNetworkEndpoint CreateNetworkOpts

141138 | RemoveNetworkEndpoint NetworkID

142139 deriving (Eq, Show)

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

762759defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }

763760

764761-- | Options for deleting a container.

765−data ContainerDeleteOpts = ContainerDeleteOpts {

762+data DeleteOpts = DeleteOpts {

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

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

768765 } deriving (Eq, Show)

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

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

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

794791-- running.

795−defaultContainerDeleteOpts :: ContainerDeleteOpts

796−defaultContainerDeleteOpts = ContainerDeleteOpts { 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

792+defaultDeleteOpts :: DeleteOpts

793+defaultDeleteOpts = DeleteOpts { deleteVolumes = False, force = False }

804794

805795-- | Timestamp alias.

806796type Timestamp = Integer

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

15641554 macAddress labels stopSignal

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

15661556

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

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

1569−#else

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

1571−#endif

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

15731559 Nothing ->

15741560 fail "Could not parse Integer"

stack-7.10.yaml−1

@@ -14,7 +14,6 @@ flags: {}

1414extra-deps:

1515- directory-1.2.7.0

1616- unliftio-core-0.1.1.0

17−- process-1.6.5.1

1817

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

2019# system-ghc: true

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-8.0.2.yaml

tests/tests.hs+4−24

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

2424import qualified Data.HashMap.Strict as HM

2525import Data.Int (Int)

2626import qualified Data.Map as M

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

27+import Data.Maybe (fromJust, isJust)

2828import Data.Monoid

2929import Data.Text (Text, unpack)

3030import qualified Data.Vector as V

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

4040

4141-- opts = defaultClientOpts

4242testImageName = "docker-hs/test"

43−imageToDeleteFullName = "hello-world:latest"

4443

4544toStrict1 = B.concat . BL.toChunks

4645

@@ -74,27 +73,13 @@ testFindImage =

7473 where

7574 imageFullName = testImageName <> ":latest"

7675

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−

9176testListContainers :: IO ()

9277testListContainers =

9378 runDocker $

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

9580 c <- fromRight containerId

9681 res <- listContainers $ ListOpts { all=True }

97− deleteContainer (ContainerDeleteOpts True True) c

82+ deleteContainer (DeleteOpts True True) c

9883 lift $ assert $ isRight res

9984

10085testBuildFromDockerfile :: IO ()

@@ -125,7 +110,7 @@ testRunAndReadLogHelper networkingConfig =

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

126111 logs <- getContainerLogs defaultLogOpts c >>= fromRight

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

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

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

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

130115 mapM_ removeNetwork createdNetworks

131116 where

@@ -243,7 +228,6 @@ integrationTests =

243228 [ testCase "Get docker version" testDockerVersion

244229 , testCase "Build image from Dockerfile" testBuildFromDockerfile

245230 , testCase "Find image by name" testFindImage

246− , testCase "Delete image" testDeleteImage

247231 , testCase "List containers" testListContainers

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

249233 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking

@@ -265,11 +249,7 @@ jsonTests =

265249 ]

266250

267251setup :: IO ()

268−setup =

269− mapM_ system

270− [ "docker pull " ++ unpack imageToDeleteFullName

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

272− ]

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

273253

274254isLeft = not . isRight

275255