09fb912 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

Merge branch 'bug/listcontainers' into pr48

commit09fb91220bd34a6464961c545a8cad59c7c3964a authorDeni Bertovic <deni@denibertovic.com> dateTue 9 Jan 2018, 00:22 (9 years ago) parent6f06028 d7e3042

4 files changed+30−13

compare with master

unifiedsplit

Makefile+1−1 src/Docker/Client/Internal.hs+3−2 src/Docker/Client/Types.hs+11−10 tests/tests.hs+15

Makefile+1−1

@@ -18,7 +18,7 @@ repl:

1818

1919## Run tests. Example RUN_INTEGRATION_TESTS=1 make test

2020test:

21− @stack test

21+ @RUN_INTEGRATION_TESTS=1 stack test

2222

2323## Cut new release

2424release:

src/Docker/Client/Internal.hs+3−2

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

55import Data.ByteString (ByteString)

66import qualified Data.ByteString.Char8 as BSC

77import qualified Data.Conduit.Binary as CB

8−import Data.Text as T

8+import qualified Data.Text as T

99import Data.Text.Encoding (decodeUtf8, encodeUtf8)

1010import qualified Network.HTTP.Client as HTTP

1111import Network.HTTP.Conduit (requestBodySourceChunked)

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

1313 encodePathSegments)

14+import Prelude hiding (all)

1415

1516import Docker.Client.Types

1617

@@ -26,7 +27,7 @@ encodeQ = encodeUtf8 . T.pack

2627

2728getEndpoint :: ApiVersion -> Endpoint -> T.Text

2829getEndpoint v VersionEndpoint = encodeURL [v, "version"]

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

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

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

3132getEndpoint v (CreateContainerEndpoint _ cn) = case cn of

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

src/Docker/Client/Types.hs+11−10

@@ -249,8 +249,8 @@ data Mount = Mount {

249249 mountName :: Maybe Text -- this is optional

250250 , mountSource :: FilePath

251251 , mountDestination :: FilePath

252− , mountDriver :: Text

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

252+ , mountDriver :: Maybe Text

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

254254 , mountRW :: Bool

255255 , mountPropogation :: Text

256256 }

@@ -258,14 +258,14 @@ data Mount = Mount {

258258

259259instance FromJSON Mount where

260260 parseJSON (JSON.Object o) = do

261− name <- o .: "Name"

261+ name <- o .:? "Name"

262262 src <- o .: "Source"

263263 dest <- o .: "Destination"

264− driver <- o .: "Driver"

265− mode <- o .: "Mode"

264+ driver <- o .:? "Driver"

265+ -- mode <- o .: "Mode"

266266 rw <- o .: "RW"

267267 prop <- o .: "Propagation"

268− return $ Mount name src dest driver mode rw prop

268+ return $ Mount name src dest driver rw prop

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

270270

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

@@ -523,8 +523,8 @@ instance FromJSON Container where

523523 Container <$> parseJSON o

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

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

526− <*> (v .: "ImageID")

527− <*> (v .: "Command")

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

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

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

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

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

@@ -535,11 +535,10 @@ instance FromJSON Container where

535535 parseNetworks (JSON.Object v) =

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

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

538−

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

540539

541540-- | Represents the status of the container life cycle.

541+data Status = ContainerStatus T.Text

543542 deriving (Eq, Show, Generic)

544543

545544instance FromJSON Status where

@@ -789,6 +788,8 @@ instance ToJSON VolumePermission where

789788instance FromJSON VolumePermission where

790789 parseJSON "rw" = return ReadWrite

791790 parseJSON "ro" = return ReadOnly

791+ parseJSON "RW" = return ReadWrite

792+ parseJSON "RO" = return ReadOnly

792793 parseJSON _ = fail "Failed to parse VolumePermission"

793794

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

tests/tests.hs+15

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

33module Main where

5+import Prelude hiding (all)

56import qualified Test.QuickCheck.Monadic as QCM

67import Test.Tasty

78import Test.Tasty.HUnit

@@ -9,6 +10,7 @@ import Test.Tasty.QuickCheck (testProperty)

910

1011import Control.Concurrent (threadDelay)

1112import Control.Lens ((^.), (^?))

13+import Control.Monad (forM_)

1214import Control.Monad.IO.Class

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

1416import qualified Data.Aeson as JSON

@@ -69,6 +71,18 @@ testFindImage =

6971 where

7072 imageFullName = testImageName <> ":latest"

7173

74+testListContainers :: IO ()

75+testListContainers =

76+ runDocker $ do

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

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

84+ lift $ assert $ isRight res

85+

7286testBuildFromDockerfile :: IO ()

7387testBuildFromDockerfile = do

7488 cur <- getCurrentDirectory

@@ -170,6 +184,7 @@ integrationTests =

170184 [ testCase "Get docker version" testDockerVersion

171185 , testCase "Build image from Dockerfile" testBuildFromDockerfile

172186 , testCase "Find image by name" testFindImage

187+ , testCase "List containers" testListContainers

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

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

175190 ]