master...040f3fa · docker-hs

git.iko.soy/docker-hs

on 040f3fa help sign in

.travis.yml+29−24

since splitsnapshots

unifiedsplit

@@ -1,11 +1,11 @@

1sudo: required

2−dist: trusty

2+dist: bionic

4# Only build master and release tags

5−branches:

5+# branches:

6− only:

6+# only:

7− - master

7+# - master

8− - /^v\d+\.\d+(\.\d+)?(-\S*)?$/

8+# - /^v\d+\.\d+(\.\d+)?(-\S*)?$/

10# Choose a lightweight base image; we provide our own build tools.

11language:

@@ -27,37 +27,42 @@ env:

27 - STACK_ARGS=""

29 matrix:

30− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=7.10

30+ - DOCKER_VERSION="18.03.1~ce~3-0~ubuntu" GHCVER=7.10

31− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=7.10

31+ - DOCKER_VERSION="5:18.09.9~3-0~ubuntu-bionic" GHCVER=7.10

32− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=7.10

32+ - DOCKER_VERSION="5:19.03.6~3-0~ubuntu-bionic" GHCVER=7.10

34− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.0

34+ - DOCKER_VERSION="18.03.1~ce~3-0~ubuntu" GHCVER=8.0

35− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.0

35+ - DOCKER_VERSION="5:18.09.9~3-0~ubuntu-bionic" GHCVER=8.0

36− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.0

36+ - DOCKER_VERSION="5:19.03.6~3-0~ubuntu-bionic" GHCVER=8.0

38− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.0.2

38+ - DOCKER_VERSION="18.03.1~ce~3-0~ubuntu" GHCVER=8.0.2

39− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.0.2

39+ - DOCKER_VERSION="5:18.09.9~3-0~ubuntu-bionic" GHCVER=8.0.2

40− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.0.2

40+ - DOCKER_VERSION="5:19.03.6~3-0~ubuntu-bionic" GHCVER=8.0.2

42− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.6.4

42+ - DOCKER_VERSION="18.03.1~ce~3-0~ubuntu" GHCVER=8.6.4

43− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.6.4

43+ - DOCKER_VERSION="5:18.09.9~3-0~ubuntu-bionic" GHCVER=8.6.4

44− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.6.4

44+ - DOCKER_VERSION="5:19.03.6~3-0~ubuntu-bionic" GHCVER=8.6.4

46− - DOCKER_VERSION="1.12.3-0~trusty" GHCVER=8.8.2

46+ - DOCKER_VERSION="18.03.1~ce~3-0~ubuntu" GHCVER=8.8.2

47− - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.8.2

47+ - DOCKER_VERSION="5:18.09.9~3-0~ubuntu-bionic" GHCVER=8.8.2

48− - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.8.2

48+ - DOCKER_VERSION="5:19.03.6~3-0~ubuntu-bionic" GHCVER=8.8.2

50addons:

51 apt:

52 packages:

53 - libgmp-dev

54+ - apt-transport-https

55+ - ca-certificates

56+ - software-properties-common

57+ - curl

55before_install:

59before_install:

56− # Upgrade docker to 1.12.3.0

60+ - curl -fsSL https://download.docker.com/linux/ubuntu/gpg | sudo apt-key add -

57− - sudo sh -c 'echo "deb https://apt.dockerproject.org/repo ubuntu-trusty main" > /etc/apt/sources.list.d/docker.list'

61+ - sudo add-apt-repository "deb [arch=amd64] https://download.docker.com/linux/ubuntu $(lsb_release -cs) stable"

58− - sudo apt-key adv --keyserver hkp://p80.pool.sks-keyservers.net:80 --recv-keys 58118E89F3A912897C070ADBF76221572C52609D

59 - sudo apt-get update

62 - sudo apt-get update

63+ - sudo apt-get install -y --no-install-recommends docker-ce=${DOCKER_VERSION}

64+

60− - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=$DOCKER_VERSION

65+# - sudo apt-get -qqy -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" install docker-engine=$DOCKER_VERSION

62install:

67install:

63 - mkdir -p "$HOME"/.local/bin

68 - mkdir -p "$HOME"/.local/bin

