b550387 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Add pruneNetworks endpoint

b550387Ben Hamlin7 years ago

src/Docker/Client/Api.hs+5

compare with master

unifiedsplit

@@ -28,6 +28,7 @@ module Docker.Client.Api (

28 , inspectNetwork

29 , connectNetwork

30 , disconnectNetwork

31+ , pruneNetworks

31 -- * Other

32 -- * Other

32 , getDockerVersion

33 , getDockerVersion

33 ) where

34 ) where

@@ -244,3 +245,7 @@ connectNetwork nid cfg = requestUnit POST $ ConnectNetworkEndpoint nid cfg

244-- | Disconnects a container from a network.

245-- | Disconnects a container from a network.

245disconnectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DisconnectConfig -> DockerT m (Either DockerError ())

246disconnectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DisconnectConfig -> DockerT m (Either DockerError ())

246disconnectNetwork nid cfg = requestUnit POST $ DisconnectNetworkEndpoint nid cfg

247disconnectNetwork 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+5

@@ -308,3 +308,8 @@ statusCodeToError (DisconnectNetworkEndpoint _ _) st =

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+2−1

@@ -83,6 +83,7 @@ getEndpoint v (ListNetworksEndpoint nfs) = encodeURLWithQuery [v, "networks"] [(

83getEndpoint v (InspectNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]

84getEndpoint v (ConnectNetworkEndpoint nid _) = encodeURL [v, "networks", fromNetworkID nid, "connect"]

85getEndpoint 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)]

87getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

88getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

88getEndpointRequestBody VersionEndpoint = Nothing

89getEndpointRequestBody VersionEndpoint = Nothing

@@ -110,8 +111,8 @@ getEndpointRequestBody (ListNetworksEndpoint _) = Nothing

110getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing

111getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing

111getEndpointRequestBody (ConnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)

112getEndpointRequestBody (ConnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)

112getEndpointRequestBody (DisconnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)

113getEndpointRequestBody (DisconnectNetworkEndpoint _ cfg) = Just $ HTTP.RequestBodyLBS (JSON.encode cfg)

114+getEndpointRequestBody (PruneNetworksEndpoint _) = Nothing

113

115

114getEndpointContentType :: Endpoint -> BSC.ByteString

116getEndpointContentType :: Endpoint -> BSC.ByteString

115getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"

117getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"

116getEndpointContentType _ = BSC.pack "application/json; charset=utf-8"

118getEndpointContentType _ = BSC.pack "application/json; charset=utf-8"

117−

src/Docker/Client/Types.hs+39

@@ -90,6 +90,9 @@ module Docker.Client.Types (

90 , defaultConnectConfig

91 , DisconnectConfig(..)

92 , defaultDisconnectConfig

93+ , PruneFilter(..)

94+ , defaultPruneFilter

95+ , NetworksDeleted(..)

93 , EndpointSettings(..)

96 , EndpointSettings(..)

94 , defaultEndpointSettings

97 , defaultEndpointSettings

95 , IPAMSettings(..)

98 , IPAMSettings(..)

@@ -118,6 +121,7 @@ module Docker.Client.Types (

118 , MemoryConstraintSize(..)

121 , MemoryConstraintSize(..)

119 ) where

122 ) where

120

123

124+import Control.Monad (join)

121import Data.Aeson (FromJSON, ToJSON, genericParseJSON,

125import Data.Aeson (FromJSON, ToJSON, genericParseJSON,

122 genericToJSON, object, parseJSON, toJSON,

126 genericToJSON, object, parseJSON, toJSON,

123 (.!=), (.:), (.:?), (.=))

127 (.!=), (.:), (.:?), (.=))

@@ -125,6 +129,7 @@ import qualified Data.Aeson as JSON

125import Data.Aeson.Types (defaultOptions, fieldLabelModifier)

129import Data.Aeson.Types (defaultOptions, fieldLabelModifier)

126import Data.Char (isAlphaNum, toUpper)

130import Data.Char (isAlphaNum, toUpper)

127import qualified Data.HashMap.Strict as HM

131import qualified Data.HashMap.Strict as HM

132+import Data.Maybe (maybeToList, catMaybes)

