@@ -1,7 +1,7 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4−module Docker.Client.Types (
4+module Docker.Types (
5 Endpoint(..)
5 Endpoint(..)
7 , ApiVersion
7 , ApiVersion
@@ -11,11 +11,7 @@ module Docker.Client.Types (
12 , fromImageID
12 , fromImageID
13 , toImageID
13 , toImageID
17 , Timeout(..)
14 , Timeout(..)
19 , Signal(..)
15 , Signal(..)
20 , ContainerDetails(..)
16 , ContainerDetails(..)
21 , DockerClientOpts(..)
17 , DockerClientOpts(..)
@@ -26,48 +22,40 @@ module Docker.Client.Types (
26 , ContainerPortInfo(..)
22 , ContainerPortInfo(..)
27 , Container(..)
23 , Container(..)
28 , ContainerState(..)
24 , ContainerState(..)
29− , State(..)
25+ , Status(..)
31− , Label(..)
27+ , Labels(..)
33 , Image(..)
29 , Image(..)
35 , dropImagePrefix
30 , dropImagePrefix
36 , CreateOpts(..)
31 , CreateOpts(..)
39 , defaultCreateOpts
32 , defaultCreateOpts
40 , DetachKeys(..)
33 , DetachKeys(..)
41 , StartOpts(..)
34 , StartOpts(..)
42 , defaultStartOpts
35 , defaultStartOpts
43− , ContainerDeleteOpts(..)
36+ , DeleteOpts(..)
44− , defaultContainerDeleteOpts
45− , ImageDeleteOpts(..)
46− , defaultImageDeleteOpts
47 , Timestamp
37 , Timestamp
48 , TailLogOpt(..)
38 , TailLogOpt(..)
49 , LogOpts(..)
39 , LogOpts(..)
50 , defaultLogOpts
40 , defaultLogOpts
51− , CreateNetworkOpts(..)
52− , defaultCreateNetworkOpts
53 , VolumePermission(..)
41 , VolumePermission(..)
55 , Volume(..)
42 , Volume(..)
56 , Device(..)
43 , Device(..)
57 , ContainerName
44 , ContainerName
58 , VolumeFrom(..)
45 , VolumeFrom(..)
59 , Link(..)
46 , Link(..)
60 , LogDriverType(..)
47 , LogDriverType(..)
61− , LogDriverOption(..)
48+ , LogDriverOptions(..)
62 , LogDriverConfig(..)
49 , LogDriverConfig(..)
63 , NetworkMode(..)
50 , NetworkMode(..)
64 , PortType(..)
51 , PortType(..)
65−-- , NetworkInterface(..)
52+ , NetworkInterface(..)
66− , Network(..)
53+ , Networks(..)
67 , NetworkSettings(..)
54 , NetworkSettings(..)
68 , NetworkOptions(..)
55 , NetworkOptions(..)
69 , Mount(..)
56 , Mount(..)
70 , PortBinding(..)
57 , PortBinding(..)
71 , HostPort(..)
59 , HostPort(..)
72 , RetryCount
60 , RetryCount
73 , RestartPolicy(..)
61 , RestartPolicy(..)
@@ -75,8 +63,6 @@ module Docker.Client.Types (
75 , UTSMode(..)
63 , UTSMode(..)
76 , HostConfig(..)
64 , HostConfig(..)
77 , defaultHostConfig
65 , defaultHostConfig
78− , NetworkingConfig(..)
80 , Ulimit(..)
66 , Ulimit(..)
81 , ContainerResources(..)
67 , ContainerResources(..)
82 , defaultContainerResources
68 , defaultContainerResources
@@ -86,18 +72,7 @@ module Docker.Client.Types (
86 , EnvVar(..)
72 , EnvVar(..)
87 , ContainerConfig(..)
73 , ContainerConfig(..)
88 , defaultContainerConfig
74 , defaultContainerConfig
89− , ExposedPort(..)
75+ , ExposedPorts(..)
99− , MemoryConstraint(..)
100− , MemoryConstraintSize(..)
103import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
78import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
@@ -107,57 +82,39 @@ import qualified Data.Aeson as JSON
107import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
82import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
108import Data.Char (isAlphaNum, toUpper)
83import Data.Char (isAlphaNum, toUpper)
109import qualified Data.HashMap.Strict as HM
84import qualified Data.HashMap.Strict as HM
85+import qualified Data.Map as M
110import Data.Monoid ((<>))
86import Data.Monoid ((<>))
111−import Data.Scientific (floatingOrInteger)
112import Data.Text (Text)
87import Data.Text (Text)
113import qualified Data.Text as T
88import qualified Data.Text as T
114import Data.Time.Clock (UTCTime)
89import Data.Time.Clock (UTCTime)
115−import qualified Data.Vector as V
116import GHC.Generics (Generic)
90import GHC.Generics (Generic)
117import Prelude hiding (all, tail)
91import Prelude hiding (all, tail)
118import Text.Read (readMaybe)
92import Text.Read (readMaybe)
120−-- | List of Docker Engine API endpoints
121data Endpoint =
94data Endpoint =
122 VersionEndpoint
95 VersionEndpoint
123 | ListContainersEndpoint ListOpts
96 | ListContainersEndpoint ListOpts
124 | ListImagesEndpoint ListOpts
97 | ListImagesEndpoint ListOpts
125− | CreateContainerEndpoint CreateOpts (Maybe ContainerName)
98+ | CreateContainerEndpoint CreateOpts
126 | StartContainerEndpoint StartOpts ContainerID
99 | StartContainerEndpoint StartOpts ContainerID
127 | StopContainerEndpoint Timeout ContainerID
100 | StopContainerEndpoint Timeout ContainerID
128− | WaitContainerEndpoint ContainerID
129 | KillContainerEndpoint Signal ContainerID
101 | KillContainerEndpoint Signal ContainerID
130 | RestartContainerEndpoint Timeout ContainerID
102 | RestartContainerEndpoint Timeout ContainerID
131 | PauseContainerEndpoint ContainerID
103 | PauseContainerEndpoint ContainerID
132 | UnpauseContainerEndpoint ContainerID
104 | UnpauseContainerEndpoint ContainerID
133− | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.
105+ | ContainerLogsEndpoint LogOpts Bool ContainerID -- Second argument (Bool) is whether to follow.
134− -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.
135− | DeleteContainerEndpoint ContainerDeleteOpts ContainerID
106+ | DeleteContainerEndpoint DeleteOpts ContainerID
136 | InspectContainerEndpoint ContainerID
107 | InspectContainerEndpoint ContainerID
137− | BuildImageEndpoint BuildOpts FilePath
138− | CreateImageEndpoint T.Text Tag (Maybe T.Text) -- ^ Either pull an image from docker hub or imports an image from a tarball (or URL)
139− | DeleteImageEndpoint ImageDeleteOpts ImageID
140− | CreateNetworkEndpoint CreateNetworkOpts
141− | RemoveNetworkEndpoint NetworkID
142 deriving (Eq, Show)
108 deriving (Eq, Show)
144−-- | We should newtype this
145type URL = Text
110type URL = Text
147−-- | We should newtype this
148type ApiVersion = Text
111type ApiVersion = Text
151−-- | ID of a contianer
152newtype ContainerID = ContainerID Text
112newtype ContainerID = ContainerID Text
153 deriving (Eq, Show)
113 deriving (Eq, Show)
155−-- | Used for extracting the id of the container from the newtype
156fromContainerID :: ContainerID -> Text
115fromContainerID :: ContainerID -> Text
157fromContainerID (ContainerID t) = t
116fromContainerID (ContainerID t) = t
159−-- | Used for parsing a Text value into a ContainerID. We apply some basic
161toContainerID :: Text -> Maybe ContainerID
118toContainerID :: Text -> Maybe ContainerID
162toContainerID t =
119toContainerID t =
163 if T.all (\c -> isAlphaNum c || c == ':') t then -- Note: Can we improve this whitelist?
120 if T.all (\c -> isAlphaNum c || c == ':') t then -- Note: Can we improve this whitelist?
@@ -165,16 +122,12 @@ toContainerID t =
169newtype ImageID = ImageID Text
125newtype ImageID = ImageID Text
170 deriving (Eq, Show)
126 deriving (Eq, Show)
172−-- | Used for extracting the id of the image from the newtype.
173fromImageID :: ImageID -> Text
128fromImageID :: ImageID -> Text
174fromImageID (ImageID t) = t
129fromImageID (ImageID t) = t
176−-- | Helper function used for parsing a Text value into an ImageID. For now
177−-- just basic validation is used.
178toImageID :: Text -> Maybe ImageID
131toImageID :: Text -> Maybe ImageID
179toImageID t =
132toImageID t =
180 if T.all (\c -> isAlphaNum c || c == ':') t then -- Note: Can we improve this whitelist?
133 if T.all (\c -> isAlphaNum c || c == ':') t then -- Note: Can we improve this whitelist?
@@ -182,26 +135,9 @@ toImageID t =
185−-- | Timeout used for stopping a container. DefaultTimeout is 10 seconds.
186data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)
138data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)
188−data StatusCode = StatusCode Int
190−instance ToJSON StatusCode where
191− toJSON (StatusCode c) = object ["StatusCode" .= c]
193−instance FromJSON StatusCode where
194− parseJSON (JSON.Object o) = do
195− c <- o .: "StatusCode"
196− if c >= 0 && c <= 255 then
197− return (StatusCode c)
199− fail "Unknown exit code"
200− parseJSON _ = fail "Unknown exit code"
202-- TODO: Add more Signals or use an existing lib
140-- TODO: Add more Signals or use an existing lib
203−-- | Signal used for sending to the process running in the container.
204−-- The default signal is SIGTERM.
205data Signal = SIGHUP
141data Signal = SIGHUP
207 | SIGQUIT
143 | SIGQUIT
@@ -213,16 +149,16 @@ data Signal = SIGHUP
214instance FromJSON Signal where
150instance FromJSON Signal where
215 parseJSON (JSON.String "SIGTERM") = return SIGTERM
151 parseJSON (JSON.String "SIGTERM") = return SIGTERM
216− parseJSON (JSON.String "SIGHUP") = return SIGHUP -- Note: Guessing on the string values for these.
152+ parseJSON (JSON.String "SIGHUP") = return SIGHUP -- Note: Guessing on the string values for these.
217− parseJSON (JSON.String "SIGINT") = return SIGINT
153+ parseJSON (JSON.String "SIGINT") = return SIGINT
218 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT
154 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT
219 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP
155 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP
220 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1
156 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1
221− parseJSON _ = fail "Unknown Signal"
157+ parseJSON _ = fail "Unknown Signal"
223instance ToJSON Signal where
159instance ToJSON Signal where
224− toJSON SIGHUP = "SIGHUP"
160+ toJSON SIGHUP = "SIGHUP"
225− toJSON SIGINT = "SIGINT"
161+ toJSON SIGINT = "SIGINT"
226 toJSON SIGQUIT = "SIGQUIT"
162 toJSON SIGQUIT = "SIGQUIT"
227 toJSON SIGSTOP = "SIGSTOP"
163 toJSON SIGSTOP = "SIGSTOP"
228 toJSON SIGTERM = "SIGTERM"
164 toJSON SIGTERM = "SIGTERM"
@@ -250,19 +186,17 @@ data ContainerDetails = ContainerDetails {
250 , processLabel :: Text
186 , processLabel :: Text
251 , resolveConfPath :: FilePath
187 , resolveConfPath :: FilePath
252 , restartCount :: Int
188 , restartCount :: Int
253− , containerDetailsState :: ContainerState
189+ , state :: ContainerState
254 , mounts :: [Mount]
190 , mounts :: [Mount]
256 deriving (Eq, Show, Generic)
192 deriving (Eq, Show, Generic)
258−-- | Data type used for parsing the mount information from a container
260data Mount = Mount {
194data Mount = Mount {
261− mountName :: Maybe Text -- this is optional
195+ mountName :: Text
262 , mountSource :: FilePath
196 , mountSource :: FilePath
263 , mountDestination :: FilePath
197 , mountDestination :: FilePath
264− , mountDriver :: Maybe Text
198+ , mountDriver :: Text
265− -- , mountMode :: Maybe VolumePermission -- apparently this can be null
199+ , mountMode :: Text -- Note: Improve this?
266 , mountRW :: Bool
200 , mountRW :: Bool
267 , mountPropogation :: Text
201 , mountPropogation :: Text
@@ -270,18 +204,16 @@ data Mount = Mount {
271instance FromJSON Mount where
205instance FromJSON Mount where
272 parseJSON (JSON.Object o) = do
206 parseJSON (JSON.Object o) = do
273− name <- o .:? "Name"
207+ name <- o .: "Name"
274 src <- o .: "Source"
208 src <- o .: "Source"
275 dest <- o .: "Destination"
209 dest <- o .: "Destination"
276− driver <- o .:? "Driver"
210+ driver <- o .: "Driver"
277− -- mode <- o .: "Mode"
211+ mode <- o .: "Mode"
278 rw <- o .: "RW"
212 rw <- o .: "RW"
279 prop <- o .: "Propagation"
213 prop <- o .: "Propagation"
280− return $ Mount name src dest driver rw prop
214+ return $ Mount name src dest driver mode rw prop
281 parseJSON _ = fail "Mount is not an object"
215 parseJSON _ = fail "Mount is not an object"
283−-- | Data type used for parsing the container state from a list of
285data ContainerState = ContainerState {
217data ContainerState = ContainerState {
286 containerError :: Text
218 containerError :: Text
287 , exitCode :: Int
219 , exitCode :: Int
@@ -293,7 +225,7 @@ data ContainerState = ContainerState {
293 , restarting :: Bool
225 , restarting :: Bool
294 , running :: Bool
226 , running :: Bool
295 , startedAt :: UTCTime
227 , startedAt :: UTCTime
296− , state :: State
228+ , status :: Status
298 deriving (Eq, Show, Generic)
230 deriving (Eq, Show, Generic)
@@ -313,30 +245,23 @@ instance FromJSON ContainerState where
313 return $ ContainerState err exit finished oomKilled dead paused pid restarting running started st
245 return $ ContainerState err exit finished oomKilled dead paused pid restarting running started st
314 parseJSON _ = fail "ContainerState is not an object"
246 parseJSON _ = fail "ContainerState is not an object"
317−-- | Client options used to configure the remote engine we're talking to
318data DockerClientOpts = DockerClientOpts {
248data DockerClientOpts = DockerClientOpts {
319 apiVer :: ApiVersion
249 apiVer :: ApiVersion
320 , baseUrl :: URL
250 , baseUrl :: URL
322 deriving (Eq, Show)
252 deriving (Eq, Show)
324−-- | Default "DockerClientOpts" used for talking to the docker engine.
325defaultClientOpts :: DockerClientOpts
254defaultClientOpts :: DockerClientOpts
326defaultClientOpts = DockerClientOpts {
255defaultClientOpts = DockerClientOpts {
327− apiVer = "v1.24"
256+ apiVer = "v1.23"
328 , baseUrl = "http://127.0.0.1:2375"
257 , baseUrl = "http://127.0.0.1:2375"
331−-- | List options used for filtering the list of container or images.
332data ListOpts = ListOpts { all :: Bool } deriving (Eq, Show)
260data ListOpts = ListOpts { all :: Bool } deriving (Eq, Show)
334−-- | Default "ListOpts". Doesn't list stopped containers.
335defaultListOpts :: ListOpts
262defaultListOpts :: ListOpts
336defaultListOpts = ListOpts { all=False }
263defaultListOpts = ListOpts { all=False }
338−-- | Data type used for represneting the version of the docker engine
340data DockerVersion = DockerVersion {
265data DockerVersion = DockerVersion {
341 version :: Text
266 version :: Text
342 , apiVersion :: ApiVersion
267 , apiVersion :: ApiVersion
@@ -406,8 +331,6 @@ instance FromJSON ImageID where
406 return iid
331 return iid
407 parseJSON _ = fail "ImageID is not an object."
332 parseJSON _ = fail "ImageID is not an object."
409−-- | Data type used for representing the information of various ports that
410−-- a contianer may expose.
411data ContainerPortInfo = ContainerPortInfo {
334data ContainerPortInfo = ContainerPortInfo {
412 ipAddressInfo :: Maybe Text
335 ipAddressInfo :: Maybe Text
413 , privatePortInfo :: Port
336 , privatePortInfo :: Port
@@ -424,8 +347,6 @@ instance FromJSON ContainerPortInfo where
424 parseJSON _ = fail "ContainerPortInfo: Not a JSON object."
347 parseJSON _ = fail "ContainerPortInfo: Not a JSON object."
426-- For inspecting container details.
349-- For inspecting container details.
427−-- | Data type used for parsing the network information of each container
428−-- when listing them.
429data NetworkOptions = NetworkOptions {
350data NetworkOptions = NetworkOptions {
430-- ipamConfig :: Maybe Text -- Don't see in 1.24
351-- ipamConfig :: Maybe Text -- Don't see in 1.24
431-- , links :: Maybe Text -- Don't see in 1.24
352-- , links :: Maybe Text -- Don't see in 1.24
@@ -455,40 +376,41 @@ instance FromJSON NetworkOptions where
455 return $ NetworkOptions networkId endpointId gateway ip ipLen ip6Gateway globalIP6 globalIP6Len mac
376 return $ NetworkOptions networkId endpointId gateway ip ipLen ip6Gateway globalIP6 globalIP6Len mac
456 parseJSON _ = fail "NetworkOptions is not an object"
377 parseJSON _ = fail "NetworkOptions is not an object"
458−-- TODO: Not sure what this is used for anymore.
379+newtype Networks = Networks (M.Map NetworkMode NetworkOptions) -- Note: Is it ever possible that there will be duplicates of network modes?
459−data Network = Network NetworkMode NetworkOptions
460 deriving (Eq, Show)
380 deriving (Eq, Show)
462−instance {-# OVERLAPPING #-} FromJSON [Network] where
382+instance FromJSON Networks where
463− parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
383+ parseJSON (JSON.Object o) = do
384+ Networks <$> HM.foldlWithKey' f (return M.empty) o
465 f accM k' v' = do
387 f accM k' v' = do
466 acc <- accM
388 acc <- accM
467 k <- parseJSON $ JSON.String k'
389 k <- parseJSON $ JSON.String k'
468 v <- parseJSON v'
390 v <- parseJSON v'
469− return $ (Network k v):acc
391+ return $ M.insert k v acc
470 parseJSON _ = fail "Networks is not an object"
393 parseJSON _ = fail "Networks is not an object"
472−-- | Data type reprsenting the various network settings a container can have.
473data NetworkSettings = NetworkSettings {
395data NetworkSettings = NetworkSettings {
474− networkSettingsBridge :: Text
396+ networkSettingsBridge :: Text
475− , networkSettingsSandboxId :: Text
397+ , networkSettingsSandboxId :: Text
476− , networkSettingsHairpinMode :: Bool
398+ , networkSettingsHairpinMode :: Bool
477− , networkSettingsLinkLocalIPv6Address :: Text
399+ , networkSettingsLinkLocalIPv6Address :: Text
478 , networkSettingsLinkLocalIPv6PrefixLen :: Int
400 , networkSettingsLinkLocalIPv6PrefixLen :: Int
479− , networkSettingsPorts :: [PortBinding]
401+ , networkSettingsPorts :: PortBindings
480− , networkSettingsSandboxKey :: Text
402+ , networkSettingsSandboxKey :: Text
481− , networkSettingsSecondaryIPAddresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
403+ , networkSettingsSecondaryIPAddresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
482 , networkSettingsSecondaryIPv6Addresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
404 , networkSettingsSecondaryIPv6Addresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
483− , networkSettingsEndpointID :: Text
405+ , networkSettingsEndpointID :: Text
484− , networkSettingsGateway :: Text
406+ , networkSettingsGateway :: Text
485− , networkSettingsGlobalIPv6Address :: Text
407+ , networkSettingsGlobalIPv6Address :: Text
486− , networkSettingsGlobalIPv6PrefixLen :: Int
408+ , networkSettingsGlobalIPv6PrefixLen :: Int
487− , networkSettingsIpAddress :: Text
409+ , networkSettingsIpAddress :: Text
488− , networkSettingsIpPrefixLen :: Int
410+ , networkSettingsIpPrefixLen :: Int
489− , networkSettingsIpv6Gateway :: Text
411+ , networkSettingsIpv6Gateway :: Text
490− , networkSettingsMacAddress :: Text
412+ , networkSettingsMacAddress :: Text
491− , networkSettingsNetworks :: [Network]
413+ , networkSettingsNetworks :: Networks
493 deriving (Eq, Show)
415 deriving (Eq, Show)
@@ -515,7 +437,6 @@ instance FromJSON NetworkSettings where
515 return $ NetworkSettings bridge sandbox hairpin localIP6 localIP6Len ports sandboxKey secondaryIP secondayIP6 endpointID gateway globalIP6 globalIP6Len ip ipLen ip6Gateway mac networks
437 return $ NetworkSettings bridge sandbox hairpin localIP6 localIP6Len ports sandboxKey secondaryIP secondayIP6 endpointID gateway globalIP6 globalIP6Len ip ipLen ip6Gateway mac networks
516 parseJSON _ = fail "NetworkSettings is not an object."
438 parseJSON _ = fail "NetworkSettings is not an object."
518−-- | Data type used for parsing a list of containers.
519data Container = Container
440data Container = Container
520 { containerId :: ContainerID
441 { containerId :: ContainerID
521 , containerNames :: [Text]
442 , containerNames :: [Text]
@@ -523,23 +444,21 @@ data Container = Container
523 , containerImageId :: ImageID
444 , containerImageId :: ImageID
524 , containerCommand :: Text
445 , containerCommand :: Text
525 , containerCreatedAt :: Int
446 , containerCreatedAt :: Int
526− , containerState :: State
527− , containerStatus :: Maybe Text
447+ , containerStatus :: Status
528 , containerPorts :: [ContainerPortInfo]
448 , containerPorts :: [ContainerPortInfo]
529− , containerLabels :: [Label]
449+ , containerLabels :: Labels
530− , containerNetworks :: [Network]
450+ , containerNetworks :: Networks
531 , containerMounts :: [Mount]
451 , containerMounts :: [Mount]
532 } deriving (Show, Eq)
452 } deriving (Show, Eq)
534instance FromJSON Container where
454instance FromJSON Container where
535− parseJSON o@(JSON.Object v) =
455+ parseJSON (JSON.Object v) =
536− Container <$> parseJSON o
456+ Container <$> (v .: "Id")
537 <*> (v .: "Names")
457 <*> (v .: "Names")
538 <*> (v .: "Image")
458 <*> (v .: "Image")
539− <*> (v .: "ImageID") -- Doesn't exist anymore
459+ <*> (v .: "ImageID")
540− <*> (v .: "Command") -- Doesn't exist anymore
460+ <*> (v .: "Command")
541 <*> (v .: "Created")
461 <*> (v .: "Created")
543 <*> (v .: "Status")
462 <*> (v .: "Status")
544 <*> (v .: "Ports")
463 <*> (v .: "Ports")
545 <*> (v .: "Labels")
464 <*> (v .: "Labels")
@@ -549,124 +468,65 @@ instance FromJSON Container where
549 parseNetworks (JSON.Object v) =
468 parseNetworks (JSON.Object v) =
550 (v .: "Networks") >>= parseJSON
469 (v .: "Networks") >>= parseJSON
551 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
470 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
552 parseJSON _ = fail "Container: Not a JSON object."
472 parseJSON _ = fail "Container: Not a JSON object."
554−-- | Represents the state of the container life cycle.
555−data State = Created | Restarting | Running | Paused | Exited | Dead
474+data Status = Created | Restarting | Running | Paused | Exited | Dead
556 deriving (Eq, Show, Generic)
475 deriving (Eq, Show, Generic)
558−instance FromJSON State where
477+instance FromJSON Status where
559− parseJSON (JSON.String "running") = return Running
478+ parseJSON (JSON.String "running") = return Running
560− parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.
479+ parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.
561 parseJSON (JSON.String "restarting") = return Restarting
480 parseJSON (JSON.String "restarting") = return Restarting
562− parseJSON (JSON.String "paused") = return Paused
481+ parseJSON (JSON.String "paused") = return Paused
563− parseJSON (JSON.String "exited") = return Exited
482+ parseJSON (JSON.String "exited") = return Exited
564− parseJSON (JSON.String "dead") = return Dead
483+ parseJSON (JSON.String "dead") = return Dead
565− parseJSON s = fail $ "Unknown Status: " ++ show s
484+ parseJSON _ = fail "Unknown Status"
567−-- | Alias for representing a RepoDigest. We could newtype this and add
569type Digest = Text
486type Digest = Text
571−-- | Container and Image Labels.
572−data Label = Label Name Value deriving (Eq, Show)
488+newtype Labels = Labels (M.Map Name Value) deriving (Eq, Show)
490+instance FromJSON Labels where
491+ parseJSON val = Labels <$> parseJSON val
575−-- If there are multiple lables with the same Name in the list
576−-- then the last one wins.
577−instance {-# OVERLAPPING #-} ToJSON [Label] where
493+instance ToJSON Labels where
578− toJSON [] = emptyJsonObject
494+ toJSON (Labels kvs) = object [k .= v | (k,v) <- (M.toList kvs)]
579− toJSON (l:ls) = toJsonKeyVal (l:ls) key val
580− where key (Label k _) = T.unpack k
583−instance {-# OVERLAPPING #-} FromJSON [Label] where
584− parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
585− where f accM k v = do
587− value <- parseJSON v
588− return $ (Label k value):acc
589− parseJSON JSON.Null = return []
590− parseJSON _ = fail "Failed to parse Labels. Not an object."
593type Tag = Text
496type Tag = Text
595−-- | Data type used for parsing information from a list of images.
596data Image = DockerImage {
498data Image = DockerImage {
597 imageId :: ImageID
499 imageId :: ImageID
598 , imageCreated :: Integer
500 , imageCreated :: Integer
599 , imageParentId :: Maybe ImageID
501 , imageParentId :: Maybe ImageID
600 , imageRepoTags :: [Tag]
502 , imageRepoTags :: [Tag]
601− , imageRepoDigests :: [Digest]
503+ , imageRepoDigests :: Maybe [Digest]
602 , imageSize :: Integer
504 , imageSize :: Integer
603 , imageVirtualSize :: Integer
505 , imageVirtualSize :: Integer
604− , imageLabels :: [Label]
506+ , imageLabels :: Maybe Labels
605 } deriving (Show, Eq, Generic)
507 } deriving (Show, Eq, Generic)
607−-- | Helper function used for dropping the "image" prefix when serializing
608−-- the Image data type to and from json.
609dropImagePrefix :: [a] -> [a]
509dropImagePrefix :: [a] -> [a]
610dropImagePrefix = drop 5
510dropImagePrefix = drop 5
613instance FromJSON Image where
512instance FromJSON Image where
614− parseJSON (JSON.Object o) = do
513+ parseJSON = genericParseJSON defaultOptions {
615− imageId <- o .: "Id"
514+ fieldLabelModifier = dropImagePrefix}
616− imageCreated <- o .: "Created"
515+
617− imageParentId <- o .:? "ParentId"
618− imageRepoTags <- o .:? "RepoTags" .!= []
619− imageRepoDigests <- o .:? "RepoDigests" .!= []
620− imageSize <- o .: "Size"
621− imageVirtualSize <- o .: "VirtualSize"
622− imageLabels <- o .:? "Labels" .!= []
623− return $ DockerImage imageId imageCreated imageParentId imageRepoTags imageRepoDigests imageSize imageVirtualSize imageLabels
624− parseJSON _ = fail "Failed to parse DockerImage."
626−-- | Alias for Aliases.
629−-- | EndpointsConfig is container configuration for a specific network
630−newtype EndpointConfig = EndpointConfig [Alias] deriving (Eq, Show)
632−instance ToJSON EndpointConfig where
633− toJSON (EndpointConfig aliases) = JSON.object
634− [ "Aliases" .= aliases
637−-- | Alias for endpoint name
638−type EndpointName = Text
640−-- | Data type for the NetworkingConfig section of the container settings
641−newtype NetworkingConfig = NetworkingConfig
642− { endpointsConfig :: HM.HashMap EndpointName EndpointConfig
643− } deriving (Eq, Show)
645−instance ToJSON NetworkingConfig where
646− toJSON (NetworkingConfig endpointsConfig) = JSON.object
647− [ "EndpointsConfig" .= endpointsConfig
650−-- | Options used for creating a Container.
651data CreateOpts = CreateOpts {
516data CreateOpts = CreateOpts {
652− containerConfig :: ContainerConfig
517+ containerConfig :: ContainerConfig
653− , hostConfig :: HostConfig
518+ , hostConfig :: HostConfig
654− , networkingConfig :: NetworkingConfig
655 } deriving (Eq, Show)
519 } deriving (Eq, Show)
657instance ToJSON CreateOpts where
521instance ToJSON CreateOpts where
658− toJSON (CreateOpts cc hc nc) = do
522+ toJSON (CreateOpts cc hc) = do
659 let ccJSON = toJSON cc
523 let ccJSON = toJSON cc
660 let hcJSON = toJSON hc
524 let hcJSON = toJSON hc
661 case ccJSON of
525 case ccJSON of
662 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
526 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
663− let o1 = HM.insert "HostConfig" hcJSON o
527+ JSON.Object $ HM.insert "HostConfig" hcJSON o
664− let o2 = HM.insert "NetworkingConfig" (toJSON nc) o1
666 _ -> error "ContainerConfig is not an object." -- This should never happen.
528 _ -> error "ContainerConfig is not an object." -- This should never happen.
668−-- | Container configuration used for creating a container with sensible
670defaultContainerConfig :: Text -> ContainerConfig
530defaultContainerConfig :: Text -> ContainerConfig
671defaultContainerConfig imageName = ContainerConfig {
531defaultContainerConfig imageName = ContainerConfig {
672 hostname=Nothing
532 hostname=Nothing
@@ -676,29 +536,28 @@ defaultContainerConfig imageName = ContainerConfig {
676 , attachStdout=False
536 , attachStdout=False
677 , image=imageName
537 , image=imageName
678 , attachStderr=False
538 , attachStderr=False
679− , exposedPorts=[]
539+ , exposedPorts=ExposedPorts M.empty
680 , tty=False
540 , tty=False
681 , openStdin=False
541 , openStdin=False
682 , stdinOnce=False
542 , stdinOnce=False
685− , volumes=[]
545+ , volumes=Nothing
686 , workingDir=Nothing
546 , workingDir=Nothing
687− , entrypoint=Entrypoint []
547+ , entrypoint=Nothing
688 , networkDisabled=Nothing
548 , networkDisabled=Nothing
689 , macAddress=Nothing
549 , macAddress=Nothing
690− , labels=[]
550+ , labels=Nothing
691 , stopSignal=SIGTERM
551 , stopSignal=SIGTERM
694−-- | Default host confiratuon used for creating a container.
695defaultHostConfig :: HostConfig
554defaultHostConfig :: HostConfig
696defaultHostConfig = HostConfig {
555defaultHostConfig = HostConfig {
698 , containerIDFile=Nothing
557 , containerIDFile=Nothing
699− , logConfig=LogDriverConfig JsonFile []
558+ , logConfig=LogDriverConfig JsonFile Nothing
700− , networkMode=NetworkBridge
559+ , networkMode=Bridge
701− , portBindings=[]
560+ , portBindings=PortBindings []
702 , restartPolicy=RestartOff
561 , restartPolicy=RestartOff
703 , volumeDriver=Nothing
562 , volumeDriver=Nothing
704 , volumesFrom=[]
563 , volumesFrom=[]
@@ -719,7 +578,6 @@ defaultHostConfig = HostConfig {
719 , resources=defaultContainerResources
578 , resources=defaultContainerResources
722−-- Default container resource contstraints (None).
723defaultContainerResources :: ContainerResources
581defaultContainerResources :: ContainerResources
724defaultContainerResources = ContainerResources {
582defaultContainerResources = ContainerResources {
725 cpuShares=Nothing
583 cpuShares=Nothing
@@ -737,80 +595,31 @@ defaultContainerResources = ContainerResources {
737 , memory=Nothing
595 , memory=Nothing
738 , memoryReservation=Nothing
596 , memoryReservation=Nothing
739 , memorySwap=Nothing
597 , memorySwap=Nothing
740− , oomKillDisable=Just False
598+ , oomKillDisable=False
741 , ulimits=[]
599 , ulimits=[]
744−-- | Default create options when creating a container. You only need to
602+
745−-- specify an image name and the rest is all sensible defaults.
746defaultCreateOpts :: T.Text -> CreateOpts
603defaultCreateOpts :: T.Text -> CreateOpts
747−defaultCreateOpts imageName = CreateOpts
748− { containerConfig = defaultContainerConfig imageName
604+defaultCreateOpts imageName = CreateOpts { containerConfig = defaultContainerConfig imageName, hostConfig = defaultHostConfig }
749− , hostConfig = defaultHostConfig
750− , networkingConfig = NetworkingConfig HM.empty
753−-- | Override the key sequence for detaching a container.
606+-- detachKeys – Override the key sequence for detaching a container.
754-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
607-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
755data DetachKeys = WithCtrl Char | WithoutCtrl Char | DefaultDetachKey deriving (Eq, Show)
608data DetachKeys = WithCtrl Char | WithoutCtrl Char | DefaultDetachKey deriving (Eq, Show)
757−-- | Options for starting a container.
758data StartOpts = StartOpts { detachKeys :: DetachKeys } deriving (Eq, Show)
610data StartOpts = StartOpts { detachKeys :: DetachKeys } deriving (Eq, Show)
760−-- | Default options for staring a container.
761defaultStartOpts :: StartOpts
612defaultStartOpts :: StartOpts
762defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
613defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
764−-- | Options for deleting a container.
615+data DeleteOpts = DeleteOpts {
765−data ContainerDeleteOpts = ContainerDeleteOpts {
616+ deleteVolumes :: Bool
766− deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.
617+ , force :: Bool
767− , force :: Bool -- ^ If the container is still running force deletion anyway.
768 } deriving (Eq, Show)
618 } deriving (Eq, Show)
770−-- TODO: Add support for container build constraints
771−-- | Options for when building images from a Dockerfile
772−data BuildOpts = BuildOpts {
773− buildImageName :: Text -- ^ Image name in the form of name:tag; ie. myimage:latest.:w
774− , buildDockerfileName :: Text -- ^ Name of dockerfile (default: Dockerfile)
775− , buildQuiet :: Bool
776− , buildNoCache :: Bool -- ^ Do not use cache when building the image.
777− , buildRemoveItermediate :: Bool -- ^ Remove intermediate containers after a successful build (default true).
778− , buildForceRemoveIntermediate :: Bool -- ^ Always remove intermediate containers.
779− , buildPullParent :: Bool -- ^ Always attempt to pull a newer version of the *parent* image (ie. FROM debian:jessie).
780− } deriving (Eq, Show)
782−defaultBuildOpts :: Text -> BuildOpts
783−defaultBuildOpts nameTag = BuildOpts { buildImageName = nameTag
784− , buildDockerfileName = "Dockerfile"
785− , buildQuiet = False
786− , buildNoCache = False
787− , buildRemoveItermediate = True
788− , buildForceRemoveIntermediate = False
789− , buildPullParent = False
792−-- | Default options for deleting a container. Most of the time we DON'T
793−-- want to delete the container's volumes or force delete it if it's
795−defaultContainerDeleteOpts :: ContainerDeleteOpts
796−defaultContainerDeleteOpts = ContainerDeleteOpts { deleteVolumes = False, force = False }
798−-- | Image delete opts
799−data ImageDeleteOpts = ImageDeleteOpts deriving (Eq, Show)
801−-- | Sane image deletion defaults
802−defaultImageDeleteOpts :: ImageDeleteOpts
803−defaultImageDeleteOpts = ImageDeleteOpts
805−-- | Timestamp alias.
806type Timestamp = Integer
620type Timestamp = Integer
808−-- | Used for requesting N number of lines when tailing a containers log
810data TailLogOpt = Tail Integer | All deriving (Eq, Show)
621data TailLogOpt = Tail Integer | All deriving (Eq, Show)
813−-- | Log options used when requesting the log output from a container.
814data LogOpts = LogOpts {
623data LogOpts = LogOpts {
815 stdout :: Bool
624 stdout :: Bool
816 , stderr :: Bool
625 , stderr :: Bool
@@ -819,7 +628,6 @@ data LogOpts = LogOpts {
819 , tail :: TailLogOpt
628 , tail :: TailLogOpt
820 } deriving (Eq, Show)
629 } deriving (Eq, Show)
822−-- | Sensible default for log options.
823defaultLogOpts :: LogOpts
631defaultLogOpts :: LogOpts
824defaultLogOpts = LogOpts { stdout = True
632defaultLogOpts = LogOpts { stdout = True
825 , stderr = True
633 , stderr = True
@@ -828,87 +636,37 @@ defaultLogOpts = LogOpts { stdout = True
828 , tail = All
636 , tail = All
831−-- | Options for creating a network
832−data CreateNetworkOpts = CreateNetworkOpts
833− { createNetworkName :: Text -- ^ The network's name
834− , createNetworkCheckDuplicate :: Bool -- ^ Check for networks with duplicate names.
835− , createNetworkDriver :: Text -- ^ Name of the network driver plugin to use.
836− , createNetworkInternal :: Bool -- ^ Restrict external access to the network.
837− , createNetworkEnableIPv6 :: Bool -- ^ Enable IPv6 on the network.
838− } deriving (Eq, Show)
840−-- | Sensible defalut for create network options
841−defaultCreateNetworkOpts :: Text -> CreateNetworkOpts
842−defaultCreateNetworkOpts name =
844− { createNetworkName = name
845− , createNetworkCheckDuplicate = False
846− , createNetworkDriver = "bridge"
847− , createNetworkInternal = True
848− , createNetworkEnableIPv6 = False
851−instance ToJSON CreateNetworkOpts where
854− [ "Name" .= createNetworkName opts
855− , "CheckDuplicate" .= createNetworkCheckDuplicate opts
856− , "Driver" .= createNetworkDriver opts
857− , "Internal" .= createNetworkInternal opts
858− , "EnableIPv6" .= createNetworkEnableIPv6 opts
861−-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
862−-- | Set permissions on volumes that you mount in the container.
863−data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
639+data VolumePermission = Rw | Ro deriving (Eq, Show, Generic)
865−instance ToJSON VolumePermission where
641+-- instance ToJSON VolumePermission where
866− toJSON ReadWrite = "rw"
642+-- toJSON = error "TODO"
867− toJSON ReadOnly = "ro"
869−instance FromJSON VolumePermission where
643+-- instance FromJSON VolumePermission where
870− parseJSON "rw" = return ReadWrite
644+-- parseJSON = error "TODO"
871− parseJSON "ro" = return ReadOnly
645+
872− parseJSON "RW" = return ReadWrite
646+-- Note: Note really sure what this should be (1.24).
873− parseJSON "RO" = return ReadOnly
647+-- This is not the same as [Volume] in HostConfig.
874− parseJSON _ = fail "Failed to parse VolumePermission"
648+newtype Volumes = Volumes [Text] -- [Volume]
875−
649+ deriving (Eq, Show)
876−-- | Used for marking a directory in the container as "exposed" hence
650+
877−-- taking it outside of the COW filesystem and making it mountable
878−-- in other containers using "VolumesFrom". The volume usually get's
879−-- created somewhere in @/var/lib/docker/volumes@ (depending on the volume
881−-- The CLI example is:
884−-- docker run --name app -v \/opt\/data -it myapp:latest
885−-- docker run --name app2 --volumes-from app \/bin\/bash -c "ls -l \/opt\/data"
887−newtype Volume = Volume FilePath deriving (Eq, Show)
889−instance {-# OVERLAPPING #-} ToJSON [Volume] where
890− toJSON [] = emptyJsonObject
891− toJSON (v:vs) = toJsonKey (v:vs) getKey
892− where getKey (Volume v) = v
894−instance {-# OVERLAPPING #-} FromJSON [Volume] where
651+instance FromJSON Volumes where
895− parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o
652+ parseJSON (JSON.Object o) = return $ Volumes $ HM.keys o
896− parseJSON (JSON.Null) = return []
897− parseJSON _ = fail "Volume is not an object"
653+ parseJSON _ = fail "Volumes is not an object"
900−data Bind = Bind { hostSrc :: Text
901− , containerDest :: Text
902− , volumePermission :: Maybe VolumePermission
903− } deriving (Eq, Show)
655+instance ToJSON Volumes where
656+ toJSON (Volumes vs) = toJSON vs
658+data Volume = Volume { hostSrc :: Text
659+ , containerDest :: Text
660+ , volumePermission :: Maybe VolumePermission
661+ } deriving (Eq, Show)
905−instance FromJSON Bind where
663+instance FromJSON Volume where
906 parseJSON (JSON.String t) = case T.split (== ':') t of
664 parseJSON (JSON.String t) = case T.split (== ':') t of
907− [src, dest] -> return $ Bind src dest Nothing
665+ [src, dest] -> return $ Volume src dest Nothing
908− [src, dest, "rw"] -> return $ Bind src dest $ Just ReadWrite
666+ [src, dest, "rw"] -> return $ Volume src dest $ Just Rw
909− [src, dest, "ro"] -> return $ Bind src dest $ Just ReadOnly
667+ [src, dest, "ro"] -> return $ Volume src dest $ Just Ro
910− _ -> fail "Could not parse Bind"
668+ _ -> fail "Could not parse Volume"
911− parseJSON _ = fail "Bind is not a string"
669+ parseJSON _ = fail "Volume is not a string"
913data Device = Device {
671data Device = Device {
914 pathOnHost :: FilePath
672 pathOnHost :: FilePath
@@ -930,19 +688,19 @@ data VolumeFrom = VolumeFrom ContainerName (Maybe VolumePermission) deriving (Eq
931instance FromJSON VolumeFrom where
689instance FromJSON VolumeFrom where
932 parseJSON (JSON.String t) = case T.split (== ':') t of
690 parseJSON (JSON.String t) = case T.split (== ':') t of
933− [vol] -> return $ VolumeFrom vol Nothing
691+ [vol] -> return $ VolumeFrom vol Nothing
934− [vol, "rw"] -> return $ VolumeFrom vol $ Just ReadWrite
692+ [vol, "rw"] -> return $ VolumeFrom vol $ Just Rw
935− [vol, "ro"] -> return $ VolumeFrom vol $ Just ReadOnly
693+ [vol, "ro"] -> return $ VolumeFrom vol $ Just Ro
936− _ -> fail "Could not parse VolumeFrom"
694+ _ -> fail "Could not parse VolumeFrom"
937 parseJSON _ = fail "VolumeFrom is not a string"
695 parseJSON _ = fail "VolumeFrom is not a string"
939instance ToJSON VolumeFrom where
697instance ToJSON VolumeFrom where
940 toJSON (VolumeFrom n p) = case p of
698 toJSON (VolumeFrom n p) = case p of
941− Nothing -> toJSON $ n <> ":" <> "rw"
699+ Nothing -> toJSON $ n <> ":" <> "rw"
942 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)
700 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)
944−instance ToJSON Bind where
702+instance ToJSON Volume where
945− toJSON (Bind src dest mode) = toJSON $ case mode of
703+ toJSON (Volume src dest mode) = toJSON $ case mode of
946 Nothing -> T.concat[src, ":", dest]
704 Nothing -> T.concat[src, ":", dest]
947 Just m -> T.concat[src, ":", dest, ":", (T.pack $ show m)]
705 Just m -> T.concat[src, ":", dest, ":", (T.pack $ show m)]
@@ -950,63 +708,63 @@ data Link = Link Text (Maybe Text) deriving (Eq, Show)
951instance FromJSON Link where
709instance FromJSON Link where
952 parseJSON (JSON.String t) = case T.split (== ':') t of
710 parseJSON (JSON.String t) = case T.split (== ':') t of
953− [f] -> return $ Link f Nothing
711+ [f] -> return $ Link f Nothing
954 [f,s] -> return $ Link f $ Just s
712 [f,s] -> return $ Link f $ Just s
955− _ -> fail "Could not parse Link"
713+ _ -> fail "Could not parse Link"
956 parseJSON _ = fail "Link is not a string"
714 parseJSON _ = fail "Link is not a string"
958instance ToJSON Link where
716instance ToJSON Link where
959 toJSON (Link n1 n2) = toJSON $ case n2 of
717 toJSON (Link n1 n2) = toJSON $ case n2 of
960 Nothing -> T.concat[n1, ":", n1] -- use same name in container
718 Nothing -> T.concat[n1, ":", n1] -- use same name in container
961− Just n -> T.concat[n1, ":", n] -- used specified name in container
719+ Just n -> T.concat[n1, ":", n] -- used specified name in container
963-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
721-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
964data LogDriverType = JsonFile | Syslog | Journald | Gelf | Fluentd | AwsLogs | Splunk | Etwlogs | LoggingDisabled deriving (Eq, Show)
722data LogDriverType = JsonFile | Syslog | Journald | Gelf | Fluentd | AwsLogs | Splunk | Etwlogs | LoggingDisabled deriving (Eq, Show)
966instance FromJSON LogDriverType where
724instance FromJSON LogDriverType where
967 parseJSON (JSON.String "json-file") = return JsonFile
725 parseJSON (JSON.String "json-file") = return JsonFile
968− parseJSON (JSON.String "syslog") = return Syslog
726+ parseJSON (JSON.String "syslog") = return Syslog
969− parseJSON (JSON.String "journald") = return Journald
727+ parseJSON (JSON.String "journald") = return Journald
970− parseJSON (JSON.String "gelf") = return Gelf
728+ parseJSON (JSON.String "gelf") = return Gelf
971− parseJSON (JSON.String "fluentd") = return Fluentd
729+ parseJSON (JSON.String "fluentd") = return Fluentd
972− parseJSON (JSON.String "awslogs") = return AwsLogs
730+ parseJSON (JSON.String "awslogs") = return AwsLogs
973− parseJSON (JSON.String "splunk") = return Splunk
731+ parseJSON (JSON.String "splunk") = return Splunk
974− parseJSON (JSON.String "etwlogs") = return Etwlogs
732+ parseJSON (JSON.String "etwlogs") = return Etwlogs
975− parseJSON (JSON.String "none") = return LoggingDisabled
733+ parseJSON (JSON.String "none") = return LoggingDisabled
976− parseJSON _ = fail "Unknown LogDriverType"
734+ parseJSON _ = fail "Unknown LogDriverType"
978instance ToJSON LogDriverType where
736instance ToJSON LogDriverType where
979− toJSON JsonFile = JSON.String "json-file"
737+ toJSON JsonFile = JSON.String "json-file"
980− toJSON Syslog = JSON.String "syslog"
738+ toJSON Syslog = JSON.String "syslog"
981− toJSON Journald = JSON.String "journald"
739+ toJSON Journald = JSON.String "journald"
982− toJSON Gelf = JSON.String "gelf"
740+ toJSON Gelf = JSON.String "gelf"
983− toJSON Fluentd = JSON.String "fluentd"
741+ toJSON Fluentd = JSON.String "fluentd"
984− toJSON AwsLogs = JSON.String "awslogs"
742+ toJSON AwsLogs = JSON.String "awslogs"
985− toJSON Splunk = JSON.String "splunk"
743+ toJSON Splunk = JSON.String "splunk"
986− toJSON Etwlogs = JSON.String "etwlogs"
744+ toJSON Etwlogs = JSON.String "etwlogs"
987 toJSON LoggingDisabled = JSON.String "none"
745 toJSON LoggingDisabled = JSON.String "none"
989−data LogDriverOption = LogDriverOption Name Value deriving (Eq, Show)
747+newtype LogDriverOptions = LogDriverOptions (M.Map Text Text) deriving (Eq, Show)
991−instance {-# OVERLAPPING #-} ToJSON [LogDriverOption] where
749+instance FromJSON LogDriverOptions where
992− toJSON [] = emptyJsonObject
750+ parseJSON (JSON.Object o) = do
993− toJSON (o:os) = toJsonKeyVal (o:os) key val
751+ LogDriverOptions <$> HM.foldlWithKey' f (return M.empty) o
994− where key (LogDriverOption n _) = T.unpack n
995− val (LogDriverOption _ v) = v
997−instance {-# OVERLAPPING #-} FromJSON [LogDriverOption] where
753+ where
998− parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
999− where f accM k v = do
754+ f accM k (JSON.String v) = do
1000 acc <- accM
755 acc <- accM
1001− value <- parseJSON v
756+ return $ M.insert k v acc
1002− return $ (LogDriverOption k value):acc
757+ f _ _ _ = fail "Value of LogDriverOptions is not a string"
1003− parseJSON JSON.Null = return []
759+ parseJSON JSON.Null = return $ LogDriverOptions M.empty
1004− parseJSON _ = fail "Failed to parse LogDriverOptions"
760+ parseJSON _ = fail "LogDriverOptions is not an object"
762+instance ToJSON LogDriverOptions where
763+ toJSON (LogDriverOptions mp) = toJSON mp
1006−data LogDriverConfig = LogDriverConfig LogDriverType [LogDriverOption] deriving (Eq, Show)
765+data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
1008instance ToJSON LogDriverConfig where
767instance ToJSON LogDriverConfig where
1009− toJSON (LogDriverConfig driverType []) = object ["Type" .= driverType]
1010 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
768 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
1012instance FromJSON LogDriverConfig where
770instance FromJSON LogDriverConfig where
@@ -1017,47 +775,21 @@ instance FromJSON LogDriverConfig where
1017 parseJSON _ = fail "LogDriverConfig is not an object"
775 parseJSON _ = fail "LogDriverConfig is not an object"
1019-- TODO: Add container:<name|id> mode
777-- TODO: Add container:<name|id> mode
1020−data NetworkMode = NetworkBridge | NetworkHost | NetworkDisabled | NetworkNamed Text
778+data NetworkMode = Bridge | Host | NetworkDisabled
1021 deriving (Eq, Show, Ord)
779 deriving (Eq, Show, Ord)
1023instance FromJSON NetworkMode where
781instance FromJSON NetworkMode where
1024− parseJSON (JSON.String "bridge") = return NetworkBridge
782+ parseJSON (JSON.String "bridge") = return Bridge
1025− parseJSON (JSON.String "host") = return NetworkHost -- Note: Guessing on these.
783+ parseJSON (JSON.String "host") = return Host -- Note: Guessing on these.
1026− parseJSON (JSON.String "none") = return NetworkDisabled
784+ parseJSON (JSON.String "none") = return NetworkDisabled
1027− parseJSON (JSON.String n) = return $ NetworkNamed n
1028− parseJSON _ = fail "Unknown NetworkMode"
785+ parseJSON _ = fail "Unknown NetworkMode"
1030instance ToJSON NetworkMode where
787instance ToJSON NetworkMode where
1031− toJSON NetworkBridge = JSON.String "bridge"
788+ toJSON Bridge = JSON.String "bridge"
1032− toJSON NetworkHost = JSON.String "host"
789+ toJSON Host = JSON.String "host"
1033 toJSON NetworkDisabled = JSON.String "none"
790 toJSON NetworkDisabled = JSON.String "none"
1034− toJSON (NetworkNamed n) = JSON.String n
1036−newtype NetworkID = NetworkID Text
1037− deriving (Eq, Show)
1039−-- | Used for extracting the id of the container from the newtype
1040−fromNetworkID :: NetworkID -> Text
1041−fromNetworkID (NetworkID t) = t
1043−-- | Used for parsing a Text value into a NetworkID.
1044−toNetworkID :: Text -> Maybe NetworkID
1045−toNetworkID t = Just $ NetworkID t
1047−instance FromJSON NetworkID where
1048− parseJSON (JSON.Object o) = do
1050− return $ NetworkID nid
1051− parseJSON _ = fail "NetworkID is not an object."
1053−instance ToJSON NetworkID where
1054− toJSON (NetworkID nid) = object ["Id" .= nid]
1056−data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)
792+data PortType = TCP | UDP deriving (Eq, Show, Generic, Read, Ord)
1058−instance Show PortType where
1062instance ToJSON PortType where
794instance ToJSON PortType where
1063 toJSON TCP = "tcp"
795 toJSON TCP = "tcp"
@@ -1067,23 +799,24 @@ instance FromJSON PortType where
1067 parseJSON val = case val of
799 parseJSON val = case val of
1068 "tcp" -> return TCP
800 "tcp" -> return TCP
1069 "udp" -> return UDP
801 "udp" -> return UDP
1070− _ -> fail "PortType: Invalid port type."
802+ _ -> fail "PortType: Invalid port type."
804+newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
1072−-- newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
1074−-- instance FromJSON NetworkInterface where
806+instance FromJSON NetworkInterface where
1075−-- parseJSON (JSON.String v) = return $ NetworkInterface v
807+ parseJSON (JSON.String v) = return $ NetworkInterface v
1076−-- parseJSON _ = fail "Network interface is not a string."
808+ parseJSON _ = fail "Network interface is not a string."
1078−-- instance ToJSON NetworkInterface where
810+instance ToJSON NetworkInterface where
1079−-- toJSON (NetworkInterface i) = JSON.String i
811+ toJSON (NetworkInterface i) = JSON.String i
1081-- | This datastructure models mapping a Port from the container onto the
813-- | This datastructure models mapping a Port from the container onto the
1082-- host system s that the service running in the container can be accessed from
814-- host system s that the service running in the container can be accessed from
1083-- the outside world. We either map a port onto all interfaces (default) or onto a specific
815-- the outside world. We either map a port onto all interfaces (default) or onto a specific
1084-- interface like `127.0.0.1`.
816-- interface like `127.0.0.1`.
1085−-- __NOTE__: We should disallow duplicate port bindings as the ToJSON
817+newtype PortBindings = PortBindings [PortBinding]
1086−-- instance will only send the last one.
818+ deriving (Eq, Show)
1087-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
820-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
1088data PortBinding = PortBinding {
821data PortBinding = PortBinding {
1089 containerPort :: Port
822 containerPort :: Port
@@ -1091,65 +824,17 @@ data PortBinding = PortBinding {
1091 , hostPorts :: [HostPort]
824 , hostPorts :: [HostPort]
1092 } deriving (Eq, Show)
825 } deriving (Eq, Show)
1094portAndType2Text :: Port -> PortType -> Text
828portAndType2Text :: Port -> PortType -> Text
1095portAndType2Text p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)
829portAndType2Text p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)
831+instance ToJSON PortBinding where
832+ toJSON (PortBinding {..}) = object [portAndType2Text containerPort portType .= hostPorts]
834+instance FromJSON PortBindings where
835+ parseJSON (JSON.Object o) = do
836+ PortBindings <$> HM.foldlWithKey' f (return []) o
1098−-- | A helper function to more easily add a bind mount to existing
1099−-- "CreateOpts" records.
1100−addBind :: Bind -> CreateOpts -> CreateOpts
1101−addBind b c = c{hostConfig=hc{binds=obs <> [b]}}
1102− where hc = hostConfig c
1103− obs = binds $ hostConfig c
1105−-- | Helper function for adding a Command to and existing
1106−-- CreateOpts record.
1107−setCmd :: Text -> CreateOpts -> CreateOpts
1108−setCmd ccmd c = c{containerConfig=cc{cmd=[ccmd]}}
1109− where cc = containerConfig c
1111−-- | Helper function for adding a "Link" to and existing
1112−-- CreateOpts record.
1113−addLink :: Link -> CreateOpts -> CreateOpts
1114−addLink l c = c{hostConfig=hc{links=ols <> [l]}}
1115− where hc = hostConfig c
1116− ols = links $ hostConfig c
1118−-- | Helper function for adding a "Volume" to and existing
1119−-- CreateOpts record.
1120−addVolume :: Volume -> CreateOpts -> CreateOpts
1121−addVolume v c = c{containerConfig=cc{volumes=oldvs <> [v]}}
1122− where cc = containerConfig c
1125−-- | Helper function for adding a "VolumeFrom" to and existing
1126−-- CreateOpts record.
1127−addVolumeFrom :: VolumeFrom -> CreateOpts -> CreateOpts
1128−addVolumeFrom vf c = c{hostConfig=hc{volumesFrom=oldvfs <> [vf]}}
1129− where hc = hostConfig c
1130− oldvfs = volumesFrom hc
1132−-- | A convenience function that adds PortBindings to and exiting
1133−-- "CreateOpts" record. Useful with 'defaultCreateOpts'
1136−-- >>> let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]
1137−-- >>> addPortBinding pb $ defaultCreateOpts "nginx:latest"
1138−addPortBinding :: PortBinding -> CreateOpts -> CreateOpts
1139−addPortBinding pb c = c{hostConfig=hc{portBindings=pbs <> [pb]}}
1140− where hc = hostConfig c
1141− pbs = portBindings $ hostConfig c
1143−-- | Helper function for adding a "ExposedPort" to and existing
1144−-- CreateOpts record.
1145−addExposedPort :: ExposedPort -> CreateOpts -> CreateOpts
1146−addExposedPort ep c = c{containerConfig=cc{exposedPorts=oldeps <> [ep]}}
1147− where cc = containerConfig c
1148− oldeps = exposedPorts cc
1151−instance {-# OVERLAPPING #-} FromJSON [PortBinding] where
1152− parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
1154 f accM k v = case T.split (== '/') k of
839 f accM k v = case T.split (== '/') k of
1155 [port', portType'] -> do
840 [port', portType'] -> do
@@ -1158,24 +843,19 @@ instance {-# OVERLAPPING #-} FromJSON [PortBinding] where
1158 acc <- accM
843 acc <- accM
1159 hps <- parseJSON v
844 hps <- parseJSON v
1160 return $ (PortBinding port portType hps):acc
845 return $ (PortBinding port portType hps):acc
1161− _ -> fail "Could not parse PortBindings"
847+ fail "Could not parse PortBindings"
1162− parseJSON (JSON.Null) = return []
1163 parseJSON _ = fail "PortBindings is not an object"
848 parseJSON _ = fail "PortBindings is not an object"
1165−instance {-# OVERLAPPING #-} ToJSON [PortBinding] where
850+instance ToJSON PortBindings where
1166− toJSON [] = emptyJsonObject
851+ toJSON (PortBindings []) = JSON.Object HM.empty
1167− toJSON (p:ps) = toJsonKeyVal (p:ps) key val
852+ toJSON (PortBindings (p:ps)) = toJSON (p:ps)
1168− where key p = T.unpack $ portAndType2Text (containerPort p) (portType p)
1169− val p = hostPorts p
1171−data HostPort = HostPort {
854+data HostPort = HostPort NetworkInterface Port
1175 deriving (Eq, Show)
855 deriving (Eq, Show)
1177instance ToJSON HostPort where
857instance ToJSON HostPort where
1178− toJSON (HostPort i p) = object ["HostPort" .= show p, "HostIp" .= i]
858+ toJSON (HostPort i p) = object ["HostPort" .= p, "HostIP" .= i]
1180instance FromJSON HostPort where
860instance FromJSON HostPort where
1181 parseJSON (JSON.Object o) = do
861 parseJSON (JSON.Object o) = do
@@ -1184,6 +864,24 @@ instance FromJSON HostPort where
1184 return $ HostPort i p
864 return $ HostPort i p
1185 parseJSON _ = fail "HostPort is not an object."
865 parseJSON _ = fail "HostPort is not an object."
867+-- newtype HostPorts = HostPorts [HostPort]
868+-- deriving (Eq, Show)
870+-- instance ToJSON HostPorts where
871+-- toJSON (HostPorts hps) = toJSON hps
873+-- instance FromJSON HostPorts where
874+-- parseJSON (JSON.Object o) = do
875+-- HostPorts <$> HM.foldlWithKey' f (return []) o
881+-- p <- parseIntegerText p'
882+-- return $ (HostPort (NetworkInterface k) p):acc
883+-- parseJSON _ = fail $ "HostPorts is not an object"
1187-- { "Name": "on-failure" , "MaximumRetryCount": 2}
885-- { "Name": "on-failure" , "MaximumRetryCount": 2}
1188type RetryCount = Integer
886type RetryCount = Integer
1189data RestartPolicy = RestartAlways | RestartUnlessStopped | RestartOnFailure RetryCount | RestartOff deriving (Eq, Show)
887data RestartPolicy = RestartAlways | RestartUnlessStopped | RestartOnFailure RetryCount | RestartOff deriving (Eq, Show)
@@ -1197,7 +895,7 @@ instance FromJSON RestartPolicy where
1197 "on-failure" -> do
895 "on-failure" -> do
1198 retry <- o .: "MaximumRetryCount"
896 retry <- o .: "MaximumRetryCount"
1199 return $ RestartOnFailure retry
897 return $ RestartOnFailure retry
1200− "no" -> return RestartOff
898+ "off" -> return RestartOff
1201 _ -> fail "Could not parse RestartPolicy"
899 _ -> fail "Could not parse RestartPolicy"
1202 parseJSON _ = fail "RestartPolicy is not an object"
900 parseJSON _ = fail "RestartPolicy is not an object"
@@ -1205,7 +903,7 @@ instance ToJSON RestartPolicy where
1205 toJSON RestartAlways = object ["Name" .= JSON.String "always"]
903 toJSON RestartAlways = object ["Name" .= JSON.String "always"]
1206 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]
904 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]
1207 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]
905 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]
1208− toJSON RestartOff = object ["Name" .= JSON.String "no"]
906+ toJSON RestartOff = object ["Name" .= JSON.String "off"]
1210data Isolation = Default | Process | Hyperv deriving (Eq, Show)
908data Isolation = Default | Process | Hyperv deriving (Eq, Show)
@@ -1215,11 +913,11 @@ newtype UTSMode = UTSMode Text deriving (Eq, Show)
1215-- TODO: Add UTSMode : UTS namespace to use for the container
913-- TODO: Add UTSMode : UTS namespace to use for the container
1216-- TODO: Sysctls map[string]string `json:",omitempty"` // List of Namespaced sysctls used for the container
914-- TODO: Sysctls map[string]string `json:",omitempty"` // List of Namespaced sysctls used for the container
1217data HostConfig = HostConfig
915data HostConfig = HostConfig
1218− { binds :: [Bind]
916+ { binds :: [Volume]
1219 , containerIDFile :: Maybe FilePath -- 1.24: Only in responses, not create
917 , containerIDFile :: Maybe FilePath -- 1.24: Only in responses, not create
1220 , logConfig :: LogDriverConfig
918 , logConfig :: LogDriverConfig
1221 , networkMode :: NetworkMode
919 , networkMode :: NetworkMode
1222− , portBindings :: [PortBinding]
920+ , portBindings :: PortBindings
1223 , restartPolicy :: RestartPolicy
921 , restartPolicy :: RestartPolicy
1224 , volumeDriver :: Maybe Text
922 , volumeDriver :: Maybe Text
1225 , volumesFrom :: [VolumeFrom]
923 , volumesFrom :: [VolumeFrom]
@@ -1273,7 +971,7 @@ instance FromJSON HostConfig where
1273 parseJSON _ = fail "HostConfig is not an object."
971 parseJSON _ = fail "HostConfig is not an object."
1275instance ToJSON HostConfig where
973instance ToJSON HostConfig where
1276− toJSON HostConfig{..} =
974+ toJSON HostConfig{..} =
1277 let arr = [
975 let arr = [
1278 "Binds" .= binds
976 "Binds" .= binds
1279 , "ContainerIDFile" .= containerIDFile
977 , "ContainerIDFile" .= containerIDFile
@@ -1301,7 +999,7 @@ instance ToJSON HostConfig where
1302 object $ arr <> ( resourcesArr resources)
1000 object $ arr <> ( resourcesArr resources)
1305 -- JP: Not sure if this is better than a separate ToJSON instance with a bunch of `HM.insert`s.
1003 -- JP: Not sure if this is better than a separate ToJSON instance with a bunch of `HM.insert`s.
1306 resourcesArr ContainerResources{..} = [
1004 resourcesArr ContainerResources{..} = [
1307 "CpuShares" .= cpuShares
1005 "CpuShares" .= cpuShares
@@ -1322,8 +1020,8 @@ instance ToJSON HostConfig where
1322 , "OomKillDisable" .= oomKillDisable
1020 , "OomKillDisable" .= oomKillDisable
1323 , "Ulimits" .= ulimits
1021 , "Ulimits" .= ulimits
1329-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
1027-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
@@ -1342,79 +1040,27 @@ instance ToJSON Ulimit where
1342 toJSON = genericToJSON defaultOptions {
1040 toJSON = genericToJSON defaultOptions {
1343 fieldLabelModifier = drop 5}
1041 fieldLabelModifier = drop 5}
1345−data DeviceWeight = DeviceWeight {
1346− deviceWeightPath :: FilePath
1347− , deviceWeightWeight :: Text
1349− deriving (Show, Eq)
1351−instance FromJSON DeviceWeight where
1352− parseJSON (JSON.Object o) = DeviceWeight
1355− parseJSON _ = fail "DeviceWeight is not an object."
1357−instance ToJSON DeviceWeight where
1358− toJSON (DeviceWeight p w) = object [
1363−data DeviceRate = DeviceRate {
1364− deviceRatePath :: FilePath
1365− , deviceRateRate :: Text
1367− deriving (Show, Eq)
1369−instance FromJSON DeviceRate where
1370− parseJSON (JSON.Object o) = DeviceRate
1373− parseJSON _ = fail "DeviceRate is not an object."
1375−instance ToJSON DeviceRate where
1376− toJSON (DeviceRate p r) = object [
1381−data MemoryConstraintSize = B | MB | GB deriving (Eq, Show)
1383−data MemoryConstraint = MemoryConstraint Integer MemoryConstraintSize deriving (Eq, Show)
1385−instance ToJSON MemoryConstraint where
1386− toJSON (MemoryConstraint x B) = toJSON x
1387− toJSON (MemoryConstraint x MB) = toJSON $ x * 1024 * 1024
1388− toJSON (MemoryConstraint x GB) = toJSON $ x * 1024 * 1024 * 1024
1390−instance FromJSON MemoryConstraint where
1391− parseJSON (JSON.Number x) = case (floatingOrInteger x) of
1392− Left (_ :: Double) -> fail "Failed to parse MemoryConstraint"
1393− Right i -> return $ MemoryConstraint i B
1394− -- The docker daemon will always return the number as bytes (integer), regardless of how we set them (using MB or GB)
1395− parseJSON _ = fail "Failed to parse MemoryConstraint"
1397data ContainerResources = ContainerResources {
1043data ContainerResources = ContainerResources {
1398 cpuShares :: Maybe Integer
1044 cpuShares :: Maybe Integer
1399 -- , cgroupParent :: Text -- 1.24: Missing from inspecting container details... Going to omit for now.
1045 -- , cgroupParent :: Text -- 1.24: Missing from inspecting container details... Going to omit for now.
1400 , blkioWeight :: Maybe Integer
1046 , blkioWeight :: Maybe Integer
1401− , blkioWeightDevice :: Maybe [DeviceWeight]
1047+ , blkioWeightDevice :: Maybe Text -- TODO: Not Text
1402− , blkioDeviceReadBps :: Maybe [DeviceRate] -- TODO: Not Text
1048+ , blkioDeviceReadBps :: Maybe Text -- TODO: Not Text
1403− , blkioDeviceWriteBps :: Maybe [DeviceRate] -- TODO: Not Text
1049+ , blkioDeviceWriteBps :: Maybe Text -- TODO: Not Text
1404− , blkioDeviceReadIOps :: Maybe [DeviceRate] -- TODO: Not Text
1050+ , blkioDeviceReadIOps :: Maybe Text -- TODO: Not Text
1405− , blkioDeviceWriteIOps :: Maybe [DeviceRate] -- TODO: Not Text
1051+ , blkioDeviceWriteIOps :: Maybe Text -- TODO: Not Text
1406 , cpuPeriod :: Maybe Integer
1052 , cpuPeriod :: Maybe Integer
1407 -- , cpuQuota :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1053 -- , cpuQuota :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1408 , cpusetCpus :: Maybe Text
1054 , cpusetCpus :: Maybe Text
1409 , cpusetMems :: Maybe Text
1055 , cpusetMems :: Maybe Text
1410 , devices :: [Device]
1056 , devices :: [Device]
1411 -- , diskQuota :: Integer -- Don't see this ins 1.24.
1057 -- , diskQuota :: Integer -- Don't see this ins 1.24.
1412− , kernelMemory :: Maybe MemoryConstraint
1058+ , kernelMemory :: Maybe Integer
1413− , memory :: Maybe MemoryConstraint
1059+ , memory :: Maybe Integer
1414− , memoryReservation :: Maybe MemoryConstraint
1060+ , memoryReservation :: Maybe Integer
1415− , memorySwap :: Maybe MemoryConstraint
1061+ , memorySwap :: Maybe Integer
1416 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1062 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1417− , oomKillDisable :: Maybe Bool
1063+ , oomKillDisable :: Bool
1418 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1064 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1419 , ulimits :: [Ulimit]
1065 , ulimits :: [Ulimit]
1420 -- TODO: Missing from 1.24
1066 -- TODO: Missing from 1.24
@@ -1452,59 +1098,41 @@ instance FromJSON EnvVar where
1452 parseJSON _ = fail "EnvVar is not a string"
1098 parseJSON _ = fail "EnvVar is not a string"
1454instance ToJSON EnvVar where
1100instance ToJSON EnvVar where
1455− toJSON (EnvVar n v) = JSON.String $ n <> T.pack "=" <> v
1101+ toJSON (EnvVar n v) = object [n .= v]
1457−-- | ExposedPort represents a port (and it's type)
1103+-- | ExposedPorts represent a enumeraton of all the ports (and their type)
1458-- that a container should expose to other containers or the host system.
1104-- that a container should expose to other containers or the host system.
1459−-- `NOTE`: This does not automatically expose the port onto the host
1105+-- `NOTE`: This does not automatically expose the ports onto the host
1460−-- system but rather it just tags it. It's best to be used with
1106+-- system but rather it just tags them. It's best to be used with
1461-- the PublishAllPorts flag. It is also useful for
1107-- the PublishAllPorts flag. It is also useful for
1462-- the daemon to know which Environment variables to
1108-- the daemon to know which Environment variables to
1463-- inject into a container linking to our container.
1109-- inject into a container linking to our container.
1464-- Example linking a Postgres container named db would inject the following
1110-- Example linking a Postgres container named db would inject the following
1465-- environment variables automatically if we set the corresponding
1111-- environment variables automatically if we set the corresponding
1466−--
1112+-- ExposedPorts:
1470-- DB_PORT_5432_TCP_PORT="5432"
1113-- DB_PORT_5432_TCP_PORT="5432"
1471-- DB_PORT_5432_TCP_PROTO="tcp"
1114-- DB_PORT_5432_TCP_PROTO="tcp"
1472-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1115-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1474−data ExposedPort = ExposedPort Port PortType deriving (Eq, Show)
1116+newtype ExposedPorts = ExposedPorts (M.Map Port PortType) deriving (Eq, Show)
1117+-- JP: Should this be ExposedPorts [(Port, PortType)]?
1119+instance FromJSON ExposedPorts where
1120+ parseJSON (JSON.Object o) = do
1121+ ExposedPorts <$> HM.foldlWithKey' f (return M.empty) o
1476−instance {-# OVERLAPPING #-} FromJSON [ExposedPort] where
1477− parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
1479 f accM k _ = case T.split (== '/') k of
1124 f accM k _ = case T.split (== '/') k of
1480 [port', portType'] -> do
1125 [port', portType'] -> do
1481 port <- parseIntegerText port'
1126 port <- parseIntegerText port'
1482 portType <- parseJSON $ JSON.String portType'
1127 portType <- parseJSON $ JSON.String portType'
1483 acc <- accM
1128 acc <- accM
1484− return $ (ExposedPort port portType):acc
1129+ return $ M.insert port portType acc
1485− _ -> fail "Could not parse ExposedPorts"
1131+ fail "Could not parse ExposedPorts"
1486− parseJSON (JSON.Null) = return []
1487− parseJSON _ = fail "ExposedPorts is not an object"
1132+ parseJSON _ = fail "ExposedPorts is not an object."
1489−instance {-# OVERLAPPING #-} ToJSON [ExposedPort] where
1490− toJSON [] = emptyJsonObject
1491− toJSON (p:ps) = toJsonKey (p:ps) key
1492− where key (ExposedPort p t) = show p <> slash <> show t
1493− slash = T.unpack "/"
1495−data Entrypoint = Entrypoint [T.Text] deriving (Eq, Show, Generic)
1497−instance ToJSON Entrypoint where
1134+instance ToJSON ExposedPorts where
1498− toJSON (Entrypoint (e:es)) = toJSON (e:es)
1135+ toJSON (ExposedPorts kvs) = object [((T.pack $ show p) <> "/" <> (T.pack $ show t)) .= JSON.Object HM.empty | (p,t) <- (M.toList kvs)]
1499− toJSON (Entrypoint []) = JSON.Null
1501−instance FromJSON Entrypoint where
1502− parseJSON (JSON.String e) = return $ Entrypoint [e]
1503− parseJSON (JSON.Array ar) = do
1504− arr <- mapM parseJSON (V.toList ar)
1505− return $ Entrypoint arr
1506− parseJSON JSON.Null = return $ Entrypoint []
1507− parseJSON _ = fail "Failed to parse Entrypoint"
1510data ContainerConfig = ContainerConfig {
1138data ContainerConfig = ContainerConfig {
@@ -1514,7 +1142,7 @@ data ContainerConfig = ContainerConfig {
1514 , attachStdin :: Bool
1142 , attachStdin :: Bool
1515 , attachStdout :: Bool
1143 , attachStdout :: Bool
1516 , attachStderr :: Bool
1144 , attachStderr :: Bool
1517− , exposedPorts :: [ExposedPort]
1145+ , exposedPorts :: ExposedPorts
1518 -- , publishService :: Text -- Don't see this in 1.24
1146 -- , publishService :: Text -- Don't see this in 1.24
1519 , tty :: Bool
1147 , tty :: Bool
1520 , openStdin :: Bool
1148 , openStdin :: Bool
@@ -1523,70 +1151,27 @@ data ContainerConfig = ContainerConfig {
1523 , cmd :: [Text]
1151 , cmd :: [Text]
1524 -- , argsEscaped :: Bool -- Don't see this in 1.24
1152 -- , argsEscaped :: Bool -- Don't see this in 1.24
1525 , image :: Text
1153 , image :: Text
1526− , volumes :: [Volume]
1154+ , volumes :: Maybe Volumes
1527 , workingDir :: Maybe FilePath
1155 , workingDir :: Maybe FilePath
1528− , entrypoint :: Entrypoint
1156+ , entrypoint :: Maybe Text -- Can be null?
1529 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
1157 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
1530 , macAddress :: Maybe Text
1158 , macAddress :: Maybe Text
1531 -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.
1159 -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.
1532− , labels :: [Label]
1160+ , labels :: Maybe Labels
1533 , stopSignal :: Signal
1161 , stopSignal :: Signal
1534 } deriving (Eq, Show, Generic)
1162 } deriving (Eq, Show, Generic)
1537instance ToJSON ContainerConfig where
1164instance ToJSON ContainerConfig where
1538 toJSON = genericToJSON defaultOptions {
1165 toJSON = genericToJSON defaultOptions {
1539 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1166 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1541instance FromJSON ContainerConfig where
1168instance FromJSON ContainerConfig where
1542− parseJSON (JSON.Object o) = do
1169+ parseJSON = genericParseJSON defaultOptions {
1543− hostname <- o .:? "Hostname"
1170+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1544− domainname <- o .:? "Domainname"
1545− user <- o .:? "User"
1546− attachStdin <- o .: "AttachStdin"
1547− attachStdout <- o .: "AttachStdout"
1548− attachStderr <- o .: "AttachStderr"
1549− exposedPorts <- o .:? "ExposedPorts" .!= []
1551− openStdin <- o .: "OpenStdin"
1552− stdinOnce <- o .: "StdinOnce"
1555− image <- o .: "Image"
1556− volumes <- o .: "Volumes"
1557− workingDir <- o .:? "WorkingDir"
1558− entrypoint <- o .: "Entrypoint"
1559− networkDisabled <- o .:? "networkDisabled"
1560− macAddress <- o .:? "MacAddress"
1561− labels <- o .:? "Labels" .!= []
1562− stopSignal <- o .: "StopSignal"
1563− return $ ContainerConfig hostname domainname user attachStdin attachStdout attachStderr exposedPorts tty openStdin stdinOnce env cmd image volumes workingDir entrypoint networkDisabled
1564− macAddress labels stopSignal
1565− parseJSON _ = fail "NetworkSettings is not an object."
1567−#if MIN_VERSION_base(4,13,0)
1568−parseIntegerText :: (MonadFail m) => Text -> m Integer
1570parseIntegerText :: (Monad m) => Text -> m Integer
1172parseIntegerText :: (Monad m) => Text -> m Integer
1572parseIntegerText t = case readMaybe $ T.unpack t of
1173parseIntegerText t = case readMaybe $ T.unpack t of
1573 Nothing ->
1174 Nothing ->
1574 fail "Could not parse Integer"
1175 fail "Could not parse Integer"
1575 Just i ->
1176 Just i ->
1576 return i
1177 return i
1578−-- | Helper function for converting a data type [a] to a json dictionary
1579−-- like so {"something": {}, "something2": {}}
1580−toJsonKey :: Foldable t => t a -> (a -> String) -> JSON.Value
1581−toJsonKey vs getKey = JSON.Object $ foldl f HM.empty vs
1582− where f acc x = HM.insert (T.pack $ getKey x) (JSON.Object HM.empty) acc
1584−-- | Helper function for converting a data type [a] to a json dictionary
1585−-- like so {"something": "val1", "something2": "val2"}
1586−toJsonKeyVal :: (Foldable t, JSON.ToJSON r) => t a -> (a -> String) -> (a -> r) -> JSON.Value
1587−toJsonKeyVal vs getKey getVal = JSON.Object $ foldl f HM.empty vs
1588− where f acc x = HM.insert (T.pack $ getKey x) (toJSON $ getVal x) acc
1590−-- | Helper function that return an empty dictionary "{}"
1591−emptyJsonObject :: JSON.Value
1592−emptyJsonObject = JSON.Object HM.empty