src/Docker/Client/Api.hs+24

@@ -24,6 +24,11 @@ module Docker.Client.Api (

24 -- * Network

25 , createNetwork

26 , removeNetwork

27+ , listNetworks

28+ , inspectNetwork

29+ , connectNetwork

30+ , disconnectNetwork

31+ , pruneNetworks

27 -- * Other

32 -- * Other

28 , getDockerVersion

33 , getDockerVersion

29 ) where

34 ) where

@@ -225,3 +230,22 @@ createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseR

225removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())

230removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())

226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

231removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

227

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

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

236+

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

238+inspectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError NetworkDetails)

239+inspectNetwork nid = requestHelper GET (InspectNetworkEndpoint nid) >>= parseResponse

240+

241+-- | Connects a container to a network.

242+connectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> ConnectConfig -> DockerT m (Either DockerError ())

243+connectNetwork nid cfg = requestUnit POST $ ConnectNetworkEndpoint nid cfg

244+

245+-- | Disconnects a container from a network.

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

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

@@ -288,3 +288,28 @@ statusCodeToError (RemoveNetworkEndpoint _) st =

288 Nothing

289 else

290 Just $ DockerInvalidStatusCode st

291+statusCodeToError (ListNetworksEndpoint _) st =

292+ if st == status200 then

293+ Nothing

294+ else

295+ Just $ DockerInvalidStatusCode st

296+statusCodeToError (InspectNetworkEndpoint _) st =

297+ if st == status200 then

298+ Nothing

299+ else

300+ Just $ DockerInvalidStatusCode st

301+statusCodeToError (ConnectNetworkEndpoint _ _) st =

302+ if st == status200 then

303+ Nothing

304+ else

305+ Just $ DockerInvalidStatusCode st

306+statusCodeToError (DisconnectNetworkEndpoint _ _) st =

307+ if st == status200 then

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+23−13

@@ -1,17 +1,18 @@

1module Docker.Client.Internal where

3−import Blaze.ByteString.Builder (toByteString)

3+import Blaze.ByteString.Builder (toByteString)

4−import qualified Data.Aeson as JSON

4+import qualified Data.Aeson as JSON

5−import Data.ByteString (ByteString)

5+import Data.ByteString (ByteString)

6−import qualified Data.ByteString.Char8 as BSC

6+import qualified Data.ByteString.Char8 as BSC

7−import qualified Data.Conduit.Binary as CB

7+import qualified Data.ByteString.Lazy.Char8 as BSLC

8+import qualified Data.Conduit.Binary as CB

8−import qualified Data.Text as T

9+import qualified Data.Text as T

9−import Data.Text.Encoding (decodeUtf8, encodeUtf8)

10+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

10−import qualified Network.HTTP.Client as HTTP

11+import qualified Network.HTTP.Client as HTTP

11−import Network.HTTP.Conduit (requestBodySourceChunked)

12+import Network.HTTP.Conduit (requestBodySourceChunked)

12−import Network.HTTP.Types (Query, encodePath,

13+import Network.HTTP.Types (Query, encodePath,

13− encodePathSegments)

14+ encodePathSegments)

14−import Prelude hiding (all)

15+import Prelude hiding (all)

16import Docker.Client.Types

17import Docker.Client.Types

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

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

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

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

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

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

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

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

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

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

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

82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

88getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

83getEndpointRequestBody VersionEndpoint = Nothing

89getEndpointRequestBody VersionEndpoint = Nothing

@@ -101,8 +107,12 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing

101

107

102getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)

108getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)

103getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

109getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

110+getEndpointRequestBody (ListNetworksEndpoint _) = Nothing

111+getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing

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

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

114+getEndpointRequestBody (PruneNetworksEndpoint _) = Nothing

104

115

105getEndpointContentType :: Endpoint -> BSC.ByteString

116getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

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

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

108−

src/Docker/Client/Types.hs+318−20

