on af843a1 help sign in
5 files changed+411−18
since splitsnapshots
unifiedsplit
src/Docker/Client/Api.hs+24 src/Docker/Client/Http.hs+25 src/Docker/Client/Internal.hs+23−13 src/Docker/Client/Types.hs+279−4 tests/tests.hs+60−1
src/Docker/Client/Api.hs+24
@@ -24,6 +24,11 @@ module Docker.Client.Api (
2424 -- * Network
2525 , createNetwork
2626 , removeNetwork
27+ , listNetworks
28+ , inspectNetwork
29+ , connectNetwork
30+ , disconnectNetwork
31+ , pruneNetworks
2732 -- * Other
2833 , getDockerVersion
2934 ) where
@@ -225,3 +230,22 @@ createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseR
225230removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())
226231removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid
227232
233+-- | Lists networks optionally matching a list of 'NetworkFilter's.
234+listNetworks :: forall m . (MonadIO m, MonadMask m) => NetworkFilter -> DockerT m (Either DockerError [NetworkDetails])
235+listNetworks nfs = requestHelper GET (ListNetworksEndpoint nfs) >>= parseResponse
236+
237+-- | Gets 'NetworkDetails' for a network, given its name or id.
238+inspectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError NetworkDetails)
239+inspectNetwork nid = requestHelper GET (InspectNetworkEndpoint nid) >>= parseResponse
240+
241+-- | Connects a container to a network.
242+connectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> ConnectConfig -> DockerT m (Either DockerError ())
243+connectNetwork nid cfg = requestUnit POST $ ConnectNetworkEndpoint nid cfg
244+
245+-- | Disconnects a container from a network.
246+disconnectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DisconnectConfig -> DockerT m (Either DockerError ())
247+disconnectNetwork nid cfg = requestUnit POST $ DisconnectNetworkEndpoint nid cfg
248+
249+-- | Remove unused networks
250+pruneNetworks :: forall m . (MonadIO m, MonadMask m) => PruneFilter -> DockerT m (Either DockerError NetworksDeleted)
251+pruneNetworks pfs = requestHelper POST (PruneNetworksEndpoint pfs) >>= parseResponse
src/Docker/Client/Http.hs+25
@@ -288,3 +288,28 @@ statusCodeToError (RemoveNetworkEndpoint _) st =
288288 Nothing
289289 else
290290 Just $ DockerInvalidStatusCode st
291+statusCodeToError (ListNetworksEndpoint _) st =
292+ if st == status200 then
293+ Nothing
294+ else
295+ Just $ DockerInvalidStatusCode st
296+statusCodeToError (InspectNetworkEndpoint _) st =
297+ if st == status200 then
298+ Nothing
299+ else
300+ Just $ DockerInvalidStatusCode st
301+statusCodeToError (ConnectNetworkEndpoint _ _) st =
302+ if st == status200 then
303+ Nothing
304+ else
305+ Just $ DockerInvalidStatusCode st
306+statusCodeToError (DisconnectNetworkEndpoint _ _) st =
307+ if st == status200 then
308+ Nothing
309+ else
310+ Just $ DockerInvalidStatusCode st
311+statusCodeToError (PruneNetworksEndpoint _) st =
312+ if st == status200 then
313+ Nothing
314+ else
315+ Just $ DockerInvalidStatusCode st
src/Docker/Client/Internal.hs+23−13
@@ -1,17 +1,18 @@
11module Docker.Client.Internal where
22
3−import Blaze.ByteString.Builder (toByteString)
4−import qualified Data.Aeson as JSON
5−import Data.ByteString (ByteString)
6−import qualified Data.ByteString.Char8 as BSC
7−import qualified Data.Conduit.Binary as CB
8−import qualified Data.Text as T
9−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
10−import qualified Network.HTTP.Client as HTTP
11−import Network.HTTP.Conduit (requestBodySourceChunked)
12−import Network.HTTP.Types (Query, encodePath,
13− encodePathSegments)
14−import Prelude hiding (all)
3+import Blaze.ByteString.Builder (toByteString)
4+import qualified Data.Aeson as JSON
5+import Data.ByteString (ByteString)
6+import qualified Data.ByteString.Char8 as BSC
7+import qualified Data.ByteString.Lazy.Char8 as BSLC
8+import qualified Data.Conduit.Binary as CB
9+import qualified Data.Text as T
10+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
11+import qualified Network.HTTP.Client as HTTP
12+import Network.HTTP.Conduit (requestBodySourceChunked)
13+import Network.HTTP.Types (Query, encodePath,
14+ encodePathSegments)
15+import Prelude hiding (all)
1516
1617import Docker.Client.Types
1718
@@ -78,6 +79,11 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images"
7879getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid]
7980getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"]
8081getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
82+getEndpoint v (ListNetworksEndpoint nf) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nf)]
83+getEndpoint v (InspectNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
84+getEndpoint v (ConnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "connect"]
85+getEndpoint v (DisconnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "disconnect"]
86+getEndpoint v (PruneNetworksEndpoint pf) = encodeURLWithQuery [v, "networks", "prune"] [("filters", Just . BSLC.toStrict $ JSON.encode pf)]
8187
8288getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
8389getEndpointRequestBody VersionEndpoint = Nothing
@@ -101,8 +107,12 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing
101107
102108getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)
103109getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing
110+getEndpointRequestBody (ListNetworksEndpoint _) = Nothing
111+getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing
112+getEndpointRequestBody (ConnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)
113+getEndpointRequestBody (DisconnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)
114+getEndpointRequestBody (PruneNetworksEndpoint _) = Nothing
104115
105116getEndpointContentType :: Endpoint -> BSC.ByteString
106117getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
107118getEndpointContentType _ = BSC.pack "application/json; charset=utf-8"
108−
src/Docker/Client/Types.hs+279−4
@@ -76,6 +76,28 @@ module Docker.Client.Types (
7676 , HostConfig(..)
7777 , defaultHostConfig
7878 , NetworkingConfig(..)
79+ , NetworkScope(..)
80+ , CIDR(..)
81+ , IPAMDriver(..)
82+ , IPAMConfig(..)
83+ , IPAM(..)
84+ , NetworkContainer(..)
85+ , NetworkDetails(..)
86+ , NetworkType(..)
87+ , NetworkName
88+ , NetworkFilter(..)
89+ , defaultNetworkFilter
90+ , ConnectConfig(..)
91+ , defaultConnectConfig
92+ , DisconnectConfig(..)
93+ , defaultDisconnectConfig
94+ , PruneFilter(..)
95+ , defaultPruneFilter
96+ , NetworksDeleted(..)
97+ , EndpointSettings(..)
98+ , defaultEndpointSettings
99+ , IPAMSettings(..)
100+ , defaultIPAMSettings
79101 , EndpointConfig(..)
80102 , Ulimit(..)
81103 , ContainerResources(..)
@@ -100,6 +122,7 @@ module Docker.Client.Types (
100122 , MemoryConstraintSize(..)
101123 ) where
102124
125+import Control.Monad (join)
103126import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
104127 genericToJSON, object, parseJSON, toJSON,
105128 (.!=), (.:), (.:?), (.=))
@@ -107,6 +130,7 @@ import qualified Data.Aeson as JSON
107130import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
108131import Data.Char (isAlphaNum, toUpper)
109132import qualified Data.HashMap.Strict as HM
133+import Data.Maybe (maybeToList, catMaybes)
110134import Data.Monoid ((<>))
111135import Data.Scientific (floatingOrInteger)
112136import Data.Text (Text)
@@ -114,6 +138,7 @@ import qualified Data.Text as T
114138import Data.Time.Clock (UTCTime)
115139import qualified Data.Vector as V
116140import GHC.Generics (Generic)
141+import Numeric (readDec)
117142import Prelude hiding (all, tail)
118143import Text.Read (readMaybe)
119144
@@ -139,6 +164,11 @@ data Endpoint =
139164 | DeleteImageEndpoint ImageDeleteOpts ImageID
140165 | CreateNetworkEndpoint CreateNetworkOpts
141166 | RemoveNetworkEndpoint NetworkID
167+ | ListNetworksEndpoint NetworkFilter
168+ | InspectNetworkEndpoint NetworkID
169+ | ConnectNetworkEndpoint NetworkID ConnectConfig
170+ | DisconnectNetworkEndpoint NetworkID DisconnectConfig
171+ | PruneNetworksEndpoint PruneFilter
142172 deriving (Eq, Show)
143173
144174-- | We should newtype this
@@ -858,6 +888,248 @@ instance ToJSON CreateNetworkOpts where
858888 , "EnableIPv6" .= createNetworkEnableIPv6 opts
859889 ]
860890
891+data NetworkScope = LocalScope | GlobalScope | SwarmScope deriving (Eq, Show)
892+
893+fromNetworkScope :: NetworkScope -> Text
894+fromNetworkScope LocalScope = "local"
895+fromNetworkScope GlobalScope = "global"
896+fromNetworkScope SwarmScope = "swarm"
897+
898+instance ToJSON NetworkScope where
899+ toJSON = JSON.String . fromNetworkScope
900+
901+instance FromJSON NetworkScope where
902+ parseJSON "local" = return LocalScope
903+ parseJSON "global" = return GlobalScope
904+ parseJSON "swarm" = return SwarmScope
905+ parseJSON _ = fail "Failed to parse NetworkScope"
906+
907+data CIDR = CIDR Text Int deriving (Eq, Show)
908+
909+instance FromJSON CIDR where
910+ parseJSON (JSON.String t) = case T.splitOn "/" t of
911+ [a,p] -> CIDR a <$> parsePrefixLen p
912+ _ -> fail "Failed to parse CIDR"
913+ where
914+ parsePrefixLen p = case readDec (T.unpack p) of
915+ (n,""):_ -> return n
916+ _ -> fail "Failed to parse CIDR prefix length"
917+ parseJSON _ = fail "Failed to parse CIDR"
918+
919+data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show)
920+
921+instance FromJSON IPAMDriver where
922+ parseJSON (JSON.String "default") = return DefaultIPAMDriver
923+ parseJSON (JSON.String t) = return $ NamedIPAMDriver t
924+ parseJSON _ = fail "IPAMDriver is not a string"
925+
926+data IPAMConfig = IPAMConfig
927+ { ipamConfigSubnet :: CIDR
928+ , ipamConfigIPRange :: Maybe CIDR
929+ , ipamSubnetGateway :: Maybe Text
930+ , ipamConfigAuxAddress :: Maybe Text
931+ } deriving (Eq, Show)
932+
933+instance FromJSON IPAMConfig where
934+ parseJSON (JSON.Object o) = IPAMConfig
935+ <$> o .: "Subnet"
936+ <*> o .:? "IPRange"
937+ <*> o .:? "Gateway"
938+ <*> o .:? "AuxAddress"
939+ parseJSON _ = fail "IPAMConfig is not an object"
940+
941+data IPAM = IPAM
942+ { ipamDriver :: IPAMDriver
943+ , ipamConfig :: [IPAMConfig]
944+ , ipamOptions :: HM.HashMap Text Text
945+ } deriving (Eq, Show)
946+
947+instance FromJSON IPAM where
948+ parseJSON (JSON.Object o) = IPAM
949+ <$> o .:? "Driver" .!= DefaultIPAMDriver
950+ <*> o .:? "Config" .!= []
951+ <*> o .:? "Options" .!= HM.empty
952+ parseJSON _ = fail "IPAM is not an object"
953+
954+data NetworkContainer = NetworkContainer
955+ { networkContainerName :: ContainerName
956+ , networkContainerEndpointID :: Text
957+ , networkContainerMacAddress :: Text
958+ , networkContainerIPv4Address :: Text
959+ , networkContainerIPv6Address :: Text
960+ } deriving (Eq, Show)
961+
962+instance FromJSON NetworkContainer where
963+ parseJSON (JSON.Object o) = NetworkContainer
964+ <$> o .: "Name"
965+ <*> o .: "EndpointID"
966+ <*> o .: "MacAddress"
967+ <*> o .: "IPv4Address"
968+ <*> o .: "IPv6Address"
969+ parseJSON _ = fail "NetworkContainer is not an object"
970+
971+data NetworkDetails = NetworkDetails
972+ { networkDetailsName :: Text
973+ , networkDetailsID :: NetworkID
974+ , networkDetailsCreated :: UTCTime
975+ , networkDetailsScope :: NetworkScope
976+ , networkDetailsDriver :: NetworkMode
977+ , networkDetailsEnableIPv6 :: Bool
978+ , networkDetailsInternal :: Bool
979+ , networkDetailsAttachable :: Bool
980+ , networkDetailsIngress :: Bool
981+ , networkDetailsIPAM :: IPAM
982+ , networkDetailsOptions :: HM.HashMap Text Text
983+ , networkDetailsLabels :: HM.HashMap Text Text
984+ , networkDetailsContainers :: HM.HashMap Text NetworkContainer
985+ } deriving (Eq, Show)
986+
987+instance FromJSON NetworkDetails where
988+ parseJSON v@(JSON.Object o) = NetworkDetails
989+ <$> o .: "Name"
990+ <*> parseJSON v
991+ <*> o .: "Created"
992+ <*> o .: "Scope"
993+ <*> o .: "Driver"
994+ <*> o .: "EnableIPv6"
995+ <*> o .: "Internal"
996+ <*> o .: "Attachable"
997+ <*> o .: "Ingress"
998+ <*> o .: "IPAM"
999+ <*> o .:? "Options" .!= HM.empty
1000+ <*> o .:? "Labels" .!= HM.empty
1001+ <*> o .:? "Containers" .!= HM.empty
1002+ parseJSON _ = fail "NetworkDetails is not an object"
1003+
1004+data NetworkType = BuiltinNetwork | CustomNetwork deriving (Eq, Show)
1005+
1006+fromNetworkType :: NetworkType -> Text
1007+fromNetworkType BuiltinNetwork = "builtin"
1008+fromNetworkType CustomNetwork = "custom"
1009+
1010+type NetworkName = Text
1011+
1012+instance ToJSON NetworkType where
1013+ toJSON = JSON.String . fromNetworkType
1014+
1015+instance FromJSON NetworkType where
1016+ parseJSON (JSON.String "builtin") = return BuiltinNetwork
1017+ parseJSON (JSON.String "custom") = return CustomNetwork
1018+ parseJSON _ = fail "Failed to parse NetworkType"
1019+
1020+data NetworkFilter = NetworkFilter
1021+ { networkFilterNames :: [Text]
1022+ , networkFilterIDs :: [NetworkID]
1023+ , networkFilterDrivers :: [NetworkMode]
1024+ , networkFilterScopes :: [NetworkScope]
1025+ , networkFilterTypes :: [NetworkType]
1026+ , networkFilterLabels :: [(Text, (Maybe Text))]
1027+ } deriving (Eq, Show)
1028+
1029+instance ToJSON NetworkFilter where
1030+ toJSON nf = object . catMaybes $
1031+ [ "name" .=? networkFilterNames nf
1032+ , "id" .=? (fromNetworkID <$> networkFilterIDs nf)
1033+ , "driver" .=? (fromNetworkMode <$> networkFilterDrivers nf)
1034+ , "scope" .=? (fromNetworkScope <$> networkFilterScopes nf)
1035+ , "type" .=? (fromNetworkType <$> networkFilterTypes nf)
1036+ , "label" .=? (constructLabel <$> networkFilterLabels nf)
1037+ ]
1038+ where
1039+ _ .=? [] = Nothing
1040+ k .=? l = Just $ k .= l
1041+
1042+constructLabel :: (Text, Maybe Text) -> Text
1043+constructLabel (k, Just v) = T.concat [k, "=", v]
1044+constructLabel (k, Nothing) = k
1045+
1046+defaultNetworkFilter :: NetworkFilter
1047+defaultNetworkFilter = NetworkFilter [] [] [] [] [] []
1048+
1049+data ConnectConfig = ConnectConfig
1050+ { connectContainer :: Text
1051+ , connectEndpointConfig :: EndpointSettings
1052+ } deriving (Eq, Show, Generic)
1053+
1054+instance ToJSON ConnectConfig where
1055+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 7 }
1056+
1057+defaultConnectConfig :: Text -> ConnectConfig
1058+defaultConnectConfig = flip ConnectConfig defaultEndpointSettings
1059+
1060+data DisconnectConfig = DisconnectConfig
1061+ { disconnectContainer :: Text
1062+ , disconnectForce :: Bool
1063+ } deriving (Eq, Show, Generic)
1064+
1065+instance ToJSON DisconnectConfig where
1066+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 10 }
1067+
1068+defaultDisconnectConfig :: Text -> DisconnectConfig
1069+defaultDisconnectConfig = flip DisconnectConfig False
1070+
1071+data PruneFilter = PruneFilter
1072+ { pruneFilterUntil :: Maybe Text
1073+ -- ^ Can be a Unix timestamp, a date-formatted timestamp, or a duration,
1074+ -- such as @10m@ or @1h30m@.
1075+ , pruneFilterIncludeLabels :: [(Text, (Maybe Text))]
1076+ , pruneFilterExcludeLabels :: [(Text, (Maybe Text))]
1077+ } deriving (Eq, Show)
1078+
1079+instance ToJSON PruneFilter where
1080+ toJSON pf = object . catMaybes $
1081+ [ "until" .=? maybeToList (pruneFilterUntil pf)
1082+ , "label" .=? (constructLabel <$> pruneFilterIncludeLabels pf)
1083+ , "label!" .=? (constructLabel <$> pruneFilterExcludeLabels pf)
1084+ ]
1085+ where
1086+ _ .=? [] = Nothing
1087+ k .=? l = Just $ k .= l
1088+
1089+defaultPruneFilter :: PruneFilter
1090+defaultPruneFilter = PruneFilter Nothing [] []
1091+
1092+newtype NetworksDeleted = NetworksDeleted [Text]
1093+ deriving (Eq, Show)
1094+
1095+instance FromJSON NetworksDeleted where
1096+ parseJSON (JSON.Object o) =
1097+ NetworksDeleted . join . maybeToList <$> o .: "NetworksDeleted"
1098+ parseJSON _ = fail $ "NetworksDeleted is not an object"
1099+
1100+data EndpointSettings = EndpointSettings
1101+ { endpointIPAMConfig :: IPAMSettings
1102+ , endpointLinks :: [Text]
1103+ , endpointAliases :: [Text]
1104+ , endpointNetworkID :: Maybe Text
1105+ , endpointEndpointID :: Maybe Text
1106+ , endpointGateway :: Maybe Text
1107+ , endpointIPAddress :: Maybe Text
1108+ , endpointIPPrefixLen :: Maybe Int
1109+ , endpointIPv6Gateway :: Maybe Text
1110+ , endpointGlobalIPv6Address :: Maybe Text
1111+ , endpointGlobalIPv6PrefixLen :: Maybe Int
1112+ , endpointMacAddress :: Maybe Text
1113+ } deriving (Eq, Show, Generic)
1114+
1115+instance ToJSON EndpointSettings where
1116+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 8 }
1117+
1118+defaultEndpointSettings :: EndpointSettings
1119+defaultEndpointSettings = EndpointSettings defaultIPAMSettings [] [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1120+
1121+data IPAMSettings = IPAMSettings
1122+ { ipamIPv4Address :: Maybe Text
1123+ , ipamIPv6Address :: Maybe Text
1124+ , ipamLinkLocalIPs :: [Text]
1125+ } deriving (Eq, Show, Generic)
1126+
1127+instance ToJSON IPAMSettings where
1128+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 4 }
1129+
1130+defaultIPAMSettings :: IPAMSettings
1131+defaultIPAMSettings = IPAMSettings Nothing Nothing []
1132+
8611133-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
8621134-- | Set permissions on volumes that you mount in the container.
8631135data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
@@ -1027,11 +1299,14 @@ instance FromJSON NetworkMode where
10271299 parseJSON (JSON.String n) = return $ NetworkNamed n
10281300 parseJSON _ = fail "Unknown NetworkMode"
10291301
1302+fromNetworkMode :: NetworkMode -> Text
1303+fromNetworkMode NetworkBridge = "bridge"
1304+fromNetworkMode NetworkHost = "host"
1305+fromNetworkMode NetworkDisabled = "none"
1306+fromNetworkMode (NetworkNamed n) = n
1307+
10301308instance ToJSON NetworkMode where
1031− toJSON NetworkBridge = JSON.String "bridge"
1032− toJSON NetworkHost = JSON.String "host"
1033− toJSON NetworkDisabled = JSON.String "none"
1034− toJSON (NetworkNamed n) = JSON.String n
1309+ toJSON = JSON.String . fromNetworkMode
10351310
10361311newtype NetworkID = NetworkID Text
10371312 deriving (Eq, Show)
tests/tests.hs+60−1
@@ -11,7 +11,7 @@ import Test.Tasty.QuickCheck (testProperty)
1111
1212import Control.Concurrent (threadDelay)
1313import Control.Lens ((^.), (^?))
14−import Control.Monad (forM_)
14+import Control.Monad (forM_, when, (<=<))
1515import Control.Monad.IO.Class
1616import Control.Monad.Trans.Class (lift)
1717import qualified Data.Aeson as JSON
@@ -23,6 +23,7 @@ import qualified Data.ByteString.Char8 as C
2323import qualified Data.ByteString.Lazy as BL
2424import qualified Data.HashMap.Strict as HM
2525import Data.Int (Int)
26+import Data.List ((\\))
2627import qualified Data.Map as M
2728import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)
2829import Data.Monoid
@@ -144,6 +145,48 @@ testCreateRemoveNetwork = do
144145 removeStatus <- removeNetwork nid
145146 lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus
146147
148+testListNetworks :: IO ()
149+testListNetworks =
150+ runDocker $ do
151+ res <- listNetworks defaultNetworkFilter {networkFilterNames = ["bridge"]}
152+ lift $ case res of
153+ Left _ -> assertFailure $ "listing networks, unexpected status: " ++ show res
154+ Right (d:_) -> assertBool "listing networks, bridge network missing" $ networkDetailsName d == "bridge"
155+
156+testInspectNetwork :: IO ()
157+testInspectNetwork =
158+ runDocker $ do
159+ res <- inspectNetwork . fromJust $ toNetworkID "bridge"
160+ lift $ assertBool ("inspecting networks, unexpected status: " ++ show res) $ isRight res
161+
162+testConnectNetwork :: IO ()
163+testConnectNetwork =
164+ runDocker $ do
165+ containerId <- fromRight =<< createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
166+ networkId <- fromRight =<< createNetwork (defaultCreateNetworkOpts "mynetwork")
167+ res <- connectNetwork networkId . defaultConnectConfig $ fromContainerID containerId
168+ lift $ assertBool ("connecting network, unexpected status: " ++ show res) $ isRight res
169+ details <- fromRight =<< inspectContainer containerId
170+ _ <- deleteContainer defaultContainerDeleteOpts containerId
171+ _ <- removeNetwork networkId
172+ let networks = networkMode <$> (networkSettingsNetworks . networkSettings) details
173+ lift $ assertBool "connecting network failed" $ NetworkNamed "mynetwork" `elem` networks
174+ where
175+ networkMode (Network mode _) = mode
176+
177+testDisconnectNetwork :: IO ()
178+testDisconnectNetwork =
179+ runDocker $ do
180+ containerId <- fromRight =<< createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
181+ res <- disconnectNetwork (fromJust $ toNetworkID "bridge") (defaultDisconnectConfig $ fromContainerID containerId)
182+ lift $ assertBool ("disconnecting network, unexpected status: " ++ show res) $ isRight res
183+ details <- fromRight =<< inspectContainer containerId
184+ _ <- deleteContainer defaultContainerDeleteOpts containerId
185+ let networks = networkMode <$> (networkSettingsNetworks . networkSettings) details
186+ lift $ assertBool "disconnecting network failed" $ null networks
187+ where
188+ networkMode (Network mode _) = mode
189+
147190testLogDriverOptionsJson :: TestTree
148191testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
149192 where
@@ -236,6 +279,17 @@ testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSample
236279 ]
237280 ]
238281
282+testDisconnectConfigJson :: TestTree
283+testDisconnectConfigJson = testGroup "Testing DisconnectConfig JSON" [testSampleEncode]
284+ where
285+ testSampleEncode =
286+ let config = DisconnectConfig "mycontainer" True
287+ in testCase "Test toJSON" $ assert $ JSON.toJSON config ==
288+ JSON.object
289+ [ "Container" .= ("mycontainer" :: Text)
290+ , "Force" .= True
291+ ]
292+
239293integrationTests :: TestTree
240294integrationTests =
241295 testGroup
@@ -249,6 +303,10 @@ integrationTests =
249303 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
250304 , testCase "Try to stop a container that doesn't exist" testStopNonexisting
251305 , testCase "Create and remove a network" testCreateRemoveNetwork
306+ , testCase "List networks" testListNetworks
307+ , testCase "Inspect a network" testInspectNetwork
308+ , testCase "Connect a container to a network" testConnectNetwork
309+ , testCase "Disconnect a container from a network" testDisconnectNetwork
252310 ]
253311
254312jsonTests :: TestTree
@@ -262,6 +320,7 @@ jsonTests =
262320 , testEntrypointJson
263321 , testEnvVarJson
264322 , testNetworkingConfigJson
323+ , testDisconnectConfigJson
265324 ]
266325
267326setup :: IO ()