git.iko.soy/docker-hs
on master help sign in
Add disconnectNetwork endpoint
commit1147188a30c8478eec76a79933651c6fe28c64d7 authorBen Hamlin <protob3n@gmail.com> dateFri 5 Jul 2019, 21:18 (7 years ago) parent926a5cb
5 files changed+52
compare with master
unifiedsplit
src/Docker/Client/Api.hs+5 src/Docker/Client/Http.hs+5 src/Docker/Client/Internal.hs+2 src/Docker/Client/Types.hs+14 tests/tests.hs+26
src/Docker/Client/Api.hs+5
@@ -27,6 +27,7 @@ module Docker.Client.Api (
2727 , listNetworks
2828 , inspectNetwork
2929 , connectNetwork
30+ , disconnectNetwork
3031 -- * Other
3132 , getDockerVersion
3233 ) where
@@ -239,3 +240,7 @@ inspectNetwork nid = requestHelper GET (InspectNetworkEndpoint nid) >>= parseRes
239240-- | Connects a container to a network.
240241connectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> ConnectConfig -> DockerT m (Either DockerError ())
241242connectNetwork nid cfg = requestUnit POST $ ConnectNetworkEndpoint nid cfg
243+
244+-- | Disconnects a container from a network.
245+disconnectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DisconnectConfig -> DockerT m (Either DockerError ())
246+disconnectNetwork nid cfg = requestUnit POST $ DisconnectNetworkEndpoint nid cfg
src/Docker/Client/Http.hs+5
@@ -303,3 +303,8 @@ statusCodeToError (ConnectNetworkEndpoint _ _) st =
303303 Nothing
304304 else
305305 Just $ DockerInvalidStatusCode st
306+statusCodeToError (DisconnectNetworkEndpoint _ _) st =
307+ if st == status200 then
308+ Nothing
309+ else
310+ Just $ DockerInvalidStatusCode st
src/Docker/Client/Internal.hs+2
@@ -82,6 +82,7 @@ getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetwor
8282getEndpoint v (ListNetworksEndpoint nfs) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nfs)]
8383getEndpoint v (InspectNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
8484getEndpoint v (ConnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "connect"]
85+getEndpoint v (DisconnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "disconnect"]
8586
8687getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
8788getEndpointRequestBody VersionEndpoint = Nothing
@@ -108,6 +109,7 @@ getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing
108109getEndpointRequestBody (ListNetworksEndpoint _) = Nothing
109110getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing
110111getEndpointRequestBody (ConnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)
112+getEndpointRequestBody (DisconnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)
111113
112114getEndpointContentType :: Endpoint -> BSC.ByteString
113115getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
src/Docker/Client/Types.hs+14
@@ -88,6 +88,8 @@ module Docker.Client.Types (
8888 , NetworkFilter(..)
8989 , ConnectConfig(..)
9090 , defaultConnectConfig
91+ , DisconnectConfig(..)
92+ , defaultDisconnectConfig
9193 , EndpointSettings(..)
9294 , defaultEndpointSettings
9395 , IPAMSettings(..)
@@ -159,6 +161,7 @@ data Endpoint =
159161 | ListNetworksEndpoint [NetworkFilter]
160162 | InspectNetworkEndpoint NetworkID
161163 | ConnectNetworkEndpoint NetworkID ConnectConfig
164+ | DisconnectNetworkEndpoint NetworkID DisconnectConfig
162165 deriving (Eq, Show)
163166
164167-- | We should newtype this
@@ -1037,6 +1040,17 @@ instance ToJSON ConnectConfig where
10371040defaultConnectConfig :: Text -> ConnectConfig
10381041defaultConnectConfig = flip ConnectConfig defaultEndpointSettings
10391042
1043+data DisconnectConfig = DisconnectConfig
1044+ { disconnectContainer :: Text
1045+ , disconnectForce :: Bool
1046+ } deriving (Eq, Show, Generic)
1047+
1048+instance ToJSON DisconnectConfig where
1049+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 10 }
1050+
1051+defaultDisconnectConfig :: Text -> DisconnectConfig
1052+defaultDisconnectConfig = flip DisconnectConfig False
1053+
10401054data EndpointSettings = EndpointSettings
10411055 { endpointIPAMConfig :: IPAMSettings
10421056 , endpointLinks :: [Text]
tests/tests.hs+26
@@ -173,6 +173,19 @@ testConnectNetwork =
173173 where
174174 networkMode (Network mode _) = mode
175175
176+testDisconnectNetwork :: IO ()
177+testDisconnectNetwork =
178+ runDocker $ do
179+ containerId <- fromRight =<< createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
180+ res <- disconnectNetwork (fromJust $ toNetworkID "bridge") (defaultDisconnectConfig $ fromContainerID containerId)
181+ lift $ assertBool ("disconnecting network, unexpected status: " ++ show res) $ isRight res
182+ details <- fromRight =<< inspectContainer containerId
183+ _ <- deleteContainer defaultContainerDeleteOpts containerId
184+ let networks = networkMode <$> (networkSettingsNetworks . networkSettings) details
185+ lift $ assertBool "disconnecting network failed" $ null networks
186+ where
187+ networkMode (Network mode _) = mode
188+
176189testLogDriverOptionsJson :: TestTree
177190testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
178191 where
@@ -265,6 +278,17 @@ testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSample
265278 ]
266279 ]
267280
281+testDisconnectConfigJson :: TestTree
282+testDisconnectConfigJson = testGroup "Testing DisconnectConfig JSON" [testSampleEncode]
283+ where
284+ testSampleEncode =
285+ let config = DisconnectConfig "mycontainer" True
286+ in testCase "Test toJSON" $ assert $ JSON.toJSON config ==
287+ JSON.object
288+ [ "Container" .= ("mycontainer" :: Text)
289+ , "Force" .= True
290+ ]
291+
268292integrationTests :: TestTree
269293integrationTests =
270294 testGroup
@@ -281,6 +305,7 @@ integrationTests =
281305 , testCase "List networks" testListNetworks
282306 , testCase "Inspect a network" testInspectNetwork
283307 , testCase "Connect a container to a network" testConnectNetwork
308+ , testCase "Disconnect a container from a network" testDisconnectNetwork
284309 ]
285310
286311jsonTests :: TestTree
@@ -294,6 +319,7 @@ jsonTests =
294319 , testEntrypointJson
295320 , testEnvVarJson
296321 , testNetworkingConfigJson
322+ , testDisconnectConfigJson
297323 ]
298324
299325setup :: IO ()