@@ -76,6 +76,29 @@ module Docker.Client.Types (

76 , HostConfig(..)

77 , defaultHostConfig

78 , NetworkingConfig(..)

79+ , NetworkScope(..)

80+ , CIDR(..)

81+ , IPAMDriver(..)

82+ , IPAMConfig(..)

83+ , IPAM(..)

84+ , defaultIPAM

85+ , NetworkContainer(..)

86+ , NetworkDetails(..)

87+ , NetworkType(..)

88+ , NetworkName

89+ , NetworkFilter(..)

90+ , defaultNetworkFilter

91+ , ConnectConfig(..)

92+ , defaultConnectConfig

93+ , DisconnectConfig(..)

94+ , defaultDisconnectConfig

95+ , PruneFilter(..)

96+ , defaultPruneFilter

97+ , NetworksDeleted(..)

98+ , EndpointSettings(..)

99+ , defaultEndpointSettings

100+ , IPAMSettings(..)

101+ , defaultIPAMSettings

79 , EndpointConfig(..)

102 , EndpointConfig(..)

80 , Ulimit(..)

103 , Ulimit(..)

81 , ContainerResources(..)

104 , ContainerResources(..)

@@ -100,13 +123,15 @@ module Docker.Client.Types (

100 , MemoryConstraintSize(..)

123 , MemoryConstraintSize(..)

101 ) where

124 ) where

102

125

126+import Control.Monad (join)

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

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

104 genericToJSON, object, parseJSON, toJSON,

128 genericToJSON, object, parseJSON, toJSON,

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

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

106import qualified Data.Aeson as JSON

130import qualified Data.Aeson as JSON

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

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

108import Data.Char (isAlphaNum, toUpper)

132import Data.Char (isAlphaNum, toUpper)

109import qualified Data.HashMap.Strict as HM

133import qualified Data.HashMap.Strict as HM

134+import Data.Maybe (maybeToList, catMaybes)

110import Data.Monoid ((<>))

135import Data.Monoid ((<>))

111import Data.Scientific (floatingOrInteger)

136import Data.Scientific (floatingOrInteger)

112import Data.Text (Text)

137import Data.Text (Text)

@@ -114,6 +139,7 @@ import qualified Data.Text as T

114import Data.Time.Clock (UTCTime)

139import Data.Time.Clock (UTCTime)

115import qualified Data.Vector as V

140import qualified Data.Vector as V

116import GHC.Generics (Generic)

141import GHC.Generics (Generic)

142+import Numeric (readDec)

117import Prelude hiding (all, tail)

143import Prelude hiding (all, tail)

118import Text.Read (readMaybe)

144import Text.Read (readMaybe)

119

145

@@ -139,6 +165,11 @@ data Endpoint =

139 | DeleteImageEndpoint ImageDeleteOpts ImageID

165 | DeleteImageEndpoint ImageDeleteOpts ImageID

140 | CreateNetworkEndpoint CreateNetworkOpts

166 | CreateNetworkEndpoint CreateNetworkOpts

141 | RemoveNetworkEndpoint NetworkID

167 | RemoveNetworkEndpoint NetworkID

168+ | ListNetworksEndpoint NetworkFilter

169+ | InspectNetworkEndpoint NetworkID

170+ | ConnectNetworkEndpoint NetworkID ConnectConfig

171+ | DisconnectNetworkEndpoint NetworkID DisconnectConfig

172+ | PruneNetworksEndpoint PruneFilter

142 deriving (Eq, Show)

173 deriving (Eq, Show)

143

174

144-- | We should newtype this

175-- | We should newtype this

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

830

861

831-- | Options for creating a network

862-- | Options for creating a network

832data CreateNetworkOpts = CreateNetworkOpts

863data CreateNetworkOpts = CreateNetworkOpts

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

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

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

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

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

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

836− , 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

837− , 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.

838− } deriving (Eq, Show)

874+ } deriving (Eq, Show, Generic)

839

875

840-- | Sensible defalut for create network options

876-- | Sensible defalut for create network options

841defaultCreateNetworkOpts :: Text -> CreateNetworkOpts

877defaultCreateNetworkOpts :: Text -> CreateNetworkOpts

@@ -843,20 +879,279 @@ defaultCreateNetworkOpts name =

843 CreateNetworkOpts

879 CreateNetworkOpts

