@@ -73,10 +73,11 @@ module Docker.Client.Types (
73 , EnvVar(..)
73 , EnvVar(..)
74 , ContainerConfig(..)
74 , ContainerConfig(..)
75 , defaultContainerConfig
75 , defaultContainerConfig
76− , ExposedPorts(..)
76+ , ExposedPort(..)
77 , DeviceWeight(..)
77 , DeviceWeight(..)
78 , DeviceRate(..)
78 , DeviceRate(..)
79 , addPortBinding
79 , addPortBinding
@@ -592,7 +593,7 @@ defaultContainerConfig imageName = ContainerConfig {
592 , attachStdout=False
593 , attachStdout=False
593 , image=imageName
594 , image=imageName
594 , attachStderr=False
595 , attachStderr=False
595− , exposedPorts=Nothing -- ExposedPorts M.empty
596+ , exposedPorts=[]
596 , tty=False
597 , tty=False
597 , openStdin=False
598 , openStdin=False
598 , stdinOnce=False
599 , stdinOnce=False
@@ -969,6 +970,14 @@ addPortBinding pb c = c{hostConfig=hc{portBindings=pbs <> [pb]}}
969 where hc = hostConfig c
970 where hc = hostConfig c
970 pbs = portBindings $ hostConfig c
971 pbs = portBindings $ hostConfig c
973+-- | Helper function for adding a "ExposedPort" to and existing
974+-- CreateOpts record.
975+addExposedPort :: ExposedPort -> CreateOpts -> CreateOpts
976+addExposedPort ep c = c{containerConfig=cc{exposedPorts=oldeps <> [ep]}}
977+ where cc = containerConfig c
978+ oldeps = exposedPorts cc
972instance FromJSON [PortBinding] where
981instance FromJSON [PortBinding] where
973 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
982 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
@@ -979,8 +988,8 @@ instance FromJSON [PortBinding] where
979 acc <- accM
988 acc <- accM
980 hps <- parseJSON v
989 hps <- parseJSON v
981 return $ (PortBinding port portType hps):acc
990 return $ (PortBinding port portType hps):acc
983− fail "Could not parse PortBindings"
991+ _ -> fail "Could not parse PortBindings"
992+ parseJSON (JSON.Null) = return []
984 parseJSON _ = fail "PortBindings is not an object"
993 parseJSON _ = fail "PortBindings is not an object"
986instance ToJSON [PortBinding] where
995instance ToJSON [PortBinding] where
@@ -1260,44 +1269,43 @@ instance FromJSON EnvVar where
1260instance ToJSON EnvVar where
1269instance ToJSON EnvVar where
1261 toJSON (EnvVar n v) = object [n .= v]
1270 toJSON (EnvVar n v) = object [n .= v]
1263−-- | ExposedPorts represent a enumeraton of all the ports (and their type)
1272+-- | ExposedPort represents a port (and it's type)
1264-- that a container should expose to other containers or the host system.
1273-- that a container should expose to other containers or the host system.
1265−-- `NOTE`: This does not automatically expose the ports onto the host
1274+-- `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
1275+-- system but rather it just tags it. It's best to be used with
1267-- the PublishAllPorts flag. It is also useful for
1276-- the PublishAllPorts flag. It is also useful for
1268-- the daemon to know which Environment variables to
1277-- the daemon to know which Environment variables to
1269-- inject into a container linking to our container.
1278-- inject into a container linking to our container.
1270-- Example linking a Postgres container named db would inject the following
1279-- Example linking a Postgres container named db would inject the following
1271-- environment variables automatically if we set the corresponding
1280-- environment variables automatically if we set the corresponding
1273−-- ExposedPorts:
1282+-- ExposedPort:
1276-- DB_PORT_5432_TCP_PORT="5432"
1285-- DB_PORT_5432_TCP_PORT="5432"
1277-- DB_PORT_5432_TCP_PROTO="tcp"
1286-- DB_PORT_5432_TCP_PROTO="tcp"
1278-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1287-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1280−newtype ExposedPorts = ExposedPorts (M.Map Port PortType) deriving (Eq, Show)
1289+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
1291+instance FromJSON [ExposedPort] where
1292+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
1288 f accM k _ = case T.split (== '/') k of
1294 f accM k _ = case T.split (== '/') k of
1289 [port', portType'] -> do
1295 [port', portType'] -> do
1290 port <- parseIntegerText port'
1296 port <- parseIntegerText port'
1291 portType <- parseJSON $ JSON.String portType'
1297 portType <- parseJSON $ JSON.String portType'
1292 acc <- accM
1298 acc <- accM
1293− return $ M.insert port portType acc
1299+ return $ (ExposedPort port portType):acc
1295− fail "Could not parse ExposedPorts"
1300+ _ -> fail "Could not parse ExposedPorts"
1301+ parseJSON (JSON.Null) = return []
1296− parseJSON _ = fail "ExposedPorts is not an object."
1302+ parseJSON _ = fail "ExposedPorts is not an object"
1298−instance ToJSON ExposedPorts where
1299− toJSON (ExposedPorts kvs) = object [((T.pack $ show p) <> "/" <> (T.pack $ show t)) .= JSON.Object HM.empty | (p,t) <- (M.toList kvs)]
1304+instance ToJSON [ExposedPort] where
1305+ toJSON [] = JSON.Object HM.empty
1306+ toJSON (p:ps) = JSON.Object $ foldl f HM.empty (p:ps)
1307+ where f acc (ExposedPort p t) = HM.insert (exposify p t) (JSON.Object HM.empty) acc
1308+ exposify p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)
1302data ContainerConfig = ContainerConfig {
1310data ContainerConfig = ContainerConfig {
1303 hostname :: Maybe Text
1311 hostname :: Maybe Text
@@ -1306,7 +1314,7 @@ data ContainerConfig = ContainerConfig {
1306 , attachStdin :: Bool
1314 , attachStdin :: Bool
1307 , attachStdout :: Bool
1315 , attachStdout :: Bool
1308 , attachStderr :: Bool
1316 , attachStderr :: Bool
1309− , exposedPorts :: Maybe ExposedPorts -- Note: Should we expand the JSON instance and take away the Maybe?
1317+ , exposedPorts :: [ExposedPort]
1310 -- , publishService :: Text -- Don't see this in 1.24
1318 -- , publishService :: Text -- Don't see this in 1.24
1311 , tty :: Bool
1319 , tty :: Bool
1312 , openStdin :: Bool
1320 , openStdin :: Bool
@@ -1330,8 +1338,32 @@ instance ToJSON ContainerConfig where
1330 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1338 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1332instance FromJSON ContainerConfig where
1340instance FromJSON ContainerConfig where
1333− parseJSON = genericParseJSON defaultOptions {
1341+ parseJSON (JSON.Object o) = do
1334− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1342+ hostname <- o .:? "Hostname"
1343+ domainname <- o .:? "Domainname"
1344+ user <- o .:? "User"
1345+ attachStdin <- o .: "AttachStdin"
1346+ attachStdout <- o .: "AttachStdout"
1347+ attachStderr <- o .: "AttachStderr"
1348+ exposedPorts <- case HM.lookup "ExposedPorts" o of
1349+ Just eps -> parseJSON eps
1350+ Nothing -> return []
1352+ openStdin <- o .: "OpenStdin"
1353+ stdinOnce <- o .: "StdinOnce"
1356+ image <- o .: "Image"
1357+ volumes <- o .: "Volumes"
1358+ workingDir <- o .:? "WorkingDir"
1359+ entrypoint <- o .:? "Entrypoint"
1360+ networkDisabled <- o .:? "networkDisabled"
1361+ macAddress <- o .:? "MacAddress"
1362+ labels <- o .:? "Labels"
1363+ stopSignal <- o .: "StopSignal"
1364+ return $ ContainerConfig hostname domainname user attachStdin attachStdout attachStderr exposedPorts tty openStdin stdinOnce env cmd image volumes workingDir entrypoint networkDisabled
1365+ macAddress labels stopSignal
1366+ parseJSON _ = fail "NetworkSettings is not an object."
1336parseIntegerText :: (Monad m) => Text -> m Integer
1368parseIntegerText :: (Monad m) => Text -> m Integer
1337parseIntegerText t = case readMaybe $ T.unpack t of
1369parseIntegerText t = case readMaybe $ T.unpack t of