b550387 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

Add pruneNetworks endpoint

commitb550387c25d94e9e813266c6ed876b94e8d7c238 authorBen Hamlin <protob3n@gmail.com> dateTue 9 Jul 2019, 13:23 (7 years ago) parent1147188

5 files changed+53−2

compare with master

unifiedsplit

src/Docker/Client/Api.hs+5 src/Docker/Client/Http.hs+5 src/Docker/Client/Internal.hs+2−1 src/Docker/Client/Types.hs+39 tests/tests.hs+2−1

src/Docker/Client/Api.hs+5

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

2828 , inspectNetwork

2929 , connectNetwork

3030 , disconnectNetwork

31+ , pruneNetworks

3132 -- * Other

3233 , getDockerVersion

3334 ) where

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

244245-- | Disconnects a container from a network.

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

246247disconnectNetwork 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 =

308308 Nothing

309309 else

310310 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"] [(

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

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

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

8687

8788getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

8889getEndpointRequestBody VersionEndpoint = Nothing

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

110111getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing

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

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

114+getEndpointRequestBody (PruneNetworksEndpoint _) = Nothing

113115

114116getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

117−

src/Docker/Client/Types.hs+39

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

9090 , defaultConnectConfig

9191 , DisconnectConfig(..)

9292 , defaultDisconnectConfig

93+ , PruneFilter(..)

94+ , defaultPruneFilter

95+ , NetworksDeleted(..)

9396 , EndpointSettings(..)

9497 , defaultEndpointSettings

9598 , IPAMSettings(..)

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

118121 , MemoryConstraintSize(..)

119122 ) where

120123

124+import Control.Monad (join)

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

122126 genericToJSON, object, parseJSON, toJSON,

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

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

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

126130import Data.Char (isAlphaNum, toUpper)

127131import qualified Data.HashMap.Strict as HM

132+import Data.Maybe (maybeToList, catMaybes)

128133import Data.Monoid ((<>))

129134import Data.Scientific (floatingOrInteger)

130135import Data.Text (Text)

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

162167 | InspectNetworkEndpoint NetworkID

163168 | ConnectNetworkEndpoint NetworkID ConnectConfig

164169 | DisconnectNetworkEndpoint NetworkID DisconnectConfig

170+ | PruneNetworksEndpoint PruneFilter

165171 deriving (Eq, Show)

166172

167173-- | We should newtype this

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

10511057defaultDisconnectConfig :: Text -> DisconnectConfig

10521058defaultDisconnectConfig = flip DisconnectConfig False

10531059

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+

10541093data EndpointSettings = EndpointSettings

10551094 { endpointIPAMConfig :: IPAMSettings

10561095 , endpointLinks :: [Text]

tests/tests.hs+2−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