844 { createNetworkName = name

880 { createNetworkName = name

845 , createNetworkCheckDuplicate = False

881 , createNetworkCheckDuplicate = False

846− , createNetworkDriver = "bridge"

882+ , createNetworkDriver = NetworkBridge

847 , createNetworkInternal = True

883 , createNetworkInternal = True

884+ , createNetworkAttachable = False

885+ , createNetworkIngress = False

886+ , createNetworkIPAM = defaultIPAM

848 , createNetworkEnableIPv6 = False

887 , createNetworkEnableIPv6 = False

888+ , createNetworkOptions = HM.empty

889+ , createNetworkLabels = []

849 }

890 }

850

891

851instance ToJSON CreateNetworkOpts where

892instance ToJSON CreateNetworkOpts where

852− toJSON opts =

893+ toJSON = genericToJSON defaultOptions

853− object

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

854− [ "Name" .= createNetworkName opts

895+

855− , "CheckDuplicate" .= createNetworkCheckDuplicate opts

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

856− , "Driver" .= createNetworkDriver opts

897+

857− , "Internal" .= createNetworkInternal opts

898+fromNetworkScope :: NetworkScope -> Text

858− , "EnableIPv6" .= createNetworkEnableIPv6 opts

899+fromNetworkScope LocalScope = "local"

859− ]

900+fromNetworkScope GlobalScope = "global"

901+fromNetworkScope SwarmScope = "swarm"

902+

903+instance ToJSON NetworkScope where

904+ toJSON = JSON.String . fromNetworkScope

905+

906+instance FromJSON NetworkScope where

907+ parseJSON "local" = return LocalScope

908+ parseJSON "global" = return GlobalScope

909+ parseJSON "swarm" = return SwarmScope

910+ parseJSON _ = fail "Failed to parse NetworkScope"

911+

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

913+

914+instance FromJSON CIDR where

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

916+ [a,p] -> CIDR a <$> parsePrefixLen p

917+ _ -> fail "Failed to parse CIDR"

918+ where

919+ parsePrefixLen p = case readDec (T.unpack p) of

920+ (n,""):_ -> return n

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

922+ parseJSON _ = fail "Failed to parse CIDR"

923+

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)

929+

930+instance FromJSON IPAMDriver where

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

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

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

934+

935+instance ToJSON IPAMDriver where

936+ toJSON DefaultIPAMDriver = JSON.String "default"

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

938+

939+data IPAMConfig = IPAMConfig

940+ { ipamConfigSubnet :: CIDR

941+ , ipamConfigIPRange :: Maybe CIDR

942+ , ipamConfigGateway :: Maybe Text

943+ , ipamConfigAuxAddress :: Maybe Text

944+ } deriving (Eq, Show, Generic)

945+

946+instance FromJSON IPAMConfig where

947+ parseJSON (JSON.Object o) = IPAMConfig

948+ <$> o .: "Subnet"

949+ <*> o .:? "IPRange"

950+ <*> o .:? "Gateway"

951+ <*> o .:? "AuxAddress"

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

953+

954+instance ToJSON IPAMConfig where

955+ toJSON = genericToJSON defaultOptions

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

957+

958+data IPAM = IPAM

959+ { ipamDriver :: IPAMDriver

960+ , ipamConfig :: [IPAMConfig]

961+ , ipamOptions :: HM.HashMap Text Text

962+ } deriving (Eq, Show, Generic)

963+

964+instance FromJSON IPAM where

965+ parseJSON (JSON.Object o) = IPAM

966+ <$> o .:? "Driver" .!= DefaultIPAMDriver

967+ <*> o .:? "Config" .!= []

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

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

970+

971+instance ToJSON IPAM where

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

973+

974+defaultIPAM :: IPAM

975+defaultIPAM = IPAM DefaultIPAMDriver [] HM.empty

976+

977+data NetworkContainer = NetworkContainer

978+ { networkContainerName :: ContainerName

979+ , networkContainerEndpointID :: Text

980+ , networkContainerMacAddress :: Text

981+ , networkContainerIPv4Address :: Text

982+ , networkContainerIPv6Address :: Text

983+ } deriving (Eq, Show)

984+

985+instance FromJSON NetworkContainer where

