Merge branch 'bug/listcontainers' into pr48

Makefile

@@ -18,7 +18,7 @@ repl:
 
 ## Run tests. Example RUN_INTEGRATION_TESTS=1 make test
 test:
-	@stack test
+	@RUN_INTEGRATION_TESTS=1 stack test
 
 ## Cut new release
 release:

src/Docker/Client/Internal.hs

@@ -5,12 +5,13 @@ import qualified Data.Aeson               as JSON
 import           Data.ByteString          (ByteString)
 import qualified Data.ByteString.Char8    as BSC
 import qualified Data.Conduit.Binary      as CB
-import           Data.Text                as T
+import qualified Data.Text                as T
 import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
 import qualified Network.HTTP.Client      as HTTP
 import           Network.HTTP.Conduit     (requestBodySourceChunked)
 import           Network.HTTP.Types       (Query, encodePath,
                                            encodePathSegments)
+import           Prelude                  hiding (all)
 
 import           Docker.Client.Types
 
@@ -26,7 +27,7 @@ encodeQ = encodeUtf8 . T.pack
 
 getEndpoint :: ApiVersion -> Endpoint -> T.Text
 getEndpoint v VersionEndpoint = encodeURL [v, "version"]
-getEndpoint v (ListContainersEndpoint _) = encodeURL [v, "containers", "json"] -- Make use of lsOpts here
+getEndpoint v (ListContainersEndpoint (ListOpts all)) = encodeURLWithQuery [v, "containers", "json"] [("all", Just (encodeQ $ show all))]
 getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
 getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
         Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]

src/Docker/Client/Types.hs

@@ -249,8 +249,8 @@ data Mount = Mount {
       mountName        :: Maybe Text -- this is optional
     , mountSource      :: FilePath
     , mountDestination :: FilePath
-    , mountDriver      :: Text
-    , mountMode        :: Maybe VolumePermission -- apparently this can be null
+    , mountDriver      :: Maybe Text
+    -- , mountMode        :: Maybe VolumePermission -- apparently this can be null
     , mountRW          :: Bool
     , mountPropogation :: Text
     }
@@ -258,14 +258,14 @@ data Mount = Mount {
 
 instance FromJSON Mount where
     parseJSON (JSON.Object o) = do
-        name <- o .: "Name"
+        name <- o .:? "Name"
         src <- o .: "Source"
         dest <- o .: "Destination"
-        driver <- o .: "Driver"
-        mode <- o .: "Mode"
+        driver <- o .:? "Driver"
+        -- mode <- o .: "Mode"
         rw <- o .: "RW"
         prop <- o .: "Propagation"
-        return $ Mount name src dest driver mode rw prop
+        return $ Mount name src dest driver rw prop
     parseJSON _ = fail "Mount is not an object"
 
 -- | Data type used for parsing the container state from a list of
@@ -523,8 +523,8 @@ instance FromJSON Container where
             Container <$> parseJSON o
                 <*> (v .: "Names")
                 <*> (v .: "Image")
-                <*> (v .: "ImageID")
-                <*> (v .: "Command")
+                <*> (v .: "ImageID") -- Doesn't exist anymore
+                <*> (v .: "Command") -- Doesn't exist anymore
                 <*> (v .: "Created")
                 <*> (v .: "State")
                 <*> (v .: "Ports")
@@ -535,11 +535,10 @@ instance FromJSON Container where
                 parseNetworks (JSON.Object v) =
                     (v .: "Networks") >>= parseJSON
                 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
-
         parseJSON _ = fail "Container: Not a JSON object."
 
 -- | Represents the status of the container life cycle.
-data Status = Created | Restarting | Running | Paused | Exited | Dead
+data Status = ContainerStatus T.Text
     deriving (Eq, Show, Generic)
 
 instance FromJSON Status where
@@ -789,6 +788,8 @@ instance ToJSON VolumePermission where
 instance FromJSON VolumePermission where
     parseJSON "rw" = return ReadWrite
     parseJSON "ro" = return ReadOnly
+    parseJSON "RW" = return ReadWrite
+    parseJSON "RO" = return ReadOnly
     parseJSON _    = fail "Failed to parse VolumePermission"
 
 -- | Used for marking a directory in the container as "exposed" hence

tests/tests.hs

@@ -2,6 +2,7 @@
 
 module Main where
 
+import           Prelude                   hiding (all)
 import qualified Test.QuickCheck.Monadic   as QCM
 import           Test.Tasty
 import           Test.Tasty.HUnit
@@ -9,6 +10,7 @@ import           Test.Tasty.QuickCheck     (testProperty)
 
 import           Control.Concurrent        (threadDelay)
 import           Control.Lens              ((^.), (^?))
+import           Control.Monad             (forM_)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class (lift)
 import qualified Data.Aeson                as JSON
@@ -69,6 +71,18 @@ testFindImage =
   where
     imageFullName = testImageName <> ":latest"
 
+testListContainers :: IO ()
+testListContainers =
+  runDocker $ do
+    res <- listContainers $ ListOpts { all=True }
+    case res of
+     Right cs -> do
+       forM_ cs $ \r -> do
+         lift $ print (containerNetworks r)
+         lift $ print (containerStatus r)
+     Left e -> lift $ print e
+    lift $ assert $ isRight res
+
 testBuildFromDockerfile :: IO ()
 testBuildFromDockerfile = do
   cur <- getCurrentDirectory
@@ -170,6 +184,7 @@ integrationTests =
     [ testCase "Get docker version" testDockerVersion
     , testCase "Build image from Dockerfile" testBuildFromDockerfile
     , testCase "Find image by name" testFindImage
+    , testCase "List containers" testListContainers
     , testCase "Run a dummy container and read its log" testRunAndReadLog
     , testCase "Try to stop a container that doesn't exist" testStopNonexisting
     ]