WIP fixed listing containers

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

@@ -246,11 +246,11 @@ data ContainerDetails = ContainerDetails {
 -- | Data type used for parsing the mount information from a container
 -- list.
 data Mount = Mount {
-      mountName        :: Text
+      mountName        :: Maybe Text
     , 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
@@ -520,11 +520,11 @@ data Container = Container
 
 instance FromJSON Container where
         parseJSON o@(JSON.Object v) =
-            Container <$> (parseJSON o)
+            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 .: "Status")
                 <*> (v .: "Ports")
@@ -538,17 +538,17 @@ instance FromJSON Container where
         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
-    parseJSON (JSON.String "running")    = return Running
-    parseJSON (JSON.String "created")    = return Created -- Note: Guessing on the string values of these.
-    parseJSON (JSON.String "restarting") = return Restarting
-    parseJSON (JSON.String "paused")     = return Paused
-    parseJSON (JSON.String "exited")     = return Exited
-    parseJSON (JSON.String "dead")       = return Dead
-    parseJSON _                          = fail "Unknown Status"
+    parseJSON (JSON.String s) = return $ ContainerStatus s
+    -- parseJSON (JSON.String "Created")    = return Created
+    -- parseJSON (JSON.String "Restarting") = return Restarting
+    -- parseJSON (JSON.String "Paused")     = return Paused
+    -- parseJSON (JSON.String "Exited")     = parseExited s
+    -- parseJSON (JSON.String "Dead")       = return Dead
+    parseJSON _               = fail "Failed to parse Status. Unknown Status."
 
 -- | Alias for representing a RepoDigest. We could newtype this and add
 -- some validation.
@@ -788,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
@@ -71,10 +73,15 @@ testFindImage =
 
 testListContainers :: IO ()
 testListContainers =
-  runDocker $
-  do res <- listContainers defaultListOpts
-     liftIO $ print res
-     lift $ assert $ isRight res
+  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