986+ parseJSON (JSON.Object o) = NetworkContainer

987+ <$> o .: "Name"

988+ <*> o .: "EndpointID"

989+ <*> o .: "MacAddress"

990+ <*> o .: "IPv4Address"

991+ <*> o .: "IPv6Address"

992+ parseJSON _ = fail "NetworkContainer is not an object"

993+

994+data NetworkDetails = NetworkDetails

995+ { networkDetailsName :: Text

996+ , networkDetailsID :: NetworkID

997+ , networkDetailsCreated :: UTCTime

998+ , networkDetailsScope :: NetworkScope

999+ , networkDetailsDriver :: NetworkMode

1000+ , networkDetailsEnableIPv6 :: Bool

1001+ , networkDetailsInternal :: Bool

1002+ , networkDetailsAttachable :: Bool

1003+ , networkDetailsIngress :: Bool

1004+ , networkDetailsIPAM :: IPAM

1005+ , networkDetailsOptions :: HM.HashMap Text Text

1006+ , networkDetailsLabels :: [Label]

1007+ , networkDetailsContainers :: HM.HashMap Text NetworkContainer

1008+ } deriving (Eq, Show)

1009+

1010+instance FromJSON NetworkDetails where

1011+ parseJSON v@(JSON.Object o) = NetworkDetails

1012+ <$> o .: "Name"

1013+ <*> parseJSON v

1014+ <*> o .: "Created"

1015+ <*> o .: "Scope"

1016+ <*> o .: "Driver"

1017+ <*> o .: "EnableIPv6"

1018+ <*> o .: "Internal"

1019+ <*> o .: "Attachable"

1020+ <*> o .: "Ingress"

1021+ <*> o .: "IPAM"

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

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

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

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

1026+

1027+data NetworkType = BuiltinNetwork | CustomNetwork deriving (Eq, Show)

1028+

1029+fromNetworkType :: NetworkType -> Text

1030+fromNetworkType BuiltinNetwork = "builtin"

1031+fromNetworkType CustomNetwork = "custom"

1032+

1033+type NetworkName = Text

1034+

1035+instance ToJSON NetworkType where

1036+ toJSON = JSON.String . fromNetworkType

1037+

1038+instance FromJSON NetworkType where

1039+ parseJSON (JSON.String "builtin") = return BuiltinNetwork

1040+ parseJSON (JSON.String "custom") = return CustomNetwork

1041+ parseJSON _ = fail "Failed to parse NetworkType"

1042+

1043+data NetworkFilter = NetworkFilter

1044+ { networkFilterNames :: [Text]

1045+ , networkFilterIDs :: [NetworkID]

1046+ , networkFilterDrivers :: [NetworkMode]

1047+ , networkFilterScopes :: [NetworkScope]

1048+ , networkFilterTypes :: [NetworkType]

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

1050+ } deriving (Eq, Show)

1051+

1052+instance ToJSON NetworkFilter where

1053+ toJSON nf = object . catMaybes $

1054+ [ "name" .=? networkFilterNames nf

1055+ , "id" .=? (fromNetworkID <$> networkFilterIDs nf)

1056+ , "driver" .=? (fromNetworkMode <$> networkFilterDrivers nf)

1057+ , "scope" .=? (fromNetworkScope <$> networkFilterScopes nf)

1058+ , "type" .=? (fromNetworkType <$> networkFilterTypes nf)

1059+ , "label" .=? (constructLabel <$> networkFilterLabels nf)

1060+ ]

1061+ where

1062+ _ .=? [] = Nothing

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

1064+

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

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

1067+constructLabel (k, Nothing) = k

1068+

1069+defaultNetworkFilter :: NetworkFilter

1070+defaultNetworkFilter = NetworkFilter [] [] [] [] [] []

1071+

1072+data ConnectConfig = ConnectConfig

1073+ { connectContainer :: Text

1074+ , connectEndpointConfig :: EndpointSettings

1075+ } deriving (Eq, Show, Generic)

1076+

1077+instance ToJSON ConnectConfig where

1078+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 7 }

1079+

1080+defaultConnectConfig :: Text -> ConnectConfig

