040f3fa..master · docker-hs

git.iko.soy/docker-hs

on master help sign in

.travis.yml+24−29

since splitsnapshots

unifiedsplit

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

1sudo: required

2−dist: bionic

2+dist: trusty

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,42 +27,37 @@ env:

27 - STACK_ARGS=""

29 matrix:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

48+ - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" 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

59before_install:

55before_install:

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

56+ # Upgrade docker to 1.12.3.0

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

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

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

62 - sudo apt-get update

59 - sudo apt-get update

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

64−

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

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

67install:

62install:

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

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

src/Docker/Client/Api.hs−24

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

24 -- * Network

25 , createNetwork

26 , removeNetwork

27− , listNetworks

28− , inspectNetwork

29− , connectNetwork

30− , disconnectNetwork

31− , pruneNetworks

32 -- * Other

27 -- * Other

33 , getDockerVersion

28 , getDockerVersion

34 ) where

29 ) where

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

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

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

231removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

232

227

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,28 +288,3 @@ 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+13−23

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

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.ByteString.Lazy.Char8 as BSLC

7+import qualified Data.Conduit.Binary as CB

8−import qualified Data.Conduit.Binary as CB

9−import qualified Data.Text as T

8+import qualified Data.Text as T

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

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

11−import qualified Network.HTTP.Client as HTTP

10+import qualified Network.HTTP.Client as HTTP

12−import Network.HTTP.Conduit (requestBodySourceChunked)

11+import Network.HTTP.Conduit (requestBodySourceChunked)

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

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

14− encodePathSegments)

13+ encodePathSegments)

15−import Prelude hiding (all)

14+import Prelude hiding (all)

17import Docker.Client.Types

16import Docker.Client.Types

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

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

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

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

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

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

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

88getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

89getEndpointRequestBody VersionEndpoint = Nothing

83getEndpointRequestBody VersionEndpoint = Nothing

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

107

101

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

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

109getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

103getEndpointRequestBody (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

115

104

116getEndpointContentType :: Endpoint -> BSC.ByteString

105getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

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

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

108+

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

@@ -76,29 +76,6 @@ 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

102 , EndpointConfig(..)

79 , EndpointConfig(..)

103 , Ulimit(..)

80 , Ulimit(..)

104 , ContainerResources(..)

81 , ContainerResources(..)

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

123 , MemoryConstraintSize(..)

100 , MemoryConstraintSize(..)

124 ) where

101 ) where

125

102

126−import Control.Monad (join)

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

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

128 genericToJSON, object, parseJSON, toJSON,

104 genericToJSON, object, parseJSON, toJSON,

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

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

130import qualified Data.Aeson as JSON

106import qualified Data.Aeson as JSON

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

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

132import Data.Char (isAlphaNum, toUpper)

108import Data.Char (isAlphaNum, toUpper)

133import qualified Data.HashMap.Strict as HM

109import qualified Data.HashMap.Strict as HM

134−import Data.Maybe (maybeToList, catMaybes)

135import Data.Monoid ((<>))

110import Data.Monoid ((<>))

136import Data.Scientific (floatingOrInteger)

111import Data.Scientific (floatingOrInteger)

137import Data.Text (Text)

112import Data.Text (Text)

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

139import Data.Time.Clock (UTCTime)

114import Data.Time.Clock (UTCTime)

140import qualified Data.Vector as V

115import qualified Data.Vector as V

141import GHC.Generics (Generic)

116import GHC.Generics (Generic)

142−import Numeric (readDec)

143import Prelude hiding (all, tail)

117import Prelude hiding (all, tail)

144import Text.Read (readMaybe)

118import Text.Read (readMaybe)

145

119

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

165 | DeleteImageEndpoint ImageDeleteOpts ImageID

139 | DeleteImageEndpoint ImageDeleteOpts ImageID

166 | CreateNetworkEndpoint CreateNetworkOpts

140 | CreateNetworkEndpoint CreateNetworkOpts

167 | RemoveNetworkEndpoint NetworkID

141 | RemoveNetworkEndpoint NetworkID

168− | ListNetworksEndpoint NetworkFilter

169− | InspectNetworkEndpoint NetworkID

170− | ConnectNetworkEndpoint NetworkID ConnectConfig

171− | DisconnectNetworkEndpoint NetworkID DisconnectConfig

172− | PruneNetworksEndpoint PruneFilter

173 deriving (Eq, Show)

142 deriving (Eq, Show)

174

143

175-- | We should newtype this

144-- | We should newtype this

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

861

830

862-- | Options for creating a network

831-- | Options for creating a network

