2da7b4e · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Add the rest of the fields through AVI version 1.29 to 'CreateNetworkOpts'

2da7b4eBen Hamlin7 years ago

src/Docker/Client/Types.hs+46−23

compare with master

unifiedsplit

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

81 , IPAMDriver(..)

82 , IPAMConfig(..)

83 , IPAM(..)

84+ , defaultIPAM

84 , NetworkContainer(..)

85 , NetworkContainer(..)

85 , NetworkDetails(..)

86 , NetworkDetails(..)

86 , NetworkType(..)

87 , NetworkType(..)

@@ -127,7 +128,7 @@ import Data.Aeson (FromJSON, ToJSON, genericParseJSON,

127 genericToJSON, object, parseJSON, toJSON,

128 genericToJSON, object, parseJSON, toJSON,

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

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

129import qualified Data.Aeson as JSON

130import qualified Data.Aeson as JSON

130−import Data.Aeson.Types (defaultOptions, fieldLabelModifier)

131+import Data.Aeson.Types (defaultOptions, fieldLabelModifier, omitNothingFields)

131import Data.Char (isAlphaNum, toUpper)

132import Data.Char (isAlphaNum, toUpper)

132import qualified Data.HashMap.Strict as HM

133import qualified Data.HashMap.Strict as HM

133import Data.Maybe (maybeToList, catMaybes)

134import Data.Maybe (maybeToList, catMaybes)

@@ -860,12 +861,17 @@ defaultLogOpts = LogOpts { stdout = True

860

861

861-- | Options for creating a network

862-- | Options for creating a network

862data CreateNetworkOpts = CreateNetworkOpts

863data CreateNetworkOpts = CreateNetworkOpts

863− { createNetworkName :: Text -- ^ The network's name

864+ { createNetworkName :: Text -- ^ The network's name

864− , createNetworkCheckDuplicate :: Bool -- ^ Check for networks with duplicate names.

865+ , createNetworkCheckDuplicate :: Bool -- ^ Check for networks with duplicate names.

865− , createNetworkDriver :: Text -- ^ Name of the network driver plugin to use.

866+ , createNetworkDriver :: NetworkMode -- ^ Name of the network driver plugin to use.

866− , createNetworkInternal :: Bool -- ^ Restrict external access to the network.

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

867− , createNetworkEnableIPv6 :: Bool -- ^ Enable IPv6 on the network.

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.

868− } deriving (Eq, Show)

874+ } deriving (Eq, Show, Generic)

869

875

870-- | Sensible defalut for create network options

876-- | Sensible defalut for create network options

871defaultCreateNetworkOpts :: Text -> CreateNetworkOpts

877defaultCreateNetworkOpts :: Text -> CreateNetworkOpts

@@ -873,20 +879,19 @@ defaultCreateNetworkOpts name =

873 CreateNetworkOpts

879 CreateNetworkOpts

874 { createNetworkName = name

880 { createNetworkName = name

875 , createNetworkCheckDuplicate = False

881 , createNetworkCheckDuplicate = False

876− , createNetworkDriver = "bridge"

882+ , createNetworkDriver = NetworkBridge

877 , createNetworkInternal = True

883 , createNetworkInternal = True

884+ , createNetworkAttachable = False

885+ , createNetworkIngress = False

886+ , createNetworkIPAM = defaultIPAM

878 , createNetworkEnableIPv6 = False

887 , createNetworkEnableIPv6 = False

888+ , createNetworkOptions = HM.empty

889+ , createNetworkLabels = []

879 }

890 }

880

891

881instance ToJSON CreateNetworkOpts where

892instance ToJSON CreateNetworkOpts where

882− toJSON opts =

893+ toJSON = genericToJSON defaultOptions

883− object

894+ { fieldLabelModifier = drop 13, omitNothingFields = True }

884− [ "Name" .= createNetworkName opts

885− , "CheckDuplicate" .= createNetworkCheckDuplicate opts

886− , "Driver" .= createNetworkDriver opts

887− , "Internal" .= createNetworkInternal opts

888− , "EnableIPv6" .= createNetworkEnableIPv6 opts

889− ]

890

895

891data NetworkScope = LocalScope | GlobalScope | SwarmScope deriving (Eq, Show)

896data NetworkScope = LocalScope | GlobalScope | SwarmScope deriving (Eq, Show)

892

897

@@ -904,7 +909,7 @@ instance FromJSON NetworkScope where

904 parseJSON "swarm" = return SwarmScope

909 parseJSON "swarm" = return SwarmScope

905 parseJSON _ = fail "Failed to parse NetworkScope"

910 parseJSON _ = fail "Failed to parse NetworkScope"

906

911

907−data CIDR = CIDR Text Int deriving (Eq, Show)

912+data CIDR = CIDR Text Int deriving (Eq, Show, Generic)

908

913

909instance FromJSON CIDR where

914instance FromJSON CIDR where

910 parseJSON (JSON.String t) = case T.splitOn "/" t of

915 parseJSON (JSON.String t) = case T.splitOn "/" t of

@@ -916,19 +921,27 @@ instance FromJSON CIDR where

916 _ -> fail "Failed to parse CIDR prefix length"

921 _ -> fail "Failed to parse CIDR prefix length"

917 parseJSON _ = fail "Failed to parse CIDR"

922 parseJSON _ = fail "Failed to parse CIDR"

918

923

924+instance ToJSON CIDR where

925+ toJSON (CIDR addr pref) =

926+ JSON.String $ T.concat [addr, "/", T.pack $ show pref]

927+

919−data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show)

928+data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show, Generic)

920

929

921instance FromJSON IPAMDriver where

930instance FromJSON IPAMDriver where

922 parseJSON (JSON.String "default") = return DefaultIPAMDriver