1081+defaultConnectConfig = flip ConnectConfig defaultEndpointSettings

1082+

1083+data DisconnectConfig = DisconnectConfig

1084+ { disconnectContainer :: Text

1085+ , disconnectForce :: Bool

1086+ } deriving (Eq, Show, Generic)

1087+

1088+instance ToJSON DisconnectConfig where

1089+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 10 }

1090+

1091+defaultDisconnectConfig :: Text -> DisconnectConfig

1092+defaultDisconnectConfig = flip DisconnectConfig False

1093+

1094+data PruneFilter = PruneFilter

1095+ { pruneFilterUntil :: Maybe Text

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

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

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

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

1100+ } deriving (Eq, Show)

1101+

1102+instance ToJSON PruneFilter where

1103+ toJSON pf = object . catMaybes $

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

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

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

1107+ ]

1108+ where

1109+ _ .=? [] = Nothing

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

1111+

1112+defaultPruneFilter :: PruneFilter

1113+defaultPruneFilter = PruneFilter Nothing [] []

1114+

1115+newtype NetworksDeleted = NetworksDeleted [Text]

1116+ deriving (Eq, Show)

1117+

1118+instance FromJSON NetworksDeleted where

1119+ parseJSON (JSON.Object o) =

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

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

1122+

1123+data EndpointSettings = EndpointSettings

1124+ { endpointIPAMConfig :: IPAMSettings

1125+ , endpointLinks :: [Text]

1126+ , endpointAliases :: [Text]

1127+ , endpointNetworkID :: Maybe Text

1128+ , endpointEndpointID :: Maybe Text

1129+ , endpointGateway :: Maybe Text

1130+ , endpointIPAddress :: Maybe Text

1131+ , endpointIPPrefixLen :: Maybe Int

1132+ , endpointIPv6Gateway :: Maybe Text

1133+ , endpointGlobalIPv6Address :: Maybe Text

1134+ , endpointGlobalIPv6PrefixLen :: Maybe Int

1135+ , endpointMacAddress :: Maybe Text

1136+ } deriving (Eq, Show, Generic)

1137+

1138+instance ToJSON EndpointSettings where

1139+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 8 }

1140+

1141+defaultEndpointSettings :: EndpointSettings

