master..1147188 · docker-hs

git.iko.soy/docker-hs

on 1147188 help sign in

.travis.yml−4

since splitsnapshots

unifiedsplit

@@ -43,10 +43,6 @@ env:

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

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

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

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

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

49−

50addons:

46addons:

51 apt:

47 apt:

52 packages:

48 packages:

CHANGELOG.md−6

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

1# CHANGELOG

3−## 0.6.0.3 (2020-02-17)

4−

5−- Support for ghc 8.8.2.

6−- Bump dependency version.

7−- Use MonadFail for later versions.

8−

9## 0.6.0.1 (2019-05-23)

3## 0.6.0.1 (2019-05-23)

11- Support ghc 8.6.4.

5- Support ghc 8.6.4.

docker.cabal+4−4

@@ -1,5 +1,5 @@

1name: docker

2−version: 0.6.0.3

2+version: 0.6.0.2

3synopsis: An API client for docker written in Haskell

4description: See API documentation below.

5homepage: https://github.com/denibertovic/docker-hs

@@ -30,7 +30,7 @@ library

30 , bytestring >= 0.10.0 && < 0.11.0

31 , containers >= 0.5.0 && < 0.7.0

32 , data-default-class >= 0.0.1 && < 0.2.0

33− , http-client >= 0.4.0 && < 0.7.0

33+ , http-client >= 0.4.0 && < 0.6.0

34 , http-types >= 0.9 && < 0.13

35 , vector

36 , conduit

@@ -51,9 +51,9 @@ library

51 , mtl >= 2.0.0 && < 3.0.0

52 , network >= 2.6.0

53 , text >= 1.0.0 && < 2.0.0

54− , time >= 1.5.0 && < 2.0.0

54+ , time >= 1.5.0 && < 1.9.0

55 , scientific >= 0.3.0 && < 0.4.0

56− , tls >= 1.3.7 && < 1.6.0

56+ , tls >= 1.3.7 && < 1.5.0

57 , unordered-containers >= 0.2.0 && < 0.3.0

58 , x509 >= 1.6.0 && < 1.8.0

59 , x509-store >= 1.6.0 && < 1.8.0

src/Docker/Client/Api.hs+19

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

24 -- * Network

25 , createNetwork

26 , removeNetwork

27+ , listNetworks

28+ , inspectNetwork

29+ , connectNetwork

30+ , disconnectNetwork

27 -- * Other

31 -- * Other

28 , getDockerVersion

32 , getDockerVersion

29 ) where

33 ) where

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

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

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

226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

230removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

227

231

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

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

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

235+

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

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

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

239+

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

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

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

243+

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

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

246+disconnectNetwork nid cfg = requestUnit POST $ DisconnectNetworkEndpoint nid cfg

src/Docker/Client/Http.hs+20

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

src/Docker/Client/Internal.hs+21−12

@@ -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,10 @@ 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 nfs) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nfs)]

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

82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

87getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

83getEndpointRequestBody VersionEndpoint = Nothing

88getEndpointRequestBody VersionEndpoint = Nothing

@@ -101,6 +106,10 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing

101

106

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

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

103getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

108getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

109+getEndpointRequestBody (ListNetworksEndpoint _) = Nothing

110+getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing

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

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

104

113

105getEndpointContentType :: Endpoint -> BSC.ByteString

114getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

src/Docker/Client/Types.hs+233−8

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

76 , HostConfig(..)

77 , defaultHostConfig

78 , NetworkingConfig(..)

79+ , NetworkScope(..)

80+ , CIDR(..)

81+ , IPAMDriver(..)

82+ , IPAMConfig(..)

83+ , IPAM(..)

84+ , NetworkContainer(..)

85+ , NetworkDetails(..)

86+ , NetworkType(..)

87+ , NetworkName

88+ , NetworkFilter(..)

89+ , ConnectConfig(..)

90+ , defaultConnectConfig

91+ , DisconnectConfig(..)

92+ , defaultDisconnectConfig

93+ , EndpointSettings(..)

94+ , defaultEndpointSettings

95+ , IPAMSettings(..)

96+ , defaultIPAMSettings

79 , EndpointConfig(..)

97 , EndpointConfig(..)

80 , Ulimit(..)

98 , Ulimit(..)

81 , ContainerResources(..)

99 , ContainerResources(..)

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

114import Data.Time.Clock (UTCTime)

132import Data.Time.Clock (UTCTime)

115import qualified Data.Vector as V

133import qualified Data.Vector as V

116import GHC.Generics (Generic)

134import GHC.Generics (Generic)

135+import Numeric (readDec)

117import Prelude hiding (all, tail)

