git.iko.soy/docker-hs
on master help sign in
WIP fixed listing containers
d7e3042Deni 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+20−18
@@ -246,11 +246,11 @@ data ContainerDetails = ContainerDetails {
246-- | Data type used for parsing the mount information from a container
246-- | Data type used for parsing the mount information from a container
247-- list.
247-- list.
248data Mount = Mount {
248data Mount = Mount {
249− mountName :: Text
249+ mountName :: Maybe Text
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
@@ -520,11 +520,11 @@ data Container = Container
520
520
521instance FromJSON Container where
521instance FromJSON Container where
522 parseJSON o@(JSON.Object v) =
522 parseJSON o@(JSON.Object v) =
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 .: "Status")
529 <*> (v .: "Status")
530 <*> (v .: "Ports")
530 <*> (v .: "Ports")
@@ -538,17 +538,17 @@ instance FromJSON Container where
538 parseJSON _ = fail "Container: Not a JSON object."
538 parseJSON _ = fail "Container: Not a JSON object."
539
539
540-- | Represents the status of the container life cycle.
540-- | Represents the status of the container life cycle.
541−data Status = Created | Restarting | Running | Paused | Exited | Dead
541+data Status = ContainerStatus T.Text
542 deriving (Eq, Show, Generic)
542 deriving (Eq, Show, Generic)
543
543
544instance FromJSON Status where
544instance FromJSON Status where
545− parseJSON (JSON.String "running") = return Running
545+ parseJSON (JSON.String s) = return $ ContainerStatus s
546− parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.
546+ -- parseJSON (JSON.String "Created") = return Created
547− parseJSON (JSON.String "restarting") = return Restarting
547+ -- parseJSON (JSON.String "Restarting") = return Restarting
548− parseJSON (JSON.String "paused") = return Paused
548+ -- parseJSON (JSON.String "Paused") = return Paused
549− parseJSON (JSON.String "exited") = return Exited
549+ -- parseJSON (JSON.String "Exited") = parseExited s
550− parseJSON (JSON.String "dead") = return Dead
550+ -- parseJSON (JSON.String "Dead") = return Dead
551− parseJSON _ = fail "Unknown Status"
551+ parseJSON _ = fail "Failed to parse Status. Unknown Status."
552
552
553-- | Alias for representing a RepoDigest. We could newtype this and add
553-- | Alias for representing a RepoDigest. We could newtype this and add
554-- some validation.
554-- some validation.
@@ -788,6 +788,8 @@ instance ToJSON VolumePermission where
788instance FromJSON VolumePermission where
788instance FromJSON VolumePermission where
789 parseJSON "rw" = return ReadWrite
789 parseJSON "rw" = return ReadWrite
790 parseJSON "ro" = return ReadOnly
790 parseJSON "ro" = return ReadOnly
791+ parseJSON "RW" = return ReadWrite
792+ parseJSON "RO" = return ReadOnly
791 parseJSON _ = fail "Failed to parse VolumePermission"
793 parseJSON _ = fail "Failed to parse VolumePermission"
792
794
793-- | 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+11−4
@@ -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
@@ -71,10 +73,15 @@ testFindImage =
71
73
72testListContainers :: IO ()
74testListContainers :: IO ()
73testListContainers =
75testListContainers =
74− runDocker $
76+ runDocker $ do
75− do res <- listContainers defaultListOpts
77+ res <- listContainers $ ListOpts { all=True }
76− liftIO $ print res
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
77− lift $ assert $ isRight res
84+ lift $ assert $ isRight res
78
85
79testBuildFromDockerfile :: IO ()
86testBuildFromDockerfile :: IO ()
80testBuildFromDockerfile = do
87testBuildFromDockerfile = do