af843a1 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Improve handling of filters in listNetworks

af843a1Ben Hamlin7 years ago

src/Docker/Client/Api.hs+1−1

compare with master

unifiedsplit

@@ -231,7 +231,7 @@ removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (E

231removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

232

233-- | Lists networks optionally matching a list of 'NetworkFilter's.

234−listNetworks :: forall m . (MonadIO m, MonadMask m) => [NetworkFilter] -> DockerT m (Either DockerError [NetworkDetails])

234+listNetworks :: forall m . (MonadIO m, MonadMask m) => NetworkFilter -> DockerT m (Either DockerError [NetworkDetails])

235listNetworks nfs = requestHelper GET (ListNetworksEndpoint nfs) >>= parseResponse

236

237-- | Gets 'NetworkDetails' for a network, given its name or id.

src/Docker/Client/Internal.hs+1−1

@@ -79,7 +79,7 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images"

79getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid]

80getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"]

81getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]

82−getEndpoint v (ListNetworksEndpoint nfs) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nfs)]

82+getEndpoint v (ListNetworksEndpoint nf) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nf)]

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"]

src/Docker/Client/Types.hs+28−21

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

86 , NetworkType(..)

87 , NetworkName

88 , NetworkFilter(..)

89+ , defaultNetworkFilter

89 , ConnectConfig(..)

90 , ConnectConfig(..)

90 , defaultConnectConfig

91 , defaultConnectConfig

91 , DisconnectConfig(..)

92 , DisconnectConfig(..)

@@ -163,7 +164,7 @@ data Endpoint =

163 | DeleteImageEndpoint ImageDeleteOpts ImageID

164 | DeleteImageEndpoint ImageDeleteOpts ImageID

164 | CreateNetworkEndpoint CreateNetworkOpts

165 | CreateNetworkEndpoint CreateNetworkOpts

165 | RemoveNetworkEndpoint NetworkID

166 | RemoveNetworkEndpoint NetworkID

166− | ListNetworksEndpoint [NetworkFilter]

167+ | ListNetworksEndpoint NetworkFilter

167 | InspectNetworkEndpoint NetworkID

168 | InspectNetworkEndpoint NetworkID

168 | ConnectNetworkEndpoint NetworkID ConnectConfig

169 | ConnectNetworkEndpoint NetworkID ConnectConfig

169 | DisconnectNetworkEndpoint NetworkID DisconnectConfig

170 | DisconnectNetworkEndpoint NetworkID DisconnectConfig

@@ -1016,24 +1017,34 @@ instance FromJSON NetworkType where

1016 parseJSON (JSON.String "custom") = return CustomNetwork

1017 parseJSON (JSON.String "custom") = return CustomNetwork

1017 parseJSON _ = fail "Failed to parse NetworkType"

1018 parseJSON _ = fail "Failed to parse NetworkType"

1018

1019

1019−data NetworkFilter

1020+data NetworkFilter = NetworkFilter

1020− = NetworkFilterName Text

1021+ { networkFilterNames :: [Text]

1021− | NetworkFilterID NetworkID

1022+ , networkFilterIDs :: [NetworkID]

1022− | NetworkFilterLabel Text

1023+ , networkFilterDrivers :: [NetworkMode]

1023− | NetworkFilterDriver NetworkMode

1024+ , networkFilterScopes :: [NetworkScope]

1024− | NetworkFilterScope NetworkScope

1025+ , networkFilterTypes :: [NetworkType]

1025− | NetworkFilterType NetworkType

1026+ , networkFilterLabels :: [(Text, (Maybe Text))]

1026− deriving (Eq, Show)

1027+ } deriving (Eq, Show)

1027

1028

1028−instance {-# OVERLAPPING #-} ToJSON [NetworkFilter] where

1029+instance ToJSON NetworkFilter where

1029− toJSON = object . fmap toKV

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+ ]

1030 where

1038 where

1031− toKV (NetworkFilterName n) = "name" .= [n]

1039+ _ .=? [] = Nothing

1032− toKV (NetworkFilterID i) = "id" .= [fromNetworkID i]

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

1033− toKV (NetworkFilterLabel l) = "label" .= [l]

1041+

1034− toKV (NetworkFilterDriver d) = "driver" .= [fromNetworkMode d]

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

1035− toKV (NetworkFilterScope s) = "scope" .= [fromNetworkScope s]

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

1036− toKV (NetworkFilterType t) = "type" .= [fromNetworkType t]

1044+constructLabel (k, Nothing) = k

1045+

1046+defaultNetworkFilter :: NetworkFilter

1047+defaultNetworkFilter = NetworkFilter [] [] [] [] [] []

1037

1048

1038data ConnectConfig = ConnectConfig

1049data ConnectConfig = ConnectConfig

1039 { connectContainer :: Text

1050 { connectContainer :: Text

@@ -1075,10 +1086,6 @@ instance ToJSON PruneFilter where

1075 _ .=? [] = Nothing

1086 _ .=? [] = Nothing

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

1087 k .=? l = Just $ k .= l

1077

1088

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

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

1080−constructLabel (k, Nothing) = k

1081−

1082defaultPruneFilter :: PruneFilter

1089defaultPruneFilter :: PruneFilter

1083defaultPruneFilter = PruneFilter Nothing [] []

1090defaultPruneFilter = PruneFilter Nothing [] []

1084

1091

tests/tests.hs+1−1

@@ -148,7 +148,7 @@ testCreateRemoveNetwork = do

148testListNetworks :: IO ()

149testListNetworks =

150 runDocker $ do

151− res <- listNetworks [NetworkFilterName "bridge"]

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"