Network endpoints

src/Docker/Client/Api.hs

@@ -24,6 +24,11 @@ module Docker.Client.Api (
     -- * Network
     , createNetwork
     , removeNetwork
+    , listNetworks
+    , inspectNetwork
+    , connectNetwork
+    , disconnectNetwork
+    , pruneNetworks
     -- * Other
     , getDockerVersion
     ) where
@@ -225,3 +230,22 @@ createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts)  >>= parseR
 removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())
 removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid
 
+-- | Lists networks optionally matching a list of 'NetworkFilter's.
+listNetworks :: forall m . (MonadIO m, MonadMask m) => NetworkFilter -> DockerT m (Either DockerError [NetworkDetails])
+listNetworks nfs = requestHelper GET (ListNetworksEndpoint nfs) >>= parseResponse
+
+-- | Gets 'NetworkDetails' for a network, given its name or id.
+inspectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError NetworkDetails)
+inspectNetwork nid = requestHelper GET (InspectNetworkEndpoint nid) >>= parseResponse
+
+-- | Connects a container to a network.
+connectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> ConnectConfig -> DockerT m (Either DockerError ())
+connectNetwork nid cfg = requestUnit POST $ ConnectNetworkEndpoint nid cfg
+
+-- | Disconnects a container from a network.
+disconnectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DisconnectConfig -> DockerT m (Either DockerError ())
+disconnectNetwork nid cfg = requestUnit POST $ DisconnectNetworkEndpoint nid cfg
+
+-- | Remove unused networks
+pruneNetworks :: forall m . (MonadIO m, MonadMask m) => PruneFilter -> DockerT m (Either DockerError NetworksDeleted)
+pruneNetworks pfs = requestHelper POST (PruneNetworksEndpoint pfs) >>= parseResponse

src/Docker/Client/Http.hs

@@ -288,3 +288,28 @@ statusCodeToError (RemoveNetworkEndpoint _) st =
         Nothing
     else
         Just $ DockerInvalidStatusCode st
+statusCodeToError (ListNetworksEndpoint _) st =
+    if st == status200 then
+        Nothing
+    else
+        Just $ DockerInvalidStatusCode st
+statusCodeToError (InspectNetworkEndpoint _) st =
+    if st == status200 then
+        Nothing
+    else
+        Just $ DockerInvalidStatusCode st
+statusCodeToError (ConnectNetworkEndpoint _ _) st =
+    if st == status200 then
+        Nothing
+    else
+        Just $ DockerInvalidStatusCode st
+statusCodeToError (DisconnectNetworkEndpoint _ _) st =
+    if st == status200 then
+        Nothing
+    else
+        Just $ DockerInvalidStatusCode st
+statusCodeToError (PruneNetworksEndpoint _) st =
+    if st == status200 then
+        Nothing
+    else
+        Just $ DockerInvalidStatusCode st

src/Docker/Client/Internal.hs

@@ -1,17 +1,18 @@
 module Docker.Client.Internal where
 
-import           Blaze.ByteString.Builder (toByteString)
-import qualified Data.Aeson               as JSON
-import           Data.ByteString          (ByteString)
-import qualified Data.ByteString.Char8    as BSC
-import qualified Data.Conduit.Binary      as CB
-import qualified Data.Text                as T
-import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
-import qualified Network.HTTP.Client      as HTTP
-import           Network.HTTP.Conduit     (requestBodySourceChunked)
-import           Network.HTTP.Types       (Query, encodePath,
-                                           encodePathSegments)
-import           Prelude                  hiding (all)
+import           Blaze.ByteString.Builder   (toByteString)
+import qualified Data.Aeson                 as JSON
+import           Data.ByteString            (ByteString)
+import qualified Data.ByteString.Char8      as BSC
+import qualified Data.ByteString.Lazy.Char8 as BSLC
+import qualified Data.Conduit.Binary        as CB
+import qualified Data.Text                  as T
+import           Data.Text.Encoding         (decodeUtf8, encodeUtf8)
+import qualified Network.HTTP.Client        as HTTP
+import           Network.HTTP.Conduit       (requestBodySourceChunked)
+import           Network.HTTP.Types         (Query, encodePath,
+                                             encodePathSegments)
+import           Prelude                    hiding (all)
 
 import           Docker.Client.Types
 
@@ -78,6 +79,11 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images"
 getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid]
 getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"]
 getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
+getEndpoint v (ListNetworksEndpoint nf) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nf)]
+getEndpoint v (InspectNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
+getEndpoint v (ConnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "connect"]
+getEndpoint v (DisconnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "disconnect"]
+getEndpoint v (PruneNetworksEndpoint pf) = encodeURLWithQuery [v, "networks", "prune"] [("filters", Just . BSLC.toStrict $ JSON.encode pf)]
 
 getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
 getEndpointRequestBody VersionEndpoint = Nothing
@@ -101,8 +107,12 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing
 
 getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)
 getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing
+getEndpointRequestBody (ListNetworksEndpoint _) = Nothing
+getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing
+getEndpointRequestBody (ConnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)
+getEndpointRequestBody (DisconnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)
+getEndpointRequestBody (PruneNetworksEndpoint _) = Nothing
 
 getEndpointContentType :: Endpoint -> BSC.ByteString
 getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
 getEndpointContentType _ = BSC.pack "application/json; charset=utf-8"
-