136import Prelude hiding (all, tail)

118import Text.Read (readMaybe)

137import Text.Read (readMaybe)

119

138

@@ -139,6 +158,10 @@ data Endpoint =

139 | DeleteImageEndpoint ImageDeleteOpts ImageID

158 | DeleteImageEndpoint ImageDeleteOpts ImageID

140 | CreateNetworkEndpoint CreateNetworkOpts

159 | CreateNetworkEndpoint CreateNetworkOpts

141 | RemoveNetworkEndpoint NetworkID

160 | RemoveNetworkEndpoint NetworkID

161+ | ListNetworksEndpoint [NetworkFilter]

162+ | InspectNetworkEndpoint NetworkID

163+ | ConnectNetworkEndpoint NetworkID ConnectConfig

164+ | DisconnectNetworkEndpoint NetworkID DisconnectConfig

142 deriving (Eq, Show)

165 deriving (Eq, Show)

143

166

144-- | We should newtype this

167-- | We should newtype this

@@ -858,6 +881,209 @@ instance ToJSON CreateNetworkOpts where

858 , "EnableIPv6" .= createNetworkEnableIPv6 opts

881 , "EnableIPv6" .= createNetworkEnableIPv6 opts

859 ]

882 ]

860

883

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

885+

886+fromNetworkScope :: NetworkScope -> Text

887+fromNetworkScope LocalScope = "local"

888+fromNetworkScope GlobalScope = "global"

889+fromNetworkScope SwarmScope = "swarm"

890+

891+instance ToJSON NetworkScope where

892+ toJSON = JSON.String . fromNetworkScope

893+

894+instance FromJSON NetworkScope where

895+ parseJSON "local" = return LocalScope

896+ parseJSON "global" = return GlobalScope

897+ parseJSON "swarm" = return SwarmScope

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

899+

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

901+

902+instance FromJSON CIDR where

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

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

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

906+ where

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

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

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

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

911+

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

913+

914+instance FromJSON IPAMDriver where

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

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

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

918+

919+data IPAMConfig = IPAMConfig

920+ { ipamConfigSubnet :: CIDR

921+ , ipamConfigIPRange :: Maybe CIDR

922+ , ipamSubnetGateway :: Maybe Text

923+ , ipamConfigAuxAddress :: Maybe Text

924+ } deriving (Eq, Show)

925+

926+instance FromJSON IPAMConfig where

927+ parseJSON (JSON.Object o) = IPAMConfig

928+ <$> o .: "Subnet"

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

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

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

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

933+

934+data IPAM = IPAM

935+ { ipamDriver :: IPAMDriver

936+ , ipamConfig :: [IPAMConfig]

937+ , ipamOptions :: HM.HashMap Text Text

938+ } deriving (Eq, Show)

939+

940+instance FromJSON IPAM where

941+ parseJSON (JSON.Object o) = IPAM

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

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

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

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

946+

947+data NetworkContainer = NetworkContainer

948+ { networkContainerName :: ContainerName

949+ , networkContainerEndpointID :: Text

950+ , networkContainerMacAddress :: Text

951+ , networkContainerIPv4Address :: Text

952+ , networkContainerIPv6Address :: Text

953+ } deriving (Eq, Show)

954+

955+instance FromJSON NetworkContainer where

956+ parseJSON (JSON.Object o) = NetworkContainer

957+ <$> o .: "Name"

958+ <*> o .: "EndpointID"

959+ <*> o .: "MacAddress"

960+ <*> o .: "IPv4Address"

961+ <*> o .: "IPv6Address"

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

963+

964+data NetworkDetails = NetworkDetails

965+ { networkDetailsName :: Text

966+ , networkDetailsID :: NetworkID

967+ , networkDetailsCreated :: UTCTime

968+ , networkDetailsScope :: NetworkScope

969+ , networkDetailsDriver :: NetworkMode

970+ , networkDetailsEnableIPv6 :: Bool

971+ , networkDetailsInternal :: Bool

972+ , networkDetailsAttachable :: Bool

973+ , networkDetailsIngress :: Bool

974+ , networkDetailsIPAM :: IPAM

975+ , networkDetailsOptions :: HM.HashMap Text Text

976+ , networkDetailsLabels :: HM.HashMap Text Text

977+ , networkDetailsContainers :: HM.HashMap Text NetworkContainer

978+ } deriving (Eq, Show)

979+

980+instance FromJSON NetworkDetails where

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

982+ <$> o .: "Name"

983+ <*> parseJSON v

984+ <*> o .: "Created"

985+ <*> o .: "Scope"

986+ <*> o .: "Driver"

