@@ -24,7 +24,7 @@ module Docker.Client.Types (
24 , ContainerState(..)
24 , ContainerState(..)
25 , Status(..)
25 , Status(..)
27− , Labels(..)
27+ , Label(..)
29 , Image(..)
29 , Image(..)
30 , dropImagePrefix
30 , dropImagePrefix
@@ -492,7 +492,7 @@ data Container = Container
492 , containerCreatedAt :: Int
492 , containerCreatedAt :: Int
493 , containerStatus :: Status
493 , containerStatus :: Status
494 , containerPorts :: [ContainerPortInfo]
494 , containerPorts :: [ContainerPortInfo]
495− , containerLabels :: Labels
495+ , containerLabels :: [Label]
496 , containerNetworks :: Networks
496 , containerNetworks :: Networks
497 , containerMounts :: [Mount]
497 , containerMounts :: [Mount]
498 } deriving (Show, Eq)
498 } deriving (Show, Eq)
@@ -535,13 +535,24 @@ instance FromJSON Status where
535type Digest = Text
535type Digest = Text
537-- | Container and Image Labels.
537-- | Container and Image Labels.
538−newtype Labels = Labels (M.Map Name Value) deriving (Eq, Show)
538+data Label = Label Name Value deriving (Eq, Show)
540−instance FromJSON Labels where
541− parseJSON val = Labels <$> parseJSON val
541+-- If there are multiple lables with the same Name in the list
542+-- then the last one wins.
543−instance ToJSON Labels where
543+instance ToJSON [Label] where
544− toJSON (Labels kvs) = object [k .= v | (k,v) <- (M.toList kvs)]
544+ toJSON [] = JSON.Object HM.empty
545+ toJSON (l:ls) = JSON.Object $ foldl f HM.empty (l:ls)
546+ where f acc (Label n v) = HM.insert n (toJSON v) acc
548+instance FromJSON [Label] where
549+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
550+ where f accM k v = do
552+ value <- parseJSON v
553+ return $ (Label k value):acc
554+ parseJSON JSON.Null = return []
555+ parseJSON _ = fail "Failed to parse Labels. Not an object."
546-- | Alias for Tags.
557-- | Alias for Tags.
547type Tag = Text
558type Tag = Text
@@ -555,7 +566,7 @@ data Image = DockerImage {
555 , imageRepoDigests :: Maybe [Digest]
566 , imageRepoDigests :: Maybe [Digest]
556 , imageSize :: Integer
567 , imageSize :: Integer
557 , imageVirtualSize :: Integer
568 , imageVirtualSize :: Integer
558− , imageLabels :: Maybe Labels
569+ , imageLabels :: [Label]
559 } deriving (Show, Eq, Generic)
570 } deriving (Show, Eq, Generic)
561-- | Helper function used for dropping the "image" prefix when serializing
572-- | Helper function used for dropping the "image" prefix when serializing
@@ -563,9 +574,22 @@ data Image = DockerImage {
563dropImagePrefix :: [a] -> [a]
574dropImagePrefix :: [a] -> [a]
564dropImagePrefix = drop 5
575dropImagePrefix = drop 5
566instance FromJSON Image where
578instance FromJSON Image where
567− parseJSON = genericParseJSON defaultOptions {
579+ parseJSON (JSON.Object o) = do
568− fieldLabelModifier = dropImagePrefix}
580+ imageId <- o .: "Id"
581+ imageCreated <- o .: "Created"
582+ imageParentId <- o .:? "ParentId"
583+ imageRepoTags <- o .: "RepoTags"
584+ imageRepoDigests <- o .:? "RepoDigests"
585+ imageSize <- o .: "Size"
586+ imageVirtualSize <- o .: "VirtualSize"
587+ imageLabels <- case HM.lookup "Labels" o of
588+ Just ls -> parseJSON ls
589+ Nothing -> return []
590+ return $ DockerImage imageId imageCreated imageParentId imageRepoTags imageRepoDigests imageSize imageVirtualSize imageLabels
591+ parseJSON _ = fail "Failed to parse DockerImage."
570-- | Options used for creating a Container.
594-- | Options used for creating a Container.
571data CreateOpts = CreateOpts {
595data CreateOpts = CreateOpts {
@@ -604,7 +628,7 @@ defaultContainerConfig imageName = ContainerConfig {
604 , entrypoint=Nothing
628 , entrypoint=Nothing
605 , networkDisabled=Nothing
629 , networkDisabled=Nothing
606 , macAddress=Nothing
630 , macAddress=Nothing
607− , labels=Nothing
631+ , labels=[]
608 , stopSignal=SIGTERM
632 , stopSignal=SIGTERM
@@ -1329,7 +1353,7 @@ data ContainerConfig = ContainerConfig {
1329 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
1353 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
1330 , macAddress :: Maybe Text
1354 , macAddress :: Maybe Text
1331 -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.
1355 -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.
1332− , labels :: Maybe Labels
1356+ , labels :: [Label]
1333 , stopSignal :: Signal
1357 , stopSignal :: Signal
1334 } deriving (Eq, Show, Generic)
1358 } deriving (Eq, Show, Generic)
@@ -1359,7 +1383,9 @@ instance FromJSON ContainerConfig where
1359 entrypoint <- o .:? "Entrypoint"
1383 entrypoint <- o .:? "Entrypoint"
1360 networkDisabled <- o .:? "networkDisabled"
1384 networkDisabled <- o .:? "networkDisabled"
1361 macAddress <- o .:? "MacAddress"
1385 macAddress <- o .:? "MacAddress"
1362− labels <- o .:? "Labels"
1386+ labels <- case HM.lookup "Labels" o of
1387+ Just ls -> parseJSON ls
1388+ Nothing -> return []
1363 stopSignal <- o .: "StopSignal"
1389 stopSignal <- o .: "StopSignal"
1364 return $ ContainerConfig hostname domainname user attachStdin attachStdout attachStderr exposedPorts tty openStdin stdinOnce env cmd image volumes workingDir entrypoint networkDisabled
1390 return $ ContainerConfig hostname domainname user attachStdin attachStdout attachStderr exposedPorts tty openStdin stdinOnce env cmd image volumes workingDir entrypoint networkDisabled
1365 macAddress labels stopSignal
1391 macAddress labels stopSignal