@@ -11,7 +11,11 @@ module Docker.Client.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,23 +26,30 @@ module Docker.Client.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(..)
37− , defaultDeleteOpts
44+ , defaultContainerDeleteOpts
45+ , ImageDeleteOpts(..)
46+ , defaultImageDeleteOpts
38 , Timestamp
47 , Timestamp
39 , TailLogOpt(..)
48 , TailLogOpt(..)
40 , LogOpts(..)
49 , LogOpts(..)
41 , defaultLogOpts
50 , defaultLogOpts
51+ , CreateNetworkOpts(..)
52+ , defaultCreateNetworkOpts
42 , VolumePermission(..)
53 , VolumePermission(..)
43 , Bind(..)
54 , Bind(..)
44 , Volume(..)
55 , Volume(..)
@@ -47,12 +58,12 @@ module Docker.Client.Types (
47 , VolumeFrom(..)
58 , VolumeFrom(..)
48 , Link(..)
59 , Link(..)
49 , LogDriverType(..)
60 , LogDriverType(..)
50− , LogDriverOptions(..)
61+ , LogDriverOption(..)
51 , LogDriverConfig(..)
62 , LogDriverConfig(..)
52 , NetworkMode(..)
63 , NetworkMode(..)
53 , PortType(..)
64 , PortType(..)
54-- , NetworkInterface(..)
65-- , NetworkInterface(..)
55− , Networks(..)
66+ , Network(..)
56 , NetworkSettings(..)
67 , NetworkSettings(..)
57 , NetworkOptions(..)
68 , NetworkOptions(..)
58 , Mount(..)
69 , Mount(..)
@@ -64,6 +75,8 @@ module Docker.Client.Types (
64 , UTSMode(..)
75 , UTSMode(..)
65 , HostConfig(..)
76 , HostConfig(..)
66 , defaultHostConfig
77 , defaultHostConfig
78+ , NetworkingConfig(..)
67 , Ulimit(..)
80 , Ulimit(..)
68 , ContainerResources(..)
81 , ContainerResources(..)
69 , defaultContainerResources
82 , defaultContainerResources
@@ -73,15 +86,18 @@ module Docker.Client.Types (
73 , EnvVar(..)
86 , EnvVar(..)
74 , ContainerConfig(..)
87 , ContainerConfig(..)
75 , defaultContainerConfig
88 , defaultContainerConfig
76− , ExposedPorts(..)
89+ , ExposedPort(..)
77 , DeviceWeight(..)
90 , DeviceWeight(..)
78 , DeviceRate(..)
91 , DeviceRate(..)
79 , addPortBinding
92 , addPortBinding
83 , addVolume
97 , addVolume
84 , addVolumeFrom
98 , addVolumeFrom
99+ , MemoryConstraint(..)
100+ , MemoryConstraintSize(..)
87import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
103import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
@@ -91,11 +107,12 @@ import qualified Data.Aeson as JSON
91import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
107import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
92import Data.Char (isAlphaNum, toUpper)
108import Data.Char (isAlphaNum, toUpper)
93import qualified Data.HashMap.Strict as HM
109import qualified Data.HashMap.Strict as HM
94−import qualified Data.Map as M
95import Data.Monoid ((<>))
110import Data.Monoid ((<>))
111+import Data.Scientific (floatingOrInteger)
96import Data.Text (Text)
112import Data.Text (Text)
97import qualified Data.Text as T
113import qualified Data.Text as T
98import Data.Time.Clock (UTCTime)
114import Data.Time.Clock (UTCTime)
115+import qualified Data.Vector as V
99import GHC.Generics (Generic)
116import GHC.Generics (Generic)
100import Prelude hiding (all, tail)
117import Prelude hiding (all, tail)
101import Text.Read (readMaybe)
118import Text.Read (readMaybe)
@@ -108,14 +125,20 @@ data Endpoint =
108 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)
125 | CreateContainerEndpoint CreateOpts (Maybe ContainerName)
109 | StartContainerEndpoint StartOpts ContainerID
126 | StartContainerEndpoint StartOpts ContainerID
110 | StopContainerEndpoint Timeout ContainerID
127 | StopContainerEndpoint Timeout ContainerID
128+ | WaitContainerEndpoint ContainerID
111 | KillContainerEndpoint Signal ContainerID
129 | KillContainerEndpoint Signal ContainerID
112 | RestartContainerEndpoint Timeout ContainerID
130 | RestartContainerEndpoint Timeout ContainerID
113 | PauseContainerEndpoint ContainerID
131 | PauseContainerEndpoint ContainerID
114 | UnpauseContainerEndpoint ContainerID
132 | UnpauseContainerEndpoint ContainerID
115 | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.
133 | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.
116 -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.
134 -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.
117− | DeleteContainerEndpoint DeleteOpts ContainerID
135+ | DeleteContainerEndpoint ContainerDeleteOpts ContainerID
118 | 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
119 deriving (Eq, Show)
142 deriving (Eq, Show)
121-- | We should newtype this
144-- | We should newtype this
@@ -162,6 +185,20 @@ toImageID t =
162-- | Timeout used for stopping a container. DefaultTimeout is 10 seconds.
185-- | Timeout used for stopping a container. DefaultTimeout is 10 seconds.
163data 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"
165-- TODO: Add more Signals or use an existing lib
202-- TODO: Add more Signals or use an existing lib
166-- | Signal used for sending to the process running in the container.
203-- | Signal used for sending to the process running in the container.
167-- The default signal is SIGTERM.
204-- The default signal is SIGTERM.
@@ -176,16 +213,16 @@ data Signal = SIGHUP
177instance FromJSON Signal where
214instance FromJSON Signal where
178 parseJSON (JSON.String "SIGTERM") = return SIGTERM
215 parseJSON (JSON.String "SIGTERM") = return SIGTERM
179− 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.
180− parseJSON (JSON.String "SIGINT") = return SIGINT
217+ parseJSON (JSON.String "SIGINT") = return SIGINT
181 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT
218 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT
182 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP
219 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP
183 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1
220 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1
184− parseJSON _ = fail "Unknown Signal"
221+ parseJSON _ = fail "Unknown Signal"
186instance ToJSON Signal where
223instance ToJSON Signal where
187− toJSON SIGHUP = "SIGHUP"
224+ toJSON SIGHUP = "SIGHUP"
188− toJSON SIGINT = "SIGINT"
225+ toJSON SIGINT = "SIGINT"
189 toJSON SIGQUIT = "SIGQUIT"
226 toJSON SIGQUIT = "SIGQUIT"
190 toJSON SIGSTOP = "SIGSTOP"
227 toJSON SIGSTOP = "SIGSTOP"
191 toJSON SIGTERM = "SIGTERM"
228 toJSON SIGTERM = "SIGTERM"
@@ -213,7 +250,7 @@ data ContainerDetails = ContainerDetails {
213 , processLabel :: Text
250 , processLabel :: Text
214 , resolveConfPath :: FilePath
251 , resolveConfPath :: FilePath
215 , restartCount :: Int
252 , restartCount :: Int
216− , state :: ContainerState
253+ , containerDetailsState :: ContainerState
217 , mounts :: [Mount]
254 , mounts :: [Mount]
219 deriving (Eq, Show, Generic)
256 deriving (Eq, Show, Generic)
@@ -221,11 +258,11 @@ data ContainerDetails = ContainerDetails {
221-- | Data type used for parsing the mount information from a container
258-- | Data type used for parsing the mount information from a container
223data Mount = Mount {
260data Mount = Mount {
224− mountName :: Text
261+ mountName :: Maybe Text -- this is optional
225 , mountSource :: FilePath
262 , mountSource :: FilePath
226 , mountDestination :: FilePath
263 , mountDestination :: FilePath
227− , mountDriver :: Text
264+ , mountDriver :: Maybe Text
228− , mountMode :: Maybe VolumePermission -- apparently this can be null
265+ -- , mountMode :: Maybe VolumePermission -- apparently this can be null
229 , mountRW :: Bool
266 , mountRW :: Bool
230 , mountPropogation :: Text
267 , mountPropogation :: Text
@@ -233,14 +270,14 @@ data Mount = Mount {
234instance FromJSON Mount where
271instance FromJSON Mount where
235 parseJSON (JSON.Object o) = do
272 parseJSON (JSON.Object o) = do
236− name <- o .: "Name"
273+ name <- o .:? "Name"
237 src <- o .: "Source"
274 src <- o .: "Source"
238 dest <- o .: "Destination"
275 dest <- o .: "Destination"
239− driver <- o .: "Driver"
276+ driver <- o .:? "Driver"
240− mode <- o .: "Mode"
277+ -- mode <- o .: "Mode"
241 rw <- o .: "RW"
278 rw <- o .: "RW"
242 prop <- o .: "Propagation"
279 prop <- o .: "Propagation"
243− return $ Mount name src dest driver mode rw prop
280+ return $ Mount name src dest driver rw prop
244 parseJSON _ = fail "Mount is not an object"
281 parseJSON _ = fail "Mount is not an object"
246-- | Data type used for parsing the container state from a list of
283-- | Data type used for parsing the container state from a list of
@@ -256,7 +293,7 @@ data ContainerState = ContainerState {
256 , restarting :: Bool
293 , restarting :: Bool
257 , running :: Bool
294 , running :: Bool
258 , startedAt :: UTCTime
295 , startedAt :: UTCTime
259− , status :: Status
296+ , state :: State
261 deriving (Eq, Show, Generic)
298 deriving (Eq, Show, Generic)
@@ -419,20 +456,17 @@ instance FromJSON NetworkOptions where
419 parseJSON _ = fail "NetworkOptions is not an object"
456 parseJSON _ = fail "NetworkOptions is not an object"
421-- TODO: Not sure what this is used for anymore.
458-- TODO: Not sure what this is used for anymore.
422−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
423 deriving (Eq, Show)
460 deriving (Eq, Show)
425−instance FromJSON Networks where
462+instance {-# OVERLAPPING #-} FromJSON [Network] where
426− parseJSON (JSON.Object o) = do
463+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
427− Networks <$> HM.foldlWithKey' f (return M.empty) o
430 f accM k' v' = do
465 f accM k' v' = do
431 acc <- accM
466 acc <- accM
432 k <- parseJSON $ JSON.String k'
467 k <- parseJSON $ JSON.String k'
433 v <- parseJSON v'
468 v <- parseJSON v'
434− return $ M.insert k v acc
469+ return $ (Network k v):acc
436 parseJSON _ = fail "Networks is not an object"
470 parseJSON _ = fail "Networks is not an object"
438-- | Data type reprsenting the various network settings a container can have.
472-- | Data type reprsenting the various network settings a container can have.
@@ -454,7 +488,7 @@ data NetworkSettings = NetworkSettings {
454 , networkSettingsIpPrefixLen :: Int
488 , networkSettingsIpPrefixLen :: Int
455 , networkSettingsIpv6Gateway :: Text
489 , networkSettingsIpv6Gateway :: Text
456 , networkSettingsMacAddress :: Text
490 , networkSettingsMacAddress :: Text
457− , networkSettingsNetworks :: Networks
491+ , networkSettingsNetworks :: [Network]
459 deriving (Eq, Show)
493 deriving (Eq, Show)
@@ -489,21 +523,23 @@ data Container = Container
489 , containerImageId :: ImageID
523 , containerImageId :: ImageID
490 , containerCommand :: Text
524 , containerCommand :: Text
491 , containerCreatedAt :: Int
525 , containerCreatedAt :: Int
526+ , containerState :: State
492− , containerStatus :: Status
527+ , containerStatus :: Maybe Text
493 , containerPorts :: [ContainerPortInfo]
528 , containerPorts :: [ContainerPortInfo]
494− , containerLabels :: Labels
529+ , containerLabels :: [Label]
495− , containerNetworks :: Networks
530+ , containerNetworks :: [Network]
496 , containerMounts :: [Mount]
531 , containerMounts :: [Mount]
497 } deriving (Show, Eq)
532 } deriving (Show, Eq)
499instance FromJSON Container where
534instance FromJSON Container where
500− parseJSON (JSON.Object v) =
535+ parseJSON o@(JSON.Object v) =
501− Container <$> (v .: "Id")
536+ Container <$> parseJSON o
502 <*> (v .: "Names")
537 <*> (v .: "Names")
503 <*> (v .: "Image")
538 <*> (v .: "Image")
504− <*> (v .: "ImageID")
539+ <*> (v .: "ImageID") -- Doesn't exist anymore
505− <*> (v .: "Command")
540+ <*> (v .: "Command") -- Doesn't exist anymore
506 <*> (v .: "Created")
541 <*> (v .: "Created")
507 <*> (v .: "Status")
543 <*> (v .: "Status")
508 <*> (v .: "Ports")
544 <*> (v .: "Ports")
509 <*> (v .: "Labels")
545 <*> (v .: "Labels")
@@ -513,34 +549,45 @@ instance FromJSON Container where
513 parseNetworks (JSON.Object v) =
549 parseNetworks (JSON.Object v) =
514 (v .: "Networks") >>= parseJSON
550 (v .: "Networks") >>= parseJSON
515 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
551 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
517 parseJSON _ = fail "Container: Not a JSON object."
552 parseJSON _ = fail "Container: Not a JSON object."
519−-- | Represents the status of the container life cycle.
554+-- | Represents the state of the container life cycle.
520−data Status = Created | Restarting | Running | Paused | Exited | Dead
555+data State = Created | Restarting | Running | Paused | Exited | Dead
521 deriving (Eq, Show, Generic)
556 deriving (Eq, Show, Generic)
523−instance FromJSON Status where
558+instance FromJSON State where
524− parseJSON (JSON.String "running") = return Running
559+ parseJSON (JSON.String "running") = return Running
525− 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.
526 parseJSON (JSON.String "restarting") = return Restarting
561 parseJSON (JSON.String "restarting") = return Restarting
527− parseJSON (JSON.String "paused") = return Paused
562+ parseJSON (JSON.String "paused") = return Paused
528− parseJSON (JSON.String "exited") = return Exited
563+ parseJSON (JSON.String "exited") = return Exited
529− parseJSON (JSON.String "dead") = return Dead
564+ parseJSON (JSON.String "dead") = return Dead
530− parseJSON _ = fail "Unknown Status"
565+ parseJSON s = fail $ "Unknown Status: " ++ show s
532-- | Alias for representing a RepoDigest. We could newtype this and add
567-- | Alias for representing a RepoDigest. We could newtype this and add
533-- some validation.
568-- some validation.
534type Digest = Text
569type Digest = Text
536-- | Container and Image Labels.
571-- | Container and Image Labels.
537−newtype Labels = Labels (M.Map Name Value) deriving (Eq, Show)
572+data Label = Label Name Value deriving (Eq, Show)
539−instance FromJSON Labels where
540− parseJSON val = Labels <$> parseJSON val
575+-- If there are multiple lables with the same Name in the list
576+-- then the last one wins.
542−instance ToJSON Labels where
577+instance {-# OVERLAPPING #-} ToJSON [Label] where
543− 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."
545-- | Alias for Tags.
592-- | Alias for Tags.
546type Tag = Text
593type Tag = Text
@@ -551,10 +598,10 @@ data Image = DockerImage {
551 , imageCreated :: Integer
598 , imageCreated :: Integer
552 , imageParentId :: Maybe ImageID
599 , imageParentId :: Maybe ImageID
553 , imageRepoTags :: [Tag]
600 , imageRepoTags :: [Tag]
554− , imageRepoDigests :: Maybe [Digest]
601+ , imageRepoDigests :: [Digest]
555 , imageSize :: Integer
602 , imageSize :: Integer
556 , imageVirtualSize :: Integer
603 , imageVirtualSize :: Integer
557− , imageLabels :: Maybe Labels
604+ , imageLabels :: [Label]
558 } deriving (Show, Eq, Generic)
605 } deriving (Show, Eq, Generic)
560-- | Helper function used for dropping the "image" prefix when serializing
607-- | Helper function used for dropping the "image" prefix when serializing
@@ -562,23 +609,60 @@ data Image = DockerImage {
562dropImagePrefix :: [a] -> [a]
609dropImagePrefix :: [a] -> [a]
563dropImagePrefix = drop 5
610dropImagePrefix = drop 5
565instance FromJSON Image where
613instance FromJSON Image where
566− parseJSON = genericParseJSON defaultOptions {
614+ parseJSON (JSON.Object o) = do
567− fieldLabelModifier = dropImagePrefix}
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
569-- | Options used for creating a Container.
650-- | Options used for creating a Container.
570data CreateOpts = CreateOpts {
651data CreateOpts = CreateOpts {
571− containerConfig :: ContainerConfig
652+ containerConfig :: ContainerConfig
572− , hostConfig :: HostConfig
653+ , hostConfig :: HostConfig
654+ , networkingConfig :: NetworkingConfig
573 } deriving (Eq, Show)
655 } deriving (Eq, Show)
575instance ToJSON CreateOpts where
657instance ToJSON CreateOpts where
576− toJSON (CreateOpts cc hc) = do
658+ toJSON (CreateOpts cc hc nc) = do
577 let ccJSON = toJSON cc
659 let ccJSON = toJSON cc
578 let hcJSON = toJSON hc
660 let hcJSON = toJSON hc
579 case ccJSON of
661 case ccJSON of
580 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
662 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
581− JSON.Object $ HM.insert "HostConfig" hcJSON o
663+ let o1 = HM.insert "HostConfig" hcJSON o
664+ let o2 = HM.insert "NetworkingConfig" (toJSON nc) o1
582 _ -> error "ContainerConfig is not an object." -- This should never happen.
666 _ -> error "ContainerConfig is not an object." -- This should never happen.
584-- | Container configuration used for creating a container with sensible
668-- | Container configuration used for creating a container with sensible
@@ -592,7 +676,7 @@ defaultContainerConfig imageName = ContainerConfig {
592 , attachStdout=False
676 , attachStdout=False
593 , image=imageName
677 , image=imageName
594 , attachStderr=False
678 , attachStderr=False
595− , exposedPorts=Nothing -- ExposedPorts M.empty
679+ , exposedPorts=[]
596 , tty=False
680 , tty=False
597 , openStdin=False
681 , openStdin=False
598 , stdinOnce=False
682 , stdinOnce=False
@@ -600,10 +684,10 @@ defaultContainerConfig imageName = ContainerConfig {
601 , volumes=[]
685 , volumes=[]
602 , workingDir=Nothing
686 , workingDir=Nothing
603− , entrypoint=Nothing
687+ , entrypoint=Entrypoint []
604 , networkDisabled=Nothing
688 , networkDisabled=Nothing
605 , macAddress=Nothing
689 , macAddress=Nothing
606− , labels=Nothing
690+ , labels=[]
607 , stopSignal=SIGTERM
691 , stopSignal=SIGTERM
@@ -612,8 +696,8 @@ defaultHostConfig :: HostConfig
612defaultHostConfig = HostConfig {
696defaultHostConfig = HostConfig {
614 , containerIDFile=Nothing
698 , containerIDFile=Nothing
615− , logConfig=LogDriverConfig JsonFile Nothing
699+ , logConfig=LogDriverConfig JsonFile []
616− , networkMode=Bridge
700+ , networkMode=NetworkBridge
617 , portBindings=[]
701 , portBindings=[]
618 , restartPolicy=RestartOff
702 , restartPolicy=RestartOff
619 , volumeDriver=Nothing
703 , volumeDriver=Nothing
@@ -653,14 +737,18 @@ defaultContainerResources = ContainerResources {
653 , memory=Nothing
737 , memory=Nothing
654 , memoryReservation=Nothing
738 , memoryReservation=Nothing
655 , memorySwap=Nothing
739 , memorySwap=Nothing
656− , oomKillDisable=False
740+ , oomKillDisable=Just False
657 , ulimits=[]
741 , ulimits=[]
660-- | Default create options when creating a container. You only need to
744-- | Default create options when creating a container. You only need to
661-- specify an image name and the rest is all sensible defaults.
745-- specify an image name and the rest is all sensible defaults.
662defaultCreateOpts :: T.Text -> CreateOpts
746defaultCreateOpts :: T.Text -> CreateOpts
747+defaultCreateOpts imageName = CreateOpts
663−defaultCreateOpts imageName = CreateOpts { containerConfig = defaultContainerConfig imageName, hostConfig = defaultHostConfig }
748+ { containerConfig = defaultContainerConfig imageName
749+ , hostConfig = defaultHostConfig
750+ , networkingConfig = NetworkingConfig HM.empty
665-- | Override the key sequence for detaching a container.
753-- | Override the key sequence for detaching a container.
666-- 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 _.
@@ -674,16 +762,45 @@ defaultStartOpts :: StartOpts
674defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
762defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
676-- | Options for deleting a container.
764-- | Options for deleting a container.
677−data DeleteOpts = DeleteOpts {
765+data ContainerDeleteOpts = ContainerDeleteOpts {
678 deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.
766 deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.
679 , force :: Bool -- ^ If the container is still running force deletion anyway.
767 , force :: Bool -- ^ If the container is still running force deletion anyway.
680 } 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
682-- | Default options for deleting a container. Most of the time we DON'T
792-- | Default options for deleting a container. Most of the time we DON'T
683-- want to delete the container's volumes or force delete it if it's
793-- want to delete the container's volumes or force delete it if it's
684-- running.
794-- running.
685−defaultDeleteOpts :: DeleteOpts
795+defaultContainerDeleteOpts :: ContainerDeleteOpts
686−defaultDeleteOpts = DeleteOpts { deleteVolumes = False, force = False }
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
688-- | Timestamp alias.
805-- | Timestamp alias.
689type Timestamp = Integer
806type Timestamp = Integer
@@ -711,18 +828,50 @@ defaultLogOpts = LogOpts { stdout = True
711 , 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
714-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
861-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
715-- | Set permissions on volumes that you mount in the container.
862-- | Set permissions on volumes that you mount in the container.
716data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
863data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
718instance ToJSON VolumePermission where
865instance ToJSON VolumePermission where
719 toJSON ReadWrite = "rw"
866 toJSON ReadWrite = "rw"
720− toJSON ReadOnly = "ro"
867+ toJSON ReadOnly = "ro"
722instance FromJSON VolumePermission where
869instance FromJSON VolumePermission where
723 parseJSON "rw" = return ReadWrite
870 parseJSON "rw" = return ReadWrite
724 parseJSON "ro" = return ReadOnly
871 parseJSON "ro" = return ReadOnly
872+ parseJSON "RW" = return ReadWrite
873+ parseJSON "RO" = return ReadOnly
725− parseJSON _ = fail "Failed to parse VolumePermission"
874+ parseJSON _ = fail "Failed to parse VolumePermission"
727-- | Used for marking a directory in the container as "exposed" hence
876-- | Used for marking a directory in the container as "exposed" hence
728-- taking it outside of the COW filesystem and making it mountable
877-- taking it outside of the COW filesystem and making it mountable
@@ -737,15 +886,15 @@ instance FromJSON VolumePermission where
738newtype Volume = Volume FilePath deriving (Eq, Show)
887newtype Volume = Volume FilePath deriving (Eq, Show)
740−instance ToJSON [Volume] where
889+instance {-# OVERLAPPING #-} ToJSON [Volume] where
741− toJSON [] = JSON.Object HM.empty
890+ toJSON [] = emptyJsonObject
742− toJSON (v:vs) = JSON.Object $ foldl f HM.empty (v:vs)
891+ toJSON (v:vs) = toJsonKey (v:vs) getKey
743− where f acc (Volume k) = HM.insert (T.pack k) (JSON.Object HM.empty) acc
892+ where getKey (Volume v) = v
745−instance FromJSON [Volume] where
894+instance {-# OVERLAPPING #-} FromJSON [Volume] where
746 parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o
895 parseJSON (JSON.Object o) = return $ map (Volume . T.unpack) $ HM.keys o
747− parseJSON (JSON.Null) = return []
896+ parseJSON (JSON.Null) = return []
748− parseJSON _ = fail "Volume is not an object"
897+ parseJSON _ = fail "Volume is not an object"
751data Bind = Bind { hostSrc :: Text
900data Bind = Bind { hostSrc :: Text
@@ -755,10 +904,10 @@ data Bind = Bind { hostSrc :: Text
756instance FromJSON Bind where
905instance FromJSON Bind where
757 parseJSON (JSON.String t) = case T.split (== ':') t of
906 parseJSON (JSON.String t) = case T.split (== ':') t of
758− [src, dest] -> return $ Bind src dest Nothing
907+ [src, dest] -> return $ Bind src dest Nothing
759 [src, dest, "rw"] -> return $ Bind src dest $ Just ReadWrite
908 [src, dest, "rw"] -> return $ Bind src dest $ Just ReadWrite
760 [src, dest, "ro"] -> return $ Bind src dest $ Just ReadOnly
909 [src, dest, "ro"] -> return $ Bind src dest $ Just ReadOnly
761− _ -> fail "Could not parse Bind"
910+ _ -> fail "Could not parse Bind"
762 parseJSON _ = fail "Bind is not a string"
911 parseJSON _ = fail "Bind is not a string"
764data Device = Device {
913data Device = Device {
@@ -781,15 +930,15 @@ data VolumeFrom = VolumeFrom ContainerName (Maybe VolumePermission) deriving (Eq
782instance FromJSON VolumeFrom where
931instance FromJSON VolumeFrom where
783 parseJSON (JSON.String t) = case T.split (== ':') t of
932 parseJSON (JSON.String t) = case T.split (== ':') t of
784− [vol] -> return $ VolumeFrom vol Nothing
933+ [vol] -> return $ VolumeFrom vol Nothing
785 [vol, "rw"] -> return $ VolumeFrom vol $ Just ReadWrite
934 [vol, "rw"] -> return $ VolumeFrom vol $ Just ReadWrite
786 [vol, "ro"] -> return $ VolumeFrom vol $ Just ReadOnly
935 [vol, "ro"] -> return $ VolumeFrom vol $ Just ReadOnly
787− _ -> fail "Could not parse VolumeFrom"
936+ _ -> fail "Could not parse VolumeFrom"
788 parseJSON _ = fail "VolumeFrom is not a string"
937 parseJSON _ = fail "VolumeFrom is not a string"
790instance ToJSON VolumeFrom where
939instance ToJSON VolumeFrom where
791 toJSON (VolumeFrom n p) = case p of
940 toJSON (VolumeFrom n p) = case p of
792− Nothing -> toJSON $ n <> ":" <> "rw"
941+ Nothing -> toJSON $ n <> ":" <> "rw"
793 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)
942 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)
795instance ToJSON Bind where
944instance ToJSON Bind where
@@ -801,63 +950,63 @@ data Link = Link Text (Maybe Text) deriving (Eq, Show)
802instance FromJSON Link where
951instance FromJSON Link where
803 parseJSON (JSON.String t) = case T.split (== ':') t of
952 parseJSON (JSON.String t) = case T.split (== ':') t of
804− [f] -> return $ Link f Nothing
953+ [f] -> return $ Link f Nothing
805 [f,s] -> return $ Link f $ Just s
954 [f,s] -> return $ Link f $ Just s
806− _ -> fail "Could not parse Link"
955+ _ -> fail "Could not parse Link"
807 parseJSON _ = fail "Link is not a string"
956 parseJSON _ = fail "Link is not a string"
809instance ToJSON Link where
958instance ToJSON Link where
810 toJSON (Link n1 n2) = toJSON $ case n2 of
959 toJSON (Link n1 n2) = toJSON $ case n2 of
811 Nothing -> T.concat[n1, ":", n1] -- use same name in container
960 Nothing -> T.concat[n1, ":", n1] -- use same name in container
812− Just n -> T.concat[n1, ":", n] -- used specified name in container
961+ Just n -> T.concat[n1, ":", n] -- used specified name in container
814-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
963-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
815data 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)
817instance FromJSON LogDriverType where
966instance FromJSON LogDriverType where
818 parseJSON (JSON.String "json-file") = return JsonFile
967 parseJSON (JSON.String "json-file") = return JsonFile
819− parseJSON (JSON.String "syslog") = return Syslog
968+ parseJSON (JSON.String "syslog") = return Syslog
820− parseJSON (JSON.String "journald") = return Journald
969+ parseJSON (JSON.String "journald") = return Journald
821− parseJSON (JSON.String "gelf") = return Gelf
970+ parseJSON (JSON.String "gelf") = return Gelf
822− parseJSON (JSON.String "fluentd") = return Fluentd
971+ parseJSON (JSON.String "fluentd") = return Fluentd
823− parseJSON (JSON.String "awslogs") = return AwsLogs
972+ parseJSON (JSON.String "awslogs") = return AwsLogs
824− parseJSON (JSON.String "splunk") = return Splunk
973+ parseJSON (JSON.String "splunk") = return Splunk
825− parseJSON (JSON.String "etwlogs") = return Etwlogs
974+ parseJSON (JSON.String "etwlogs") = return Etwlogs
826− parseJSON (JSON.String "none") = return LoggingDisabled
975+ parseJSON (JSON.String "none") = return LoggingDisabled
827− parseJSON _ = fail "Unknown LogDriverType"
976+ parseJSON _ = fail "Unknown LogDriverType"
829instance ToJSON LogDriverType where
978instance ToJSON LogDriverType where
830− toJSON JsonFile = JSON.String "json-file"
979+ toJSON JsonFile = JSON.String "json-file"
831− toJSON Syslog = JSON.String "syslog"
980+ toJSON Syslog = JSON.String "syslog"
832− toJSON Journald = JSON.String "journald"
981+ toJSON Journald = JSON.String "journald"
833− toJSON Gelf = JSON.String "gelf"
982+ toJSON Gelf = JSON.String "gelf"
834− toJSON Fluentd = JSON.String "fluentd"
983+ toJSON Fluentd = JSON.String "fluentd"
835− toJSON AwsLogs = JSON.String "awslogs"
984+ toJSON AwsLogs = JSON.String "awslogs"
836− toJSON Splunk = JSON.String "splunk"
985+ toJSON Splunk = JSON.String "splunk"
837− toJSON Etwlogs = JSON.String "etwlogs"
986+ toJSON Etwlogs = JSON.String "etwlogs"
838 toJSON LoggingDisabled = JSON.String "none"
987 toJSON LoggingDisabled = JSON.String "none"
840−newtype LogDriverOptions = LogDriverOptions (M.Map Text Text) deriving (Eq, Show)
989+data LogDriverOption = LogDriverOption Name Value deriving (Eq, Show)
842−instance FromJSON LogDriverOptions where
991+instance {-# OVERLAPPING #-} ToJSON [LogDriverOption] where
843− parseJSON (JSON.Object o) = do
992+ toJSON [] = emptyJsonObject
844− 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
846− where
997+instance {-# OVERLAPPING #-} FromJSON [LogDriverOption] where
998+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
847− f accM k (JSON.String v) = do
999+ where f accM k v = do
848 acc <- accM
1000 acc <- accM
1001+ value <- parseJSON v
849− return $ M.insert k v acc
1002+ return $ (LogDriverOption k value):acc
1003+ parseJSON JSON.Null = return []
850− f _ _ _ = fail "Value of LogDriverOptions is not a string"
1004+ parseJSON _ = fail "Failed to parse LogDriverOptions"
852− parseJSON JSON.Null = return $ LogDriverOptions M.empty
853− parseJSON _ = fail "LogDriverOptions is not an object"
855−instance ToJSON LogDriverOptions where
856− toJSON (LogDriverOptions mp) = toJSON mp
858−data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
1006+data LogDriverConfig = LogDriverConfig LogDriverType [LogDriverOption] deriving (Eq, Show)
860instance ToJSON LogDriverConfig where
1008instance ToJSON LogDriverConfig where
1009+ toJSON (LogDriverConfig driverType []) = object ["Type" .= driverType]
861 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
1010 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
863instance FromJSON LogDriverConfig where
1012instance FromJSON LogDriverConfig where
@@ -868,19 +1017,41 @@ instance FromJSON LogDriverConfig where
868 parseJSON _ = fail "LogDriverConfig is not an object"
1017 parseJSON _ = fail "LogDriverConfig is not an object"
870-- TODO: Add container:<name|id> mode
1019-- TODO: Add container:<name|id> mode
871−data NetworkMode = Bridge | Host | NetworkDisabled
1020+data NetworkMode = NetworkBridge | NetworkHost | NetworkDisabled | NetworkNamed Text
872 deriving (Eq, Show, Ord)
1021 deriving (Eq, Show, Ord)
874instance FromJSON NetworkMode where
1023instance FromJSON NetworkMode where
875− parseJSON (JSON.String "bridge") = return Bridge
1024+ parseJSON (JSON.String "bridge") = return NetworkBridge
876− parseJSON (JSON.String "host") = return Host -- Note: Guessing on these.
1025+ parseJSON (JSON.String "host") = return NetworkHost -- Note: Guessing on these.
877− parseJSON (JSON.String "none") = return NetworkDisabled
1026+ parseJSON (JSON.String "none") = return NetworkDisabled
1027+ parseJSON (JSON.String n) = return $ NetworkNamed n
878− parseJSON _ = fail "Unknown NetworkMode"
1028+ parseJSON _ = fail "Unknown NetworkMode"
880instance ToJSON NetworkMode where
1030instance ToJSON NetworkMode where
881− toJSON Bridge = JSON.String "bridge"
1031+ toJSON NetworkBridge = JSON.String "bridge"
882− toJSON Host = JSON.String "host"
1032+ toJSON NetworkHost = JSON.String "host"
883 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]
885data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)
1056data PortType = TCP | UDP deriving (Eq, Generic, Read, Ord)
@@ -896,7 +1067,7 @@ instance FromJSON PortType where
896 parseJSON val = case val of
1067 parseJSON val = case val of
897 "tcp" -> return TCP
1068 "tcp" -> return TCP
898 "udp" -> return UDP
1069 "udp" -> return UDP
899− _ -> fail "PortType: Invalid port type."
1070+ _ -> fail "PortType: Invalid port type."
901-- newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
1072-- newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
@@ -969,7 +1140,15 @@ addPortBinding pb c = c{hostConfig=hc{portBindings=pbs <> [pb]}}
969 where hc = hostConfig c
1140 where hc = hostConfig c
970 pbs = portBindings $ 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
972−instance FromJSON [PortBinding] where
1151+instance {-# OVERLAPPING #-} FromJSON [PortBinding] where
973 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
1152 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
975 f accM k v = case T.split (== '/') k of
1154 f accM k v = case T.split (== '/') k of
@@ -979,16 +1158,15 @@ instance FromJSON [PortBinding] where
979 acc <- accM
1158 acc <- accM
980 hps <- parseJSON v
1159 hps <- parseJSON v
981 return $ (PortBinding port portType hps):acc
1160 return $ (PortBinding port portType hps):acc
983− fail "Could not parse PortBindings"
1161+ _ -> fail "Could not parse PortBindings"
1162+ parseJSON (JSON.Null) = return []
984 parseJSON _ = fail "PortBindings is not an object"
1163 parseJSON _ = fail "PortBindings is not an object"
986−instance ToJSON [PortBinding] where
1165+instance {-# OVERLAPPING #-} ToJSON [PortBinding] where
987− toJSON [] = JSON.Object HM.empty
1166+ toJSON [] = emptyJsonObject
988− toJSON (p:ps) = JSON.Object $ foldl f HM.empty (p:ps)
1167+ toJSON (p:ps) = toJsonKeyVal (p:ps) key val
989− where mKey p = portAndType2Text (containerPort p) (portType p)
1168+ where key p = T.unpack $ portAndType2Text (containerPort p) (portType p)
990− mVal p = toJSON $ hostPorts p
1169+ val p = hostPorts p
991− f acc p = HM.insert (mKey p) (mVal p) acc
993data HostPort = HostPort {
1171data HostPort = HostPort {
994 hostIp :: Text
1172 hostIp :: Text
@@ -1019,7 +1197,7 @@ instance FromJSON RestartPolicy where
1019 "on-failure" -> do
1197 "on-failure" -> do
1020 retry <- o .: "MaximumRetryCount"
1198 retry <- o .: "MaximumRetryCount"
1021 return $ RestartOnFailure retry
1199 return $ RestartOnFailure retry
1022− "off" -> return RestartOff
1200+ "no" -> return RestartOff
1023 _ -> fail "Could not parse RestartPolicy"
1201 _ -> fail "Could not parse RestartPolicy"
1024 parseJSON _ = fail "RestartPolicy is not an object"
1202 parseJSON _ = fail "RestartPolicy is not an object"
@@ -1027,7 +1205,7 @@ instance ToJSON RestartPolicy where
1027 toJSON RestartAlways = object ["Name" .= JSON.String "always"]
1205 toJSON RestartAlways = object ["Name" .= JSON.String "always"]
1028 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]
1206 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]
1029 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]
1207 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]
1030− toJSON RestartOff = object ["Name" .= JSON.String "off"]
1208+ toJSON RestartOff = object ["Name" .= JSON.String "no"]
1032data Isolation = Default | Process | Hyperv deriving (Eq, Show)
1210data Isolation = Default | Process | Hyperv deriving (Eq, Show)
@@ -1200,6 +1378,22 @@ instance ToJSON DeviceRate where
1200 , "Rate" .= r
1378 , "Rate" .= r
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"
1203data ContainerResources = ContainerResources {
1397data ContainerResources = ContainerResources {
1204 cpuShares :: Maybe Integer
1398 cpuShares :: Maybe Integer
1205 -- , 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.
@@ -1215,12 +1409,12 @@ data ContainerResources = ContainerResources {
1215 , cpusetMems :: Maybe Text
1409 , cpusetMems :: Maybe Text
1216 , devices :: [Device]
1410 , devices :: [Device]
1217 -- , diskQuota :: Integer -- Don't see this ins 1.24.
1411 -- , diskQuota :: Integer -- Don't see this ins 1.24.
1218− , kernelMemory :: Maybe Integer
1412+ , kernelMemory :: Maybe MemoryConstraint
1219− , memory :: Maybe Integer
1413+ , memory :: Maybe MemoryConstraint
1220− , memoryReservation :: Maybe Integer
1414+ , memoryReservation :: Maybe MemoryConstraint
1221− , memorySwap :: Maybe Integer
1415+ , memorySwap :: Maybe MemoryConstraint
1222 -- , 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.
1223− , oomKillDisable :: Bool
1417+ , oomKillDisable :: Maybe Bool
1224 -- , 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.
1225 , ulimits :: [Ulimit]
1419 , ulimits :: [Ulimit]
1226 -- TODO: Missing from 1.24
1420 -- TODO: Missing from 1.24
@@ -1258,45 +1452,59 @@ instance FromJSON EnvVar where
1258 parseJSON _ = fail "EnvVar is not a string"
1452 parseJSON _ = fail "EnvVar is not a string"
1260instance ToJSON EnvVar where
1454instance ToJSON EnvVar where
1261− toJSON (EnvVar n v) = object [n .= v]
1455+ toJSON (EnvVar n v) = JSON.String $ n <> T.pack "=" <> v
1263−-- | ExposedPorts represent a enumeraton of all the ports (and their type)
1457+-- | ExposedPort represents a port (and it's type)
1264-- 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.
1265−-- `NOTE`: This does not automatically expose the ports onto the host
1459+-- `NOTE`: This does not automatically expose the port onto the host
1266−-- 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
1267-- the PublishAllPorts flag. It is also useful for
1461-- the PublishAllPorts flag. It is also useful for
1268-- the daemon to know which Environment variables to
1462-- the daemon to know which Environment variables to
1269-- inject into a container linking to our container.
1463-- inject into a container linking to our container.
1270-- Example linking a Postgres container named db would inject the following
1464-- Example linking a Postgres container named db would inject the following
1271-- environment variables automatically if we set the corresponding
1465-- environment variables automatically if we set the corresponding
1273−-- ExposedPorts:
1467+-- ExposedPort:
1276-- DB_PORT_5432_TCP_PORT="5432"
1470-- DB_PORT_5432_TCP_PORT="5432"
1277-- DB_PORT_5432_TCP_PROTO="tcp"
1471-- DB_PORT_5432_TCP_PROTO="tcp"
1278-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1472-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1280−newtype ExposedPorts = ExposedPorts (M.Map Port PortType) deriving (Eq, Show)
1474+data ExposedPort = ExposedPort Port PortType deriving (Eq, Show)
1281−-- JP: Should this be ExposedPorts [(Port, PortType)]?
1283−instance FromJSON ExposedPorts where
1284− parseJSON (JSON.Object o) = do
1285− ExposedPorts <$> HM.foldlWithKey' f (return M.empty) o
1476+instance {-# OVERLAPPING #-} FromJSON [ExposedPort] where
1477+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
1288 f accM k _ = case T.split (== '/') k of
1479 f accM k _ = case T.split (== '/') k of
1289 [port', portType'] -> do
1480 [port', portType'] -> do
1290 port <- parseIntegerText port'
1481 port <- parseIntegerText port'
1291 portType <- parseJSON $ JSON.String portType'
1482 portType <- parseJSON $ JSON.String portType'
1292 acc <- accM
1483 acc <- accM
1293− return $ M.insert port portType acc
1484+ return $ (ExposedPort port portType):acc
1295− fail "Could not parse ExposedPorts"
1485+ _ -> fail "Could not parse ExposedPorts"
1486+ parseJSON (JSON.Null) = return []
1296− 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)
1497+instance ToJSON Entrypoint where
1498+ toJSON (Entrypoint (e:es)) = toJSON (e:es)
1499+ toJSON (Entrypoint []) = JSON.Null
1298−instance ToJSON ExposedPorts where
1501+instance FromJSON Entrypoint where
1299− toJSON (ExposedPorts kvs) = object [((T.pack $ show p) <> "/" <> (T.pack $ show t)) .= JSON.Object HM.empty | (p,t) <- (M.toList kvs)]
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"
1302data ContainerConfig = ContainerConfig {
1510data ContainerConfig = ContainerConfig {
@@ -1306,7 +1514,7 @@ data ContainerConfig = ContainerConfig {
1306 , attachStdin :: Bool
1514 , attachStdin :: Bool
1307 , attachStdout :: Bool
1515 , attachStdout :: Bool
1308 , attachStderr :: Bool
1516 , attachStderr :: Bool
1309− , exposedPorts :: Maybe ExposedPorts -- Note: Should we expand the JSON instance and take away the Maybe?
1517+ , exposedPorts :: [ExposedPort]
1310 -- , publishService :: Text -- Don't see this in 1.24
1518 -- , publishService :: Text -- Don't see this in 1.24
1311 , tty :: Bool
1519 , tty :: Bool
1312 , openStdin :: Bool
1520 , openStdin :: Bool
@@ -1317,25 +1525,68 @@ data ContainerConfig = ContainerConfig {
1317 , image :: Text
1525 , image :: Text
1318 , volumes :: [Volume]
1526 , volumes :: [Volume]
1319 , workingDir :: Maybe FilePath
1527 , workingDir :: Maybe FilePath
1320− , entrypoint :: Maybe Text -- Can be null?
1528+ , entrypoint :: Entrypoint
1321 , 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?
1322 , macAddress :: Maybe Text
1530 , macAddress :: Maybe Text
1323 -- , 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.
1324− , labels :: Maybe Labels
1532+ , labels :: [Label]
1325 , stopSignal :: Signal
1533 , stopSignal :: Signal
1326 } deriving (Eq, Show, Generic)
1534 } deriving (Eq, Show, Generic)
1328instance ToJSON ContainerConfig where
1537instance ToJSON ContainerConfig where
1329 toJSON = genericToJSON defaultOptions {
1538 toJSON = genericToJSON defaultOptions {
1330 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1539 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1332instance FromJSON ContainerConfig where
1541instance FromJSON ContainerConfig where
1333− parseJSON = genericParseJSON defaultOptions {
1542+ parseJSON (JSON.Object o) = do
1334− 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
1336parseIntegerText :: (Monad m) => Text -> m Integer
1570parseIntegerText :: (Monad m) => Text -> m Integer
1337parseIntegerText t = case readMaybe $ T.unpack t of
1572parseIntegerText t = case readMaybe $ T.unpack t of
1338 Nothing ->
1573 Nothing ->
1339 fail "Could not parse Integer"
1574 fail "Could not parse Integer"
1340 Just i ->
1575 Just i ->
1341 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