@@ -73,10 +73,11 @@ module Docker.Client.Types (
7373 , EnvVar(..)
7474 , ContainerConfig(..)
7575 , defaultContainerConfig
76− , ExposedPorts(..)
76+ , ExposedPort(..)
7777 , DeviceWeight(..)
7878 , DeviceRate(..)
7979 , addPortBinding
80+ , addExposedPort
8081 , addBind
8182 , setCmd
8283 , addLink
@@ -592,7 +593,7 @@ defaultContainerConfig imageName = ContainerConfig {
592593 , attachStdout=False
593594 , image=imageName
594595 , attachStderr=False
595− , exposedPorts=Nothing -- ExposedPorts M.empty
596+ , exposedPorts=[]
596597 , tty=False
597598 , openStdin=False
598599 , stdinOnce=False
@@ -969,6 +970,14 @@ addPortBinding pb c = c{hostConfig=hc{portBindings=pbs <> [pb]}}
969970 where hc = hostConfig c
970971 pbs = portBindings $ hostConfig c
971972
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
979+
980+
972981instance FromJSON [PortBinding] where
973982 parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
974983 where
@@ -979,8 +988,8 @@ instance FromJSON [PortBinding] where
979988 acc <- accM
980989 hps <- parseJSON v
981990 return $ (PortBinding port portType hps):acc
982− _ ->
983− fail "Could not parse PortBindings"
991+ _ -> fail "Could not parse PortBindings"
992+ parseJSON (JSON.Null) = return []
984993 parseJSON _ = fail "PortBindings is not an object"
985994
986995instance ToJSON [PortBinding] where
@@ -1260,44 +1269,43 @@ instance FromJSON EnvVar where
12601269instance ToJSON EnvVar where
12611270 toJSON (EnvVar n v) = object [n .= v]
12621271
1263−-- | ExposedPorts represent a enumeraton of all the ports (and their type)
1272+-- | ExposedPort represents a port (and it's type)
12641273-- that a container should expose to other containers or the host system.
1265−-- `NOTE`: This does not automatically expose the ports onto the host
1266−-- system but rather it just tags them. It's best to be used with
1274+-- `NOTE`: This does not automatically expose the port onto the host
1275+-- system but rather it just tags it. It's best to be used with
12671276-- the PublishAllPorts flag. It is also useful for
12681277-- the daemon to know which Environment variables to
12691278-- inject into a container linking to our container.
12701279-- Example linking a Postgres container named db would inject the following
12711280-- environment variables automatically if we set the corresponding
12721281--
1273−-- ExposedPorts:
1282+-- ExposedPort:
12741283--
12751284-- @
12761285-- DB_PORT_5432_TCP_PORT="5432"
12771286-- DB_PORT_5432_TCP_PROTO="tcp"
12781287-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
12791288-- @
1280−newtype ExposedPorts = ExposedPorts (M.Map Port PortType) deriving (Eq, Show)
1281−-- JP: Should this be ExposedPorts [(Port, PortType)]?
1282−
1283−instance FromJSON ExposedPorts where
1284− parseJSON (JSON.Object o) = do
1285− ExposedPorts <$> HM.foldlWithKey' f (return M.empty) o
1289+data ExposedPort = ExposedPort Port PortType deriving (Eq, Show)
12861290
1291+instance FromJSON [ExposedPort] where
1292+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
12871293 where
12881294 f accM k _ = case T.split (== '/') k of
12891295 [port', portType'] -> do
12901296 port <- parseIntegerText port'
12911297 portType <- parseJSON $ JSON.String portType'
12921298 acc <- accM
1293− return $ M.insert port portType acc
1294− _ ->
1295− fail "Could not parse ExposedPorts"
1296− parseJSON _ = fail "ExposedPorts is not an object."
1297−
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)]
1299+ return $ (ExposedPort port portType):acc
1300+ _ -> fail "Could not parse ExposedPorts"
1301+ parseJSON (JSON.Null) = return []
1302+ parseJSON _ = fail "ExposedPorts is not an object"
13001303
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)
13011309
13021310data ContainerConfig = ContainerConfig {
13031311 hostname :: Maybe Text
@@ -1306,7 +1314,7 @@ data ContainerConfig = ContainerConfig {
13061314 , attachStdin :: Bool
13071315 , attachStdout :: Bool
13081316 , attachStderr :: Bool
1309− , exposedPorts :: Maybe ExposedPorts -- Note: Should we expand the JSON instance and take away the Maybe?
1317+ , exposedPorts :: [ExposedPort]
13101318 -- , publishService :: Text -- Don't see this in 1.24
13111319 , tty :: Bool
13121320 , openStdin :: Bool
@@ -1330,8 +1338,32 @@ instance ToJSON ContainerConfig where
13301338 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
13311339
13321340instance FromJSON ContainerConfig where
1333− parseJSON = genericParseJSON defaultOptions {
1334− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1341+ parseJSON (JSON.Object o) = do
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 []
1351+ tty <- o .: "Tty"
1352+ openStdin <- o .: "OpenStdin"
1353+ stdinOnce <- o .: "StdinOnce"
1354+ env <- o .: "Env"
1355+ cmd <- o .: "Cmd"
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."
13351367
13361368parseIntegerText :: (Monad m) => Text -> m Integer
13371369parseIntegerText t = case readMaybe $ T.unpack t of