128import Data.Monoid ((<>))

133import Data.Monoid ((<>))

129import Data.Scientific (floatingOrInteger)

134import Data.Scientific (floatingOrInteger)

130import Data.Text (Text)

135import Data.Text (Text)

@@ -162,6 +167,7 @@ data Endpoint =

162 | InspectNetworkEndpoint NetworkID

167 | InspectNetworkEndpoint NetworkID

163 | ConnectNetworkEndpoint NetworkID ConnectConfig

168 | ConnectNetworkEndpoint NetworkID ConnectConfig

164 | DisconnectNetworkEndpoint NetworkID DisconnectConfig

169 | DisconnectNetworkEndpoint NetworkID DisconnectConfig

170+ | PruneNetworksEndpoint PruneFilter

165 deriving (Eq, Show)

171 deriving (Eq, Show)

166

172

167-- | We should newtype this

173-- | We should newtype this

@@ -1051,6 +1057,39 @@ instance ToJSON DisconnectConfig where

1051defaultDisconnectConfig :: Text -> DisconnectConfig

1057defaultDisconnectConfig :: Text -> DisconnectConfig

1052defaultDisconnectConfig = flip DisconnectConfig False

1058defaultDisconnectConfig = flip DisconnectConfig False

1053

1059

1060+data PruneFilter = PruneFilter

1061+ { pruneFilterUntil :: Maybe Text

1062+ -- ^ Can be a Unix timestamp, a date-formatted timestamp, or a duration,

1063+ -- such as @10m@ or @1h30m@.

1064+ , pruneFilterIncludeLabels :: [(Text, (Maybe Text))]

1065+ , pruneFilterExcludeLabels :: [(Text, (Maybe Text))]

1066+ } deriving (Eq, Show)

1067+

1068+instance ToJSON PruneFilter where

1069+ toJSON pf = object . catMaybes $

1070+ [ "until" .=? maybeToList (pruneFilterUntil pf)

1071+ , "label" .=? (constructLabel <$> pruneFilterIncludeLabels pf)

1072+ , "label!" .=? (constructLabel <$> pruneFilterExcludeLabels pf)

1073+ ]

1074+ where

1075+ _ .=? [] = Nothing

1076+ k .=? l = Just $ k .= l

1077+

1078+constructLabel :: (Text, Maybe Text) -> Text

1079+constructLabel (k, Just v) = T.concat [k, "=", v]

1080+constructLabel (k, Nothing) = k

1081+

1082+defaultPruneFilter :: PruneFilter

1083+defaultPruneFilter = PruneFilter Nothing [] []

1084+

1085+newtype NetworksDeleted = NetworksDeleted [Text]

1086+ deriving (Eq, Show)

1087+

1088+instance FromJSON NetworksDeleted where

1089+ parseJSON (JSON.Object o) =

1090+ NetworksDeleted . join . maybeToList <$> o .: "NetworksDeleted"

1091+ parseJSON _ = fail $ "NetworksDeleted is not an object"

1092+

1054data EndpointSettings = EndpointSettings

1093data EndpointSettings = EndpointSettings

1055 { endpointIPAMConfig :: IPAMSettings

1094 { endpointIPAMConfig :: IPAMSettings

1056 , endpointLinks :: [Text]

1095 , endpointLinks :: [Text]

tests/tests.hs+2−1

@@ -11,7 +11,7 @@ import Test.Tasty.QuickCheck (testProperty)

12import Control.Concurrent (threadDelay)

13import Control.Lens ((^.), (^?))

14−import Control.Monad (forM_)

14+import Control.Monad (forM_, when, (<=<))

15import Control.Monad.IO.Class

16import Control.Monad.Trans.Class (lift)

17import qualified Data.Aeson as JSON

@@ -23,6 +23,7 @@ import qualified Data.ByteString.Char8 as C

23import qualified Data.ByteString.Lazy as BL

24import qualified Data.HashMap.Strict as HM

25import Data.Int (Int)

26+import Data.List ((\\))

26import qualified Data.Map as M

27import qualified Data.Map as M

27import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)

28import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)

28import Data.Monoid

29import Data.Monoid