931 parseJSON (JSON.String "default") = return DefaultIPAMDriver

923 parseJSON (JSON.String t) = return $ NamedIPAMDriver t

932 parseJSON (JSON.String t) = return $ NamedIPAMDriver t

924 parseJSON _ = fail "IPAMDriver is not a string"

933 parseJSON _ = fail "IPAMDriver is not a string"

925

934

935+instance ToJSON IPAMDriver where

936+ toJSON DefaultIPAMDriver = JSON.String "default"

937+ toJSON (NamedIPAMDriver t) = JSON.String t

938+

926data IPAMConfig = IPAMConfig

939data IPAMConfig = IPAMConfig

927 { ipamConfigSubnet :: CIDR

940 { ipamConfigSubnet :: CIDR

928 , ipamConfigIPRange :: Maybe CIDR

941 , ipamConfigIPRange :: Maybe CIDR

929− , ipamSubnetGateway :: Maybe Text

942+ , ipamConfigGateway :: Maybe Text

930 , ipamConfigAuxAddress :: Maybe Text

943 , ipamConfigAuxAddress :: Maybe Text

931− } deriving (Eq, Show)

944+ } deriving (Eq, Show, Generic)

932

945

933instance FromJSON IPAMConfig where

946instance FromJSON IPAMConfig where

934 parseJSON (JSON.Object o) = IPAMConfig

947 parseJSON (JSON.Object o) = IPAMConfig

@@ -938,11 +951,15 @@ instance FromJSON IPAMConfig where

938 <*> o .:? "AuxAddress"

951 <*> o .:? "AuxAddress"

939 parseJSON _ = fail "IPAMConfig is not an object"

952 parseJSON _ = fail "IPAMConfig is not an object"

940

953

954+instance ToJSON IPAMConfig where

955+ toJSON = genericToJSON defaultOptions

956+ { fieldLabelModifier = drop 10, omitNothingFields = True }

957+

941data IPAM = IPAM

958data IPAM = IPAM

942 { ipamDriver :: IPAMDriver

959 { ipamDriver :: IPAMDriver

943 , ipamConfig :: [IPAMConfig]

960 , ipamConfig :: [IPAMConfig]

944 , ipamOptions :: HM.HashMap Text Text

961 , ipamOptions :: HM.HashMap Text Text

945− } deriving (Eq, Show)

962+ } deriving (Eq, Show, Generic)

946

963

947instance FromJSON IPAM where

964instance FromJSON IPAM where

948 parseJSON (JSON.Object o) = IPAM

965 parseJSON (JSON.Object o) = IPAM

@@ -951,6 +968,12 @@ instance FromJSON IPAM where

951 <*> o .:? "Options" .!= HM.empty

968 <*> o .:? "Options" .!= HM.empty

952 parseJSON _ = fail "IPAM is not an object"

969 parseJSON _ = fail "IPAM is not an object"

953

970

971+instance ToJSON IPAM where

972+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 4 }

973+

974+defaultIPAM :: IPAM

975+defaultIPAM = IPAM DefaultIPAMDriver [] HM.empty

976+

954data NetworkContainer = NetworkContainer

977data NetworkContainer = NetworkContainer

955 { networkContainerName :: ContainerName

978 { networkContainerName :: ContainerName

956 , networkContainerEndpointID :: Text

979 , networkContainerEndpointID :: Text

@@ -980,7 +1003,7 @@ data NetworkDetails = NetworkDetails

980 , networkDetailsIngress :: Bool

1003 , networkDetailsIngress :: Bool

981 , networkDetailsIPAM :: IPAM

1004 , networkDetailsIPAM :: IPAM

982 , networkDetailsOptions :: HM.HashMap Text Text

1005 , networkDetailsOptions :: HM.HashMap Text Text

983− , networkDetailsLabels :: HM.HashMap Text Text

1006+ , networkDetailsLabels :: [Label]

984 , networkDetailsContainers :: HM.HashMap Text NetworkContainer

1007 , networkDetailsContainers :: HM.HashMap Text NetworkContainer

985 } deriving (Eq, Show)

1008 } deriving (Eq, Show)

986

1009

@@ -997,7 +1020,7 @@ instance FromJSON NetworkDetails where

997 <*> o .: "Ingress"

1020 <*> o .: "Ingress"

998 <*> o .: "IPAM"

1021 <*> o .: "IPAM"

999 <*> o .:? "Options" .!= HM.empty

1022 <*> o .:? "Options" .!= HM.empty

1000− <*> o .:? "Labels" .!= HM.empty

1023+ <*> o .:? "Labels" .!= []

1001 <*> o .:? "Containers" .!= HM.empty

1024 <*> o .:? "Containers" .!= HM.empty

1002 parseJSON _ = fail "NetworkDetails is not an object"

1025 parseJSON _ = fail "NetworkDetails is not an object"

1003

1026

tests/tests.hs+16

@@ -187,6 +187,21 @@ testDisconnectNetwork =

187 where

188 networkMode (Network mode _) = mode

189

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+

190testLogDriverOptionsJson :: TestTree

205testLogDriverOptionsJson :: TestTree

191testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]

206testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]

192 where

207 where

@@ -307,6 +322,7 @@ integrationTests =

307 , testCase "Inspect a network" testInspectNetwork

322 , testCase "Inspect a network" testInspectNetwork

308 , testCase "Connect a container to a network" testConnectNetwork

323 , testCase "Connect a container to a network" testConnectNetwork

309 , testCase "Disconnect a container from a network" testDisconnectNetwork

324 , testCase "Disconnect a container from a network" testDisconnectNetwork

325+ , testCase "Remove unused networks matching a label" testPruneNetworks

310 ]

326 ]

311

327

312jsonTests :: TestTree

328jsonTests :: TestTree