1142+defaultEndpointSettings = EndpointSettings defaultIPAMSettings [] [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

1143+

1144+data IPAMSettings = IPAMSettings

1145+ { ipamIPv4Address :: Maybe Text

1146+ , ipamIPv6Address :: Maybe Text

1147+ , ipamLinkLocalIPs :: [Text]

1148+ } deriving (Eq, Show, Generic)

1149+

1150+instance ToJSON IPAMSettings where

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

1152+

1153+defaultIPAMSettings :: IPAMSettings

1154+defaultIPAMSettings = IPAMSettings Nothing Nothing []

860

1155

861-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")

1156-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")

862-- | Set permissions on volumes that you mount in the container.

1157-- | Set permissions on volumes that you mount in the container.

@@ -1027,11 +1322,14 @@ instance FromJSON NetworkMode where

1027 parseJSON (JSON.String n) = return $ NetworkNamed n

1322 parseJSON (JSON.String n) = return $ NetworkNamed n

1028 parseJSON _ = fail "Unknown NetworkMode"

1323 parseJSON _ = fail "Unknown NetworkMode"

1029

1324

1325+fromNetworkMode :: NetworkMode -> Text

1326+fromNetworkMode NetworkBridge = "bridge"

1327+fromNetworkMode NetworkHost = "host"

1328+fromNetworkMode NetworkDisabled = "none"

1329+fromNetworkMode (NetworkNamed n) = n

1330+

1030instance ToJSON NetworkMode where

1331instance ToJSON NetworkMode where

1031− toJSON NetworkBridge = JSON.String "bridge"

1332+ toJSON = JSON.String . fromNetworkMode

1032− toJSON NetworkHost = JSON.String "host"

1033− toJSON NetworkDisabled = JSON.String "none"

1034− toJSON (NetworkNamed n) = JSON.String n

1035

1333

1036newtype NetworkID = NetworkID Text

1334newtype NetworkID = NetworkID Text

1037 deriving (Eq, Show)

1335 deriving (Eq, Show)

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

@@ -144,6 +145,63 @@ testCreateRemoveNetwork = do

144 removeStatus <- removeNetwork nid

145 removeStatus <- removeNetwork nid

145 lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus

146 lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus

146

147

148+testListNetworks :: IO ()

149+testListNetworks =

150+ runDocker $ do

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"

155+

156+testInspectNetwork :: IO ()

157+testInspectNetwork =

158+ runDocker $ do

159+ res <- inspectNetwork . fromJust $ toNetworkID "bridge"

160+ lift $ assertBool ("inspecting networks, unexpected status: " ++ show res) $ isRight res

161+

162+testConnectNetwork :: IO ()

163+testConnectNetwork =

164+ runDocker $ do

165+ containerId <- fromRight =<< createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing

166+ networkId <- fromRight =<< createNetwork (defaultCreateNetworkOpts "mynetwork")

167+ res <- connectNetwork networkId . defaultConnectConfig $ fromContainerID containerId

168+ lift $ assertBool ("connecting network, unexpected status: " ++ show res) $ isRight res

169+ details <- fromRight =<< inspectContainer containerId

170+ _ <- deleteContainer defaultContainerDeleteOpts containerId

171+ _ <- removeNetwork networkId

172+ let networks = networkMode <$> (networkSettingsNetworks . networkSettings) details

173+ lift $ assertBool "connecting network failed" $ NetworkNamed "mynetwork" `elem` networks

174+ where

175+ networkMode (Network mode _) = mode

176+

177+testDisconnectNetwork :: IO ()

178+testDisconnectNetwork =

179+ runDocker $ do

180+ containerId <- fromRight =<< createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing

181+ res <- disconnectNetwork (fromJust $ toNetworkID "bridge") (defaultDisconnectConfig $ fromContainerID containerId)

182+ lift $ assertBool ("disconnecting network, unexpected status: " ++ show res) $ isRight res

183+ details <- fromRight =<< inspectContainer containerId

184+ _ <- deleteContainer defaultContainerDeleteOpts containerId

185+ let networks = networkMode <$> (networkSettingsNetworks . networkSettings) details

186+ lift $ assertBool "disconnecting network failed" $ null networks

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+

147testLogDriverOptionsJson :: TestTree

205testLogDriverOptionsJson :: TestTree

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

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

149 where

207 where

@@ -236,6 +294,17 @@ testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSample

236 ]

294 ]

237 ]

295 ]

238

296

297+testDisconnectConfigJson :: TestTree

298+testDisconnectConfigJson = testGroup "Testing DisconnectConfig JSON" [testSampleEncode]

299+ where

300+ testSampleEncode =

301+ let config = DisconnectConfig "mycontainer" True

302+ in testCase "Test toJSON" $ assert $ JSON.toJSON config ==

303+ JSON.object

304+ [ "Container" .= ("mycontainer" :: Text)

305+ , "Force" .= True

306+ ]

307+

239integrationTests :: TestTree

308integrationTests :: TestTree

240integrationTests =

309integrationTests =

241 testGroup

310 testGroup

@@ -249,6 +318,11 @@ integrationTests =

249 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking

318 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking

250 , testCase "Try to stop a container that doesn't exist" testStopNonexisting

319 , testCase "Try to stop a container that doesn't exist" testStopNonexisting

251 , testCase "Create and remove a network" testCreateRemoveNetwork

320 , testCase "Create and remove a network" testCreateRemoveNetwork

321+ , testCase "List networks" testListNetworks

322+ , testCase "Inspect a network" testInspectNetwork

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

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

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

252 ]

326 ]

253

327

254jsonTests :: TestTree

328jsonTests :: TestTree

@@ -262,6 +336,7 @@ jsonTests =

262 , testEntrypointJson

336 , testEntrypointJson

263 , testEnvVarJson

337 , testEnvVarJson

264 , testNetworkingConfigJson

338 , testNetworkingConfigJson

339+ , testDisconnectConfigJson

265 ]

340 ]

266

341

267setup :: IO ()

342setup :: IO ()