git.iko.soy/docker-hs
on master help sign in
Merge branch 'bug/listcontainers' into pr48
09fb912Deni Bertovic
Makefile+1−1
compare with master
unifiedsplit
@@ -18,7 +18,7 @@ repl:
18
18
19## Run tests. Example RUN_INTEGRATION_TESTS=1 make test
19## Run tests. Example RUN_INTEGRATION_TESTS=1 make test
20test:
20test:
21− @stack test
21+ @RUN_INTEGRATION_TESTS=1 stack test
22
22
23## Cut new release
23## Cut new release
24release:
24release:
src/Docker/Client/Internal.hs+3−2
@@ -5,12 +5,13 @@ import qualified Data.Aeson as JSON
5import Data.ByteString (ByteString)
5import Data.ByteString (ByteString)
6import qualified Data.ByteString.Char8 as BSC
6import qualified Data.ByteString.Char8 as BSC
7import qualified Data.Conduit.Binary as CB
7import qualified Data.Conduit.Binary as CB
8−import Data.Text as T
8+import qualified Data.Text as T
9import Data.Text.Encoding (decodeUtf8, encodeUtf8)
9import Data.Text.Encoding (decodeUtf8, encodeUtf8)
10import qualified Network.HTTP.Client as HTTP
10import qualified Network.HTTP.Client as HTTP
11import Network.HTTP.Conduit (requestBodySourceChunked)
11import Network.HTTP.Conduit (requestBodySourceChunked)
12import Network.HTTP.Types (Query, encodePath,
12import Network.HTTP.Types (Query, encodePath,
13 encodePathSegments)
13 encodePathSegments)
14+import Prelude hiding (all)
14
15
15import Docker.Client.Types
16import Docker.Client.Types
16
17
@@ -26,7 +27,7 @@ encodeQ = encodeUtf8 . T.pack
26
27
27getEndpoint :: ApiVersion -> Endpoint -> T.Text
28getEndpoint :: ApiVersion -> Endpoint -> T.Text
28getEndpoint v VersionEndpoint = encodeURL [v, "version"]
29getEndpoint 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))]
30getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
31getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
31getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
32getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
32 Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
33 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 {
249 mountName :: Maybe Text -- this is optional
249 mountName :: Maybe Text -- this is optional
250 , mountSource :: FilePath
250 , mountSource :: FilePath
251 , mountDestination :: FilePath
251 , mountDestination :: FilePath
252− , mountDriver :: Text
252+ , mountDriver :: Maybe Text
253− , mountMode :: Maybe VolumePermission -- apparently this can be null
253+ -- , mountMode :: Maybe VolumePermission -- apparently this can be null
254 , mountRW :: Bool
254 , mountRW :: Bool
255 , mountPropogation :: Text
255 , mountPropogation :: Text
256 }
256 }
@@ -258,14 +258,14 @@ data Mount = Mount {
258
258
259instance FromJSON Mount where
259instance FromJSON Mount where
260 parseJSON (JSON.Object o) = do
260 parseJSON (JSON.Object o) = do
261− name <- o .: "Name"
261+ name <- o .:? "Name"
262 src <- o .: "Source"
262 src <- o .: "Source"
263 dest <- o .: "Destination"
263 dest <- o .: "Destination"
264− driver <- o .: "Driver"
264+ driver <- o .:? "Driver"
265− mode <- o .: "Mode"
265+ -- mode <- o .: "Mode"
266 rw <- o .: "RW"
266 rw <- o .: "RW"
267 prop <- o .: "Propagation"
267 prop <- o .: "Propagation"
268− return $ Mount name src dest driver mode rw prop
268+ return $ Mount name src dest driver rw prop
269 parseJSON _ = fail "Mount is not an object"
269 parseJSON _ = fail "Mount is not an object"
270
270
271-- | Data type used for parsing the container state from a list of
271-- | Data type used for parsing the container state from a list of
@@ -523,8 +523,8 @@ instance FromJSON Container where
523 Container <$> parseJSON o
523 Container <$> parseJSON o
524 <*> (v .: "Names")
524 <*> (v .: "Names")
525 <*> (v .: "Image")
525 <*> (v .: "Image")
526− <*> (v .: "ImageID")
526+ <*> (v .: "ImageID") -- Doesn't exist anymore
527− <*> (v .: "Command")
527+ <*> (v .: "Command") -- Doesn't exist anymore
528 <*> (v .: "Created")
528 <*> (v .: "Created")
529 <*> (v .: "State")
529 <*> (v .: "State")
530 <*> (v .: "Ports")
530 <*> (v .: "Ports")
@@ -535,11 +535,10 @@ instance FromJSON Container where
535 parseNetworks (JSON.Object v) =
535 parseNetworks (JSON.Object v) =
536 (v .: "Networks") >>= parseJSON
536 (v .: "Networks") >>= parseJSON
537 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
537 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
538−
539 parseJSON _ = fail "Container: Not a JSON object."
538 parseJSON _ = fail "Container: Not a JSON object."
540
539
541-- | Represents the status of the container life cycle.
540-- | Represents the status of the container life cycle.
542−data Status = Created | Restarting | Running | Paused | Exited | Dead
541+data Status = ContainerStatus T.Text
543 deriving (Eq, Show, Generic)
542 deriving (Eq, Show, Generic)
544
543
545instance FromJSON Status where
544instance FromJSON Status where
@@ -789,6 +788,8 @@ instance ToJSON VolumePermission where
789instance FromJSON VolumePermission where
788instance FromJSON VolumePermission where
790 parseJSON "rw" = return ReadWrite
789 parseJSON "rw" = return ReadWrite
791 parseJSON "ro" = return ReadOnly
790 parseJSON "ro" = return ReadOnly
791+ parseJSON "RW" = return ReadWrite
792+ parseJSON "RO" = return ReadOnly
792 parseJSON _ = fail "Failed to parse VolumePermission"
793 parseJSON _ = fail "Failed to parse VolumePermission"
793
794
794-- | Used for marking a directory in the container as "exposed" hence
795-- | Used for marking a directory in the container as "exposed" hence
tests/tests.hs+15
@@ -2,6 +2,7 @@
2
2
3module Main where
3module Main where
4
4
5+import Prelude hiding (all)
5import qualified Test.QuickCheck.Monadic as QCM
6import qualified Test.QuickCheck.Monadic as QCM
6import Test.Tasty
7import Test.Tasty
7import Test.Tasty.HUnit
8import Test.Tasty.HUnit
@@ -9,6 +10,7 @@ import Test.Tasty.QuickCheck (testProperty)
9
10
10import Control.Concurrent (threadDelay)
11import Control.Concurrent (threadDelay)
11import Control.Lens ((^.), (^?))
12import Control.Lens ((^.), (^?))
13+import Control.Monad (forM_)
12import Control.Monad.IO.Class
14import Control.Monad.IO.Class
13import Control.Monad.Trans.Class (lift)
15import Control.Monad.Trans.Class (lift)
14import qualified Data.Aeson as JSON
16import qualified Data.Aeson as JSON
@@ -69,6 +71,18 @@ testFindImage =
69 where
71 where
70 imageFullName = testImageName <> ":latest"
72 imageFullName = testImageName <> ":latest"
71
73
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+
72testBuildFromDockerfile :: IO ()
86testBuildFromDockerfile :: IO ()
73testBuildFromDockerfile = do
87testBuildFromDockerfile = do
74 cur <- getCurrentDirectory
88 cur <- getCurrentDirectory
@@ -170,6 +184,7 @@ integrationTests =
170 [ testCase "Get docker version" testDockerVersion
184 [ testCase "Get docker version" testDockerVersion
171 , testCase "Build image from Dockerfile" testBuildFromDockerfile
185 , testCase "Build image from Dockerfile" testBuildFromDockerfile
172 , testCase "Find image by name" testFindImage
186 , testCase "Find image by name" testFindImage
187+ , testCase "List containers" testListContainers
173 , testCase "Run a dummy container and read its log" testRunAndReadLog
188 , testCase "Run a dummy container and read its log" testRunAndReadLog
174 , testCase "Try to stop a container that doesn't exist" testStopNonexisting
189 , testCase "Try to stop a container that doesn't exist" testStopNonexisting
175 ]
190 ]