987+ <*> o .: "EnableIPv6"

988+ <*> o .: "Internal"

989+ <*> o .: "Attachable"

990+ <*> o .: "Ingress"

991+ <*> o .: "IPAM"

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

993+ <*> o .:? "Labels" .!= HM.empty

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

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

996+

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

998+

999+fromNetworkType :: NetworkType -> Text

1000+fromNetworkType BuiltinNetwork = "builtin"

1001+fromNetworkType CustomNetwork = "custom"

1002+

1003+type NetworkName = Text

1004+

1005+instance ToJSON NetworkType where

1006+ toJSON = JSON.String . fromNetworkType

1007+

1008+instance FromJSON NetworkType where

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

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

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

1012+

1013+data NetworkFilter

1014+ = NetworkFilterName Text

1015+ | NetworkFilterID NetworkID

1016+ | NetworkFilterLabel Text

1017+ | NetworkFilterDriver NetworkMode

1018+ | NetworkFilterScope NetworkScope

1019+ | NetworkFilterType NetworkType

1020+ deriving (Eq, Show)

1021+

1022+instance {-# OVERLAPPING #-} ToJSON [NetworkFilter] where

1023+ toJSON = object . fmap toKV

1024+ where

1025+ toKV (NetworkFilterName n) = "name" .= [n]

1026+ toKV (NetworkFilterID i) = "id" .= [fromNetworkID i]

1027+ toKV (NetworkFilterLabel l) = "label" .= [l]

1028+ toKV (NetworkFilterDriver d) = "driver" .= [fromNetworkMode d]

1029+ toKV (NetworkFilterScope s) = "scope" .= [fromNetworkScope s]

1030+ toKV (NetworkFilterType t) = "type" .= [fromNetworkType t]

1031+

1032+data ConnectConfig = ConnectConfig

1033+ { connectContainer :: Text

1034+ , connectEndpointConfig :: EndpointSettings

1035+ } deriving (Eq, Show, Generic)

1036+

1037+instance ToJSON ConnectConfig where

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

1039+

1040+defaultConnectConfig :: Text -> ConnectConfig

1041+defaultConnectConfig = flip ConnectConfig defaultEndpointSettings

1042+

1043+data DisconnectConfig = DisconnectConfig

1044+ { disconnectContainer :: Text

1045+ , disconnectForce :: Bool

1046+ } deriving (Eq, Show, Generic)

1047+

1048+instance ToJSON DisconnectConfig where

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

1050+

1051+defaultDisconnectConfig :: Text -> DisconnectConfig

1052+defaultDisconnectConfig = flip DisconnectConfig False

1053+

1054+data EndpointSettings = EndpointSettings

1055+ { endpointIPAMConfig :: IPAMSettings

1056+ , endpointLinks :: [Text]

1057+ , endpointAliases :: [Text]

1058+ , endpointNetworkID :: Maybe Text

1059+ , endpointEndpointID :: Maybe Text

1060+ , endpointGateway :: Maybe Text

1061+ , endpointIPAddress :: Maybe Text

1062+ , endpointIPPrefixLen :: Maybe Int

1063+ , endpointIPv6Gateway :: Maybe Text

1064+ , endpointGlobalIPv6Address :: Maybe Text

1065+ , endpointGlobalIPv6PrefixLen :: Maybe Int

1066+ , endpointMacAddress :: Maybe Text

1067+ } deriving (Eq, Show, Generic)

1068+

1069+instance ToJSON EndpointSettings where

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

1071+

1072+defaultEndpointSettings :: EndpointSettings

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

1074+

1075+data IPAMSettings = IPAMSettings

1076+ { ipamIPv4Address :: Maybe Text

1077+ , ipamIPv6Address :: Maybe Text

1078+ , ipamLinkLocalIPs :: [Text]

1079+ } deriving (Eq, Show, Generic)

1080+

1081+instance ToJSON IPAMSettings where

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

1083+

1084+defaultIPAMSettings :: IPAMSettings

1085+defaultIPAMSettings = IPAMSettings Nothing Nothing []

1086+

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

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

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

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

863data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)

1089data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)

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

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

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

1028 parseJSON _ = fail "Unknown NetworkMode"

1254 parseJSON _ = fail "Unknown NetworkMode"

1029

1255

1256+fromNetworkMode :: NetworkMode -> Text

1257+fromNetworkMode NetworkBridge = "bridge"

1258+fromNetworkMode NetworkHost = "host"

1259+fromNetworkMode NetworkDisabled = "none"

1260+fromNetworkMode (NetworkNamed n) = n

1261+

1030instance ToJSON NetworkMode where

