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