863data CreateNetworkOpts = CreateNetworkOpts

832data CreateNetworkOpts = CreateNetworkOpts

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

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

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

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

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

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

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

836+ , 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.

837+ , 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)

838+ } deriving (Eq, Show)

875

839

876-- | Sensible defalut for create network options

840-- | Sensible defalut for create network options

877defaultCreateNetworkOpts :: Text -> CreateNetworkOpts

841defaultCreateNetworkOpts :: Text -> CreateNetworkOpts

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

879 CreateNetworkOpts

843 CreateNetworkOpts

880 { createNetworkName = name

844 { createNetworkName = name

881 , createNetworkCheckDuplicate = False

845 , createNetworkCheckDuplicate = False

882− , createNetworkDriver = NetworkBridge

846+ , createNetworkDriver = "bridge"

883 , createNetworkInternal = True

847 , createNetworkInternal = True

884− , createNetworkAttachable = False

885− , createNetworkIngress = False

886− , createNetworkIPAM = defaultIPAM

887 , createNetworkEnableIPv6 = False

848 , createNetworkEnableIPv6 = False

888− , createNetworkOptions = HM.empty

889− , createNetworkLabels = []

890 }

849 }

891

850

892instance ToJSON CreateNetworkOpts where

851instance ToJSON CreateNetworkOpts where

893− toJSON = genericToJSON defaultOptions

852+ toJSON opts =

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

853+ object

895−

854+ [ "Name" .= createNetworkName opts

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

855+ , "CheckDuplicate" .= createNetworkCheckDuplicate opts

897−

856+ , "Driver" .= createNetworkDriver opts

898−fromNetworkScope :: NetworkScope -> Text

857+ , "Internal" .= createNetworkInternal opts

899−fromNetworkScope LocalScope = "local"

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"

858+ , "EnableIPv6" .= createNetworkEnableIPv6 opts

1018− <*> o .: "Internal"

859+ ]

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

1155

860

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

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

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

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

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

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

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

1323 parseJSON _ = fail "Unknown NetworkMode"

1028 parseJSON _ = fail "Unknown NetworkMode"

1324

1029

1325−fromNetworkMode :: NetworkMode -> Text

1326−fromNetworkMode NetworkBridge = "bridge"

1327−fromNetworkMode NetworkHost = "host"

1328−fromNetworkMode NetworkDisabled = "none"

1329−fromNetworkMode (NetworkNamed n) = n

1330−

1331instance ToJSON NetworkMode where

1030instance ToJSON NetworkMode where

1332− toJSON = JSON.String . fromNetworkMode

1031+ toJSON NetworkBridge = JSON.String "bridge"

1032+ toJSON NetworkHost = JSON.String "host"

1033+ toJSON NetworkDisabled = JSON.String "none"

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

1333

1035

1334newtype NetworkID = NetworkID Text

1036newtype NetworkID = NetworkID Text

1335 deriving (Eq, Show)

1037 deriving (Eq, Show)

tests/tests.hs+1−76

@@ -11,7 +11,7 @@ import Test.Tasty.QuickCheck (testProperty)

12import Control.Concurrent (threadDelay)

13import Control.Lens ((^.), (^?))

14−import Control.Monad (forM_, when, (<=<))

14+import Control.Monad (forM_)

15import Control.Monad.IO.Class

16import Control.Monad.Trans.Class (lift)

17import qualified Data.Aeson as JSON

@@ -23,7 +23,6 @@ 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 ((\\))

27import qualified Data.Map as M

26import qualified Data.Map as M

28import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)

27import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)

29import Data.Monoid

28import Data.Monoid

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

145 removeStatus <- removeNetwork nid

144 removeStatus <- removeNetwork nid

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

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

147

146

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−

205testLogDriverOptionsJson :: TestTree

147testLogDriverOptionsJson :: TestTree

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

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

207 where

149 where

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

294 ]

236 ]

295 ]

237 ]

296

238

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−

308integrationTests :: TestTree

239integrationTests :: TestTree

309integrationTests =

240integrationTests =

310 testGroup

241 testGroup

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

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

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

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

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

320 , testCase "Create and remove a network" testCreateRemoveNetwork

251 , 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

326 ]

252 ]

327

253

328jsonTests :: TestTree

254jsonTests :: TestTree

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

336 , testEntrypointJson

262 , testEntrypointJson

337 , testEnvVarJson

263 , testEnvVarJson

338 , testNetworkingConfigJson

264 , testNetworkingConfigJson

339− , testDisconnectConfigJson

340 ]

265 ]

341

266

342setup :: IO ()

267setup :: IO ()