1262instance ToJSON NetworkMode where

1031− toJSON NetworkBridge = JSON.String "bridge"

1263+ toJSON = JSON.String . fromNetworkMode

1032− toJSON NetworkHost = JSON.String "host"

1033− toJSON NetworkDisabled = JSON.String "none"

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

1035

1264

1036newtype NetworkID = NetworkID Text

1265newtype NetworkID = NetworkID Text

1037 deriving (Eq, Show)

1266 deriving (Eq, Show)

@@ -1564,11 +1793,7 @@ instance FromJSON ContainerConfig where

1564 macAddress labels stopSignal

1793 macAddress labels stopSignal

1565 parseJSON _ = fail "NetworkSettings is not an object."

1794 parseJSON _ = fail "NetworkSettings is not an object."

1566

1795

1567−#if MIN_VERSION_base(4,13,0)

1568−parseIntegerText :: (MonadFail m) => Text -> m Integer

1569−#else

1570parseIntegerText :: (Monad m) => Text -> m Integer

1796parseIntegerText :: (Monad m) => Text -> m Integer

1571−#endif

1572parseIntegerText t = case readMaybe $ T.unpack t of

1797parseIntegerText t = case readMaybe $ T.unpack t of

1573 Nothing ->

1798 Nothing ->

1574 fail "Could not parse Integer"

1799 fail "Could not parse Integer"

stack-7.10.yaml−1

@@ -14,7 +14,6 @@ flags: {}

14extra-deps:

15- directory-1.2.7.0

16- unliftio-core-0.1.1.0

17−- process-1.6.5.1

19# Control whether we use the GHC we find on the path

18# Control whether we use the GHC we find on the path

20# system-ghc: true

19# system-ghc: true

stack-8.8.2.yamldeleted−5

@@ -1,5 +0,0 @@

1−resolver: lts-15.0

2−packages:

3−- '.'

4−extra-deps: []

5−

tests/tests.hs+58

@@ -144,6 +144,48 @@ testCreateRemoveNetwork = do

144 removeStatus <- removeNetwork nid

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

146

147+testListNetworks :: IO ()

148+testListNetworks =

149+ runDocker $ do

150+ res <- listNetworks [NetworkFilterName "bridge"]

151+ lift $ case res of

152+ Left _ -> assertFailure $ "listing networks, unexpected status: " ++ show res

153+ Right (d:_) -> assertBool "listing networks, bridge network missing" $ networkDetailsName d == "bridge"

154+

155+testInspectNetwork :: IO ()

156+testInspectNetwork =

157+ runDocker $ do

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

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

160+

161+testConnectNetwork :: IO ()

162+testConnectNetwork =

163+ runDocker $ do

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

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

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

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

168+ details <- fromRight =<< inspectContainer containerId

169+ _ <- deleteContainer defaultContainerDeleteOpts containerId

170+ _ <- removeNetwork networkId

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

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

173+ where

174+ networkMode (Network mode _) = mode

175+

176+testDisconnectNetwork :: IO ()

177+testDisconnectNetwork =

178+ runDocker $ do

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

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

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

182+ details <- fromRight =<< inspectContainer containerId

183+ _ <- deleteContainer defaultContainerDeleteOpts containerId

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

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

186+ where

187+ networkMode (Network mode _) = mode

188+

147testLogDriverOptionsJson :: TestTree

189testLogDriverOptionsJson :: TestTree

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

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

149 where

191 where

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

236 ]

278 ]

237 ]

279 ]

238

280

281+testDisconnectConfigJson :: TestTree

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

283+ where

284+ testSampleEncode =

285+ let config = DisconnectConfig "mycontainer" True

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

287+ JSON.object

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

289+ , "Force" .= True

290+ ]

291+

239integrationTests :: TestTree

292integrationTests :: TestTree

240integrationTests =

293integrationTests =

241 testGroup

294 testGroup

@@ -249,6 +302,10 @@ integrationTests =

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

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

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

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

251 , testCase "Create and remove a network" testCreateRemoveNetwork

304 , testCase "Create and remove a network" testCreateRemoveNetwork

305+ , testCase "List networks" testListNetworks

306+ , testCase "Inspect a network" testInspectNetwork

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

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

252 ]

309 ]

253

310

254jsonTests :: TestTree

311jsonTests :: TestTree

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

262 , testEntrypointJson

319 , testEntrypointJson

263 , testEnvVarJson

320 , testEnvVarJson

264 , testNetworkingConfigJson

321 , testNetworkingConfigJson

322+ , testDisconnectConfigJson

265 ]

323 ]

266

324

267setup :: IO ()

325setup :: IO ()