on master help sign in
Add the rest of the fields through AVI version 1.29 to 'CreateNetworkOpts'
commit2da7b4eff6ca53c5daabad275b853b21904b0026 authorBen Hamlin <protob3n@gmail.com> dateTue 9 Jul 2019, 16:37 (7 years ago) parentaf843a1
2 files changed+62−23
src/Docker/Client/Types.hs+46−23 tests/tests.hs+16
src/Docker/Client/Types.hs+46−23
@@ -81,6 +81,7 @@ module Docker.Client.Types (
8181 , IPAMDriver(..)
8282 , IPAMConfig(..)
8383 , IPAM(..)
84+ , defaultIPAM
8485 , NetworkContainer(..)
8586 , NetworkDetails(..)
8687 , NetworkType(..)
@@ -127,7 +128,7 @@ import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
127128 genericToJSON, object, parseJSON, toJSON,
128129 (.!=), (.:), (.:?), (.=))
129130import qualified Data.Aeson as JSON
130−import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
131+import Data.Aeson.Types (defaultOptions, fieldLabelModifier, omitNothingFields)
131132import Data.Char (isAlphaNum, toUpper)
132133import qualified Data.HashMap.Strict as HM
133134import Data.Maybe (maybeToList, catMaybes)
@@ -860,12 +861,17 @@ defaultLogOpts = LogOpts { stdout = True
860861
861862-- | Options for creating a network
862863data CreateNetworkOpts = CreateNetworkOpts
863− { createNetworkName :: Text -- ^ The network's name
864− , createNetworkCheckDuplicate :: Bool -- ^ Check for networks with duplicate names.
865− , createNetworkDriver :: Text -- ^ Name of the network driver plugin to use.
866− , createNetworkInternal :: Bool -- ^ Restrict external access to the network.
867− , createNetworkEnableIPv6 :: Bool -- ^ Enable IPv6 on the network.
868− } deriving (Eq, Show)
864+ { createNetworkName :: Text -- ^ The network's name
865+ , createNetworkCheckDuplicate :: Bool -- ^ Check for networks with duplicate names.
866+ , createNetworkDriver :: NetworkMode -- ^ Name of the network driver plugin to use.
867+ , createNetworkInternal :: Bool -- ^ Restrict external access to the network.
868+ , createNetworkAttachable :: Bool -- ^ Network is manually attachable in swarm mode.
869+ , createNetworkIngress :: Bool -- ^ Network is a swarm-mode network.
870+ , createNetworkIPAM :: IPAM -- ^ Address management configuration
871+ , createNetworkEnableIPv6 :: Bool -- ^ Enable IPv6 on the network.
872+ , createNetworkOptions :: HM.HashMap Text Text -- ^ Options to pass to the driver.
873+ , createNetworkLabels :: [Label] -- ^ Identifying labels for the network.
874+ } deriving (Eq, Show, Generic)
869875
870876-- | Sensible defalut for create network options
871877defaultCreateNetworkOpts :: Text -> CreateNetworkOpts
@@ -873,20 +879,19 @@ defaultCreateNetworkOpts name =
873879 CreateNetworkOpts
874880 { createNetworkName = name
875881 , createNetworkCheckDuplicate = False
876− , createNetworkDriver = "bridge"
882+ , createNetworkDriver = NetworkBridge
877883 , createNetworkInternal = True
884+ , createNetworkAttachable = False
885+ , createNetworkIngress = False
886+ , createNetworkIPAM = defaultIPAM
878887 , createNetworkEnableIPv6 = False
888+ , createNetworkOptions = HM.empty
889+ , createNetworkLabels = []
879890 }
880891
881892instance ToJSON CreateNetworkOpts where
882− toJSON opts =
883− object
884− [ "Name" .= createNetworkName opts
885− , "CheckDuplicate" .= createNetworkCheckDuplicate opts
886− , "Driver" .= createNetworkDriver opts
887− , "Internal" .= createNetworkInternal opts
888− , "EnableIPv6" .= createNetworkEnableIPv6 opts
889− ]
893+ toJSON = genericToJSON defaultOptions
894+ { fieldLabelModifier = drop 13, omitNothingFields = True }
890895
891896data NetworkScope = LocalScope | GlobalScope | SwarmScope deriving (Eq, Show)
892897
@@ -904,7 +909,7 @@ instance FromJSON NetworkScope where
904909 parseJSON "swarm" = return SwarmScope
905910 parseJSON _ = fail "Failed to parse NetworkScope"
906911
907−data CIDR = CIDR Text Int deriving (Eq, Show)
912+data CIDR = CIDR Text Int deriving (Eq, Show, Generic)
908913
909914instance FromJSON CIDR where
910915 parseJSON (JSON.String t) = case T.splitOn "/" t of
@@ -916,19 +921,27 @@ instance FromJSON CIDR where
916921 _ -> fail "Failed to parse CIDR prefix length"
917922 parseJSON _ = fail "Failed to parse CIDR"
918923
919−data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show)
924+instance ToJSON CIDR where
925+ toJSON (CIDR addr pref) =
926+ JSON.String $ T.concat [addr, "/", T.pack $ show pref]
927+
928+data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show, Generic)
920929
921930instance FromJSON IPAMDriver where
922931 parseJSON (JSON.String "default") = return DefaultIPAMDriver
923932 parseJSON (JSON.String t) = return $ NamedIPAMDriver t
924933 parseJSON _ = fail "IPAMDriver is not a string"
925934
935+instance ToJSON IPAMDriver where
936+ toJSON DefaultIPAMDriver = JSON.String "default"
937+ toJSON (NamedIPAMDriver t) = JSON.String t
938+
926939data IPAMConfig = IPAMConfig
927940 { ipamConfigSubnet :: CIDR
928941 , ipamConfigIPRange :: Maybe CIDR
929− , ipamSubnetGateway :: Maybe Text
942+ , ipamConfigGateway :: Maybe Text
930943 , ipamConfigAuxAddress :: Maybe Text
931− } deriving (Eq, Show)
944+ } deriving (Eq, Show, Generic)
932945
933946instance FromJSON IPAMConfig where
934947 parseJSON (JSON.Object o) = IPAMConfig
@@ -938,11 +951,15 @@ instance FromJSON IPAMConfig where
938951 <*> o .:? "AuxAddress"
939952 parseJSON _ = fail "IPAMConfig is not an object"
940953
954+instance ToJSON IPAMConfig where
955+ toJSON = genericToJSON defaultOptions
956+ { fieldLabelModifier = drop 10, omitNothingFields = True }
957+
941958data IPAM = IPAM
942959 { ipamDriver :: IPAMDriver
943960 , ipamConfig :: [IPAMConfig]
944961 , ipamOptions :: HM.HashMap Text Text
945− } deriving (Eq, Show)
962+ } deriving (Eq, Show, Generic)
946963
947964instance FromJSON IPAM where
948965 parseJSON (JSON.Object o) = IPAM
@@ -951,6 +968,12 @@ instance FromJSON IPAM where
951968 <*> o .:? "Options" .!= HM.empty
952969 parseJSON _ = fail "IPAM is not an object"
953970
971+instance ToJSON IPAM where
972+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 4 }
973+
974+defaultIPAM :: IPAM
975+defaultIPAM = IPAM DefaultIPAMDriver [] HM.empty
976+
954977data NetworkContainer = NetworkContainer
955978 { networkContainerName :: ContainerName
956979 , networkContainerEndpointID :: Text
@@ -980,7 +1003,7 @@ data NetworkDetails = NetworkDetails
9801003 , networkDetailsIngress :: Bool
9811004 , networkDetailsIPAM :: IPAM
9821005 , networkDetailsOptions :: HM.HashMap Text Text
983− , networkDetailsLabels :: HM.HashMap Text Text
1006+ , networkDetailsLabels :: [Label]
9841007 , networkDetailsContainers :: HM.HashMap Text NetworkContainer
9851008 } deriving (Eq, Show)
9861009
@@ -997,7 +1020,7 @@ instance FromJSON NetworkDetails where
9971020 <*> o .: "Ingress"
9981021 <*> o .: "IPAM"
9991022 <*> o .:? "Options" .!= HM.empty
1000− <*> o .:? "Labels" .!= HM.empty
1023+ <*> o .:? "Labels" .!= []
10011024 <*> o .:? "Containers" .!= HM.empty
10021025 parseJSON _ = fail "NetworkDetails is not an object"
10031026
tests/tests.hs+16
@@ -187,6 +187,21 @@ testDisconnectNetwork =
187187 where
188188 networkMode (Network mode _) = mode
189189
190+testPruneNetworks :: IO ()
191+testPruneNetworks =
192+ runDocker $ do
193+ let created = ["n1", "n2", "n3"]
194+ _ <- mapM_ (fromRight <=< createNetwork . opts) created
195+ NetworksDeleted deleted <- fromRight =<< pruneNetworks filter
196+ let remaining = created \\ deleted
197+ when (remaining /= []) $ do
198+ mapM_ (removeNetwork . toNID) remaining
199+ lift . assertFailure $ "pruning networks, networks not pruned: " ++ show remaining
200+ where
201+ toNID = fromJust . toNetworkID
202+ opts n = (defaultCreateNetworkOpts n) {createNetworkLabels = [Label "prune" "me"]}
203+ filter = defaultPruneFilter {pruneFilterIncludeLabels = [("prune", Just "me")]}
204+
190205testLogDriverOptionsJson :: TestTree
191206testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
192207 where
@@ -307,6 +322,7 @@ integrationTests =
307322 , testCase "Inspect a network" testInspectNetwork
308323 , testCase "Connect a container to a network" testConnectNetwork
309324 , testCase "Disconnect a container from a network" testDisconnectNetwork
325+ , testCase "Remove unused networks matching a label" testPruneNetworks
310326 ]
311327
312328jsonTests :: TestTree