on master help sign in
10 files changed+42−415
since splitsnapshots
unifiedsplit
.travis.yml+4 CHANGELOG.md+6 docker.cabal+4−4 src/Docker/Client/Api.hs−24 src/Docker/Client/Http.hs−25 src/Docker/Client/Internal.hs+13−23 src/Docker/Client/Types.hs+8−279 stack-7.10.yaml+1 stack-8.8.2.yaml+5 tests/tests.hs+1−60
.travis.yml+4
@@ -43,6 +43,10 @@ env:
4343 - DOCKER_VERSION="1.13.1-0~ubuntu-trusty" GHCVER=8.6.4
4444 - DOCKER_VERSION="17.05.0~ce-0~ubuntu-trusty" GHCVER=8.6.4
4545
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+
4650addons:
4751 apt:
4852 packages:
CHANGELOG.md+6
@@ -1,5 +1,11 @@
11# CHANGELOG
22
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+
39## 0.6.0.1 (2019-05-23)
410
511- Support ghc 8.6.4.
docker.cabal+4−4
@@ -1,5 +1,5 @@
11name: docker
2−version: 0.6.0.2
2+version: 0.6.0.3
33synopsis: An API client for docker written in Haskell
44description: See API documentation below.
55homepage: https://github.com/denibertovic/docker-hs
@@ -30,7 +30,7 @@ library
3030 , bytestring >= 0.10.0 && < 0.11.0
3131 , containers >= 0.5.0 && < 0.7.0
3232 , data-default-class >= 0.0.1 && < 0.2.0
33− , http-client >= 0.4.0 && < 0.6.0
33+ , http-client >= 0.4.0 && < 0.7.0
3434 , http-types >= 0.9 && < 0.13
3535 , vector
3636 , conduit
@@ -51,9 +51,9 @@ library
5151 , mtl >= 2.0.0 && < 3.0.0
5252 , network >= 2.6.0
5353 , text >= 1.0.0 && < 2.0.0
54− , time >= 1.5.0 && < 1.9.0
54+ , time >= 1.5.0 && < 2.0.0
5555 , scientific >= 0.3.0 && < 0.4.0
56− , tls >= 1.3.7 && < 1.5.0
56+ , tls >= 1.3.7 && < 1.6.0
5757 , unordered-containers >= 0.2.0 && < 0.3.0
5858 , x509 >= 1.6.0 && < 1.8.0
5959 , x509-store >= 1.6.0 && < 1.8.0
src/Docker/Client/Api.hs−24
@@ -24,11 +24,6 @@ module Docker.Client.Api (
2424 -- * Network
2525 , createNetwork
2626 , removeNetwork
27− , listNetworks
28− , inspectNetwork
29− , connectNetwork
30− , disconnectNetwork
31− , pruneNetworks
3227 -- * Other
3328 , getDockerVersion
3429 ) where
@@ -230,22 +225,3 @@ createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseR
230225removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())
231226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid
232227
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 =
288288 Nothing
289289 else
290290 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 @@
11module Docker.Client.Internal where
22
3−import Blaze.ByteString.Builder (toByteString)
4−import qualified Data.Aeson as JSON
5−import Data.ByteString (ByteString)
6−import qualified Data.ByteString.Char8 as BSC
7−import qualified Data.ByteString.Lazy.Char8 as BSLC
8−import qualified Data.Conduit.Binary as CB
9−import qualified Data.Text as T
10−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
11−import qualified Network.HTTP.Client as HTTP
12−import Network.HTTP.Conduit (requestBodySourceChunked)
13−import Network.HTTP.Types (Query, encodePath,
14− encodePathSegments)
15−import Prelude hiding (all)
3+import Blaze.ByteString.Builder (toByteString)
4+import qualified Data.Aeson as JSON
5+import Data.ByteString (ByteString)
6+import qualified Data.ByteString.Char8 as BSC
7+import qualified Data.Conduit.Binary as CB
8+import qualified Data.Text as T
9+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
10+import qualified Network.HTTP.Client as HTTP
11+import Network.HTTP.Conduit (requestBodySourceChunked)
12+import Network.HTTP.Types (Query, encodePath,
13+ encodePathSegments)
14+import Prelude hiding (all)
1615
1716import Docker.Client.Types
1817
@@ -79,11 +78,6 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images"
7978getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid]
8079getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"]
8180getEndpoint 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)]
8781
8882getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
8983getEndpointRequestBody VersionEndpoint = Nothing
@@ -107,12 +101,8 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing
107101
108102getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)
109103getEndpointRequestBody (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
115104
116105getEndpointContentType :: Endpoint -> BSC.ByteString
117106getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
118107getEndpointContentType _ = BSC.pack "application/json; charset=utf-8"
108+
src/Docker/Client/Types.hs+8−279
@@ -76,28 +76,6 @@ module Docker.Client.Types (
7676 , HostConfig(..)
7777 , defaultHostConfig
7878 , NetworkingConfig(..)
79− , NetworkScope(..)
80− , CIDR(..)
81− , IPAMDriver(..)
82− , IPAMConfig(..)
83− , IPAM(..)
84− , NetworkContainer(..)
85− , NetworkDetails(..)
86− , NetworkType(..)
87− , NetworkName
88− , NetworkFilter(..)
89− , defaultNetworkFilter
90− , ConnectConfig(..)
91− , defaultConnectConfig
92− , DisconnectConfig(..)
93− , defaultDisconnectConfig
94− , PruneFilter(..)
95− , defaultPruneFilter
96− , NetworksDeleted(..)
97− , EndpointSettings(..)
98− , defaultEndpointSettings
99− , IPAMSettings(..)
100− , defaultIPAMSettings
10179 , EndpointConfig(..)
10280 , Ulimit(..)
10381 , ContainerResources(..)
@@ -122,7 +100,6 @@ module Docker.Client.Types (
122100 , MemoryConstraintSize(..)
123101 ) where
124102
125−import Control.Monad (join)
126103import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
127104 genericToJSON, object, parseJSON, toJSON,
128105 (.!=), (.:), (.:?), (.=))
@@ -130,7 +107,6 @@ import qualified Data.Aeson as JSON
130107import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
131108import Data.Char (isAlphaNum, toUpper)
132109import qualified Data.HashMap.Strict as HM
133−import Data.Maybe (maybeToList, catMaybes)
134110import Data.Monoid ((<>))
135111import Data.Scientific (floatingOrInteger)
136112import Data.Text (Text)
@@ -138,7 +114,6 @@ import qualified Data.Text as T
138114import Data.Time.Clock (UTCTime)
139115import qualified Data.Vector as V
140116import GHC.Generics (Generic)
141−import Numeric (readDec)
142117import Prelude hiding (all, tail)
143118import Text.Read (readMaybe)
144119
@@ -164,11 +139,6 @@ data Endpoint =
164139 | DeleteImageEndpoint ImageDeleteOpts ImageID
165140 | CreateNetworkEndpoint CreateNetworkOpts
166141 | RemoveNetworkEndpoint NetworkID
167− | ListNetworksEndpoint NetworkFilter
168− | InspectNetworkEndpoint NetworkID
169− | ConnectNetworkEndpoint NetworkID ConnectConfig
170− | DisconnectNetworkEndpoint NetworkID DisconnectConfig
171− | PruneNetworksEndpoint PruneFilter
172142 deriving (Eq, Show)
173143
174144-- | We should newtype this
@@ -888,248 +858,6 @@ instance ToJSON CreateNetworkOpts where
888858 , "EnableIPv6" .= createNetworkEnableIPv6 opts
889859 ]
890860
891−data NetworkScope = LocalScope | GlobalScope | SwarmScope deriving (Eq, Show)
892−
893−fromNetworkScope :: NetworkScope -> Text
894−fromNetworkScope LocalScope = "local"
895−fromNetworkScope GlobalScope = "global"
896−fromNetworkScope SwarmScope = "swarm"
897−
898−instance ToJSON NetworkScope where
899− toJSON = JSON.String . fromNetworkScope
900−
901−instance FromJSON NetworkScope where
902− parseJSON "local" = return LocalScope
903− parseJSON "global" = return GlobalScope
904− parseJSON "swarm" = return SwarmScope
905− parseJSON _ = fail "Failed to parse NetworkScope"
906−
907−data CIDR = CIDR Text Int deriving (Eq, Show)
908−
909−instance FromJSON CIDR where
910− parseJSON (JSON.String t) = case T.splitOn "/" t of
911− [a,p] -> CIDR a <$> parsePrefixLen p
912− _ -> fail "Failed to parse CIDR"
913− where
914− parsePrefixLen p = case readDec (T.unpack p) of
915− (n,""):_ -> return n
916− _ -> fail "Failed to parse CIDR prefix length"
917− parseJSON _ = fail "Failed to parse CIDR"
918−
919−data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show)
920−
921−instance FromJSON IPAMDriver where
922− parseJSON (JSON.String "default") = return DefaultIPAMDriver
923− parseJSON (JSON.String t) = return $ NamedIPAMDriver t
924− parseJSON _ = fail "IPAMDriver is not a string"
925−
926−data IPAMConfig = IPAMConfig
927− { ipamConfigSubnet :: CIDR
928− , ipamConfigIPRange :: Maybe CIDR
929− , ipamSubnetGateway :: Maybe Text
930− , ipamConfigAuxAddress :: Maybe Text
931− } deriving (Eq, Show)
932−
933−instance FromJSON IPAMConfig where
934− parseJSON (JSON.Object o) = IPAMConfig
935− <$> o .: "Subnet"
936− <*> o .:? "IPRange"
937− <*> o .:? "Gateway"
938− <*> o .:? "AuxAddress"
939− parseJSON _ = fail "IPAMConfig is not an object"
940−
941−data IPAM = IPAM
942− { ipamDriver :: IPAMDriver
943− , ipamConfig :: [IPAMConfig]
944− , ipamOptions :: HM.HashMap Text Text
945− } deriving (Eq, Show)
946−
947−instance FromJSON IPAM where
948− parseJSON (JSON.Object o) = IPAM
949− <$> o .:? "Driver" .!= DefaultIPAMDriver
950− <*> o .:? "Config" .!= []
951− <*> o .:? "Options" .!= HM.empty
952− parseJSON _ = fail "IPAM is not an object"
953−
954−data NetworkContainer = NetworkContainer
955− { networkContainerName :: ContainerName
956− , networkContainerEndpointID :: Text
957− , networkContainerMacAddress :: Text
958− , networkContainerIPv4Address :: Text
959− , networkContainerIPv6Address :: Text
960− } deriving (Eq, Show)
961−
962−instance FromJSON NetworkContainer where
963− parseJSON (JSON.Object o) = NetworkContainer
964− <$> o .: "Name"
965− <*> o .: "EndpointID"
966− <*> o .: "MacAddress"
967− <*> o .: "IPv4Address"
968− <*> o .: "IPv6Address"
969− parseJSON _ = fail "NetworkContainer is not an object"
970−
971−data NetworkDetails = NetworkDetails
972− { networkDetailsName :: Text
973− , networkDetailsID :: NetworkID
974− , networkDetailsCreated :: UTCTime
975− , networkDetailsScope :: NetworkScope
976− , networkDetailsDriver :: NetworkMode
977− , networkDetailsEnableIPv6 :: Bool
978− , networkDetailsInternal :: Bool
979− , networkDetailsAttachable :: Bool
980− , networkDetailsIngress :: Bool
981− , networkDetailsIPAM :: IPAM
982− , networkDetailsOptions :: HM.HashMap Text Text
983− , networkDetailsLabels :: HM.HashMap Text Text
984− , networkDetailsContainers :: HM.HashMap Text NetworkContainer
985− } deriving (Eq, Show)
986−
987−instance FromJSON NetworkDetails where
988− parseJSON v@(JSON.Object o) = NetworkDetails
989− <$> o .: "Name"
990− <*> parseJSON v
991− <*> o .: "Created"
992− <*> o .: "Scope"
993− <*> o .: "Driver"
994− <*> o .: "EnableIPv6"
995− <*> o .: "Internal"
996− <*> o .: "Attachable"
997− <*> o .: "Ingress"
998− <*> o .: "IPAM"
999− <*> o .:? "Options" .!= HM.empty
1000− <*> o .:? "Labels" .!= HM.empty
1001− <*> o .:? "Containers" .!= HM.empty
1002− parseJSON _ = fail "NetworkDetails is not an object"
1003−
1004−data NetworkType = BuiltinNetwork | CustomNetwork deriving (Eq, Show)
1005−
1006−fromNetworkType :: NetworkType -> Text
1007−fromNetworkType BuiltinNetwork = "builtin"
1008−fromNetworkType CustomNetwork = "custom"
1009−
1010−type NetworkName = Text
1011−
1012−instance ToJSON NetworkType where
1013− toJSON = JSON.String . fromNetworkType
1014−
1015−instance FromJSON NetworkType where
1016− parseJSON (JSON.String "builtin") = return BuiltinNetwork
1017− parseJSON (JSON.String "custom") = return CustomNetwork
1018− parseJSON _ = fail "Failed to parse NetworkType"
1019−
1020−data NetworkFilter = NetworkFilter
1021− { networkFilterNames :: [Text]
1022− , networkFilterIDs :: [NetworkID]
1023− , networkFilterDrivers :: [NetworkMode]
1024− , networkFilterScopes :: [NetworkScope]
1025− , networkFilterTypes :: [NetworkType]
1026− , networkFilterLabels :: [(Text, (Maybe Text))]
1027− } deriving (Eq, Show)
1028−
1029−instance ToJSON NetworkFilter where
1030− toJSON nf = object . catMaybes $
1031− [ "name" .=? networkFilterNames nf
1032− , "id" .=? (fromNetworkID <$> networkFilterIDs nf)
1033− , "driver" .=? (fromNetworkMode <$> networkFilterDrivers nf)
1034− , "scope" .=? (fromNetworkScope <$> networkFilterScopes nf)
1035− , "type" .=? (fromNetworkType <$> networkFilterTypes nf)
1036− , "label" .=? (constructLabel <$> networkFilterLabels nf)
1037− ]
1038− where
1039− _ .=? [] = Nothing
1040− k .=? l = Just $ k .= l
1041−
1042−constructLabel :: (Text, Maybe Text) -> Text
1043−constructLabel (k, Just v) = T.concat [k, "=", v]
1044−constructLabel (k, Nothing) = k
1045−
1046−defaultNetworkFilter :: NetworkFilter
1047−defaultNetworkFilter = NetworkFilter [] [] [] [] [] []
1048−
1049−data ConnectConfig = ConnectConfig
1050− { connectContainer :: Text
1051− , connectEndpointConfig :: EndpointSettings
1052− } deriving (Eq, Show, Generic)
1053−
1054−instance ToJSON ConnectConfig where
1055− toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 7 }
1056−
1057−defaultConnectConfig :: Text -> ConnectConfig
1058−defaultConnectConfig = flip ConnectConfig defaultEndpointSettings
1059−
1060−data DisconnectConfig = DisconnectConfig
1061− { disconnectContainer :: Text
1062− , disconnectForce :: Bool
1063− } deriving (Eq, Show, Generic)
1064−
1065−instance ToJSON DisconnectConfig where
1066− toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 10 }
1067−
1068−defaultDisconnectConfig :: Text -> DisconnectConfig
1069−defaultDisconnectConfig = flip DisconnectConfig False
1070−
1071−data PruneFilter = PruneFilter
1072− { pruneFilterUntil :: Maybe Text
1073− -- ^ Can be a Unix timestamp, a date-formatted timestamp, or a duration,
1074− -- such as @10m@ or @1h30m@.
1075− , pruneFilterIncludeLabels :: [(Text, (Maybe Text))]
1076− , pruneFilterExcludeLabels :: [(Text, (Maybe Text))]
1077− } deriving (Eq, Show)
1078−
1079−instance ToJSON PruneFilter where
1080− toJSON pf = object . catMaybes $
1081− [ "until" .=? maybeToList (pruneFilterUntil pf)
1082− , "label" .=? (constructLabel <$> pruneFilterIncludeLabels pf)
1083− , "label!" .=? (constructLabel <$> pruneFilterExcludeLabels pf)
1084− ]
1085− where
1086− _ .=? [] = Nothing
1087− k .=? l = Just $ k .= l
1088−
1089−defaultPruneFilter :: PruneFilter
1090−defaultPruneFilter = PruneFilter Nothing [] []
1091−
1092−newtype NetworksDeleted = NetworksDeleted [Text]
1093− deriving (Eq, Show)
1094−
1095−instance FromJSON NetworksDeleted where
1096− parseJSON (JSON.Object o) =
1097− NetworksDeleted . join . maybeToList <$> o .: "NetworksDeleted"
1098− parseJSON _ = fail $ "NetworksDeleted is not an object"
1099−
1100−data EndpointSettings = EndpointSettings
1101− { endpointIPAMConfig :: IPAMSettings
1102− , endpointLinks :: [Text]
1103− , endpointAliases :: [Text]
1104− , endpointNetworkID :: Maybe Text
1105− , endpointEndpointID :: Maybe Text
1106− , endpointGateway :: Maybe Text
1107− , endpointIPAddress :: Maybe Text
1108− , endpointIPPrefixLen :: Maybe Int
1109− , endpointIPv6Gateway :: Maybe Text
1110− , endpointGlobalIPv6Address :: Maybe Text
1111− , endpointGlobalIPv6PrefixLen :: Maybe Int
1112− , endpointMacAddress :: Maybe Text
1113− } deriving (Eq, Show, Generic)
1114−
1115−instance ToJSON EndpointSettings where
1116− toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 8 }
1117−
1118−defaultEndpointSettings :: EndpointSettings
1119−defaultEndpointSettings = EndpointSettings defaultIPAMSettings [] [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1120−
1121−data IPAMSettings = IPAMSettings
1122− { ipamIPv4Address :: Maybe Text
1123− , ipamIPv6Address :: Maybe Text
1124− , ipamLinkLocalIPs :: [Text]
1125− } deriving (Eq, Show, Generic)
1126−
1127−instance ToJSON IPAMSettings where
1128− toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 4 }
1129−
1130−defaultIPAMSettings :: IPAMSettings
1131−defaultIPAMSettings = IPAMSettings Nothing Nothing []
1132−
1133861-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
1134862-- | Set permissions on volumes that you mount in the container.
1135863data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
@@ -1299,14 +1027,11 @@ instance FromJSON NetworkMode where
12991027 parseJSON (JSON.String n) = return $ NetworkNamed n
13001028 parseJSON _ = fail "Unknown NetworkMode"
13011029
1302−fromNetworkMode :: NetworkMode -> Text
1303−fromNetworkMode NetworkBridge = "bridge"
1304−fromNetworkMode NetworkHost = "host"
1305−fromNetworkMode NetworkDisabled = "none"
1306−fromNetworkMode (NetworkNamed n) = n
1307−
13081030instance ToJSON NetworkMode where
1309− 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
13101035
13111036newtype NetworkID = NetworkID Text
13121037 deriving (Eq, Show)
@@ -1839,7 +1564,11 @@ instance FromJSON ContainerConfig where
18391564 macAddress labels stopSignal
18401565 parseJSON _ = fail "NetworkSettings is not an object."
18411566
1567+#if MIN_VERSION_base(4,13,0)
1568+parseIntegerText :: (MonadFail m) => Text -> m Integer
1569+#else
18421570parseIntegerText :: (Monad m) => Text -> m Integer
1571+#endif
18431572parseIntegerText t = case readMaybe $ T.unpack t of
18441573 Nothing ->
18451574 fail "Could not parse Integer"
stack-7.10.yaml+1
@@ -14,6 +14,7 @@ flags: {}
1414extra-deps:
1515- directory-1.2.7.0
1616- unliftio-core-0.1.1.0
17+- process-1.6.5.1
1718
1819# Control whether we use the GHC we find on the path
1920# system-ghc: true
stack-8.8.2.yamlnew file+5
@@ -0,0 +1,5 @@
1+resolver: lts-15.0
2+packages:
3+- '.'
4+extra-deps: []
5+
tests/tests.hs+1−60
@@ -11,7 +11,7 @@ import Test.Tasty.QuickCheck (testProperty)
1111
1212import Control.Concurrent (threadDelay)
1313import Control.Lens ((^.), (^?))
14−import Control.Monad (forM_, when, (<=<))
14+import Control.Monad (forM_)
1515import Control.Monad.IO.Class
1616import Control.Monad.Trans.Class (lift)
1717import qualified Data.Aeson as JSON
@@ -23,7 +23,6 @@ import qualified Data.ByteString.Char8 as C
2323import qualified Data.ByteString.Lazy as BL
2424import qualified Data.HashMap.Strict as HM
2525import Data.Int (Int)
26−import Data.List ((\\))
2726import qualified Data.Map as M
2827import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)
2928import Data.Monoid
@@ -145,48 +144,6 @@ testCreateRemoveNetwork = do
145144 removeStatus <- removeNetwork nid
146145 lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus
147146
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−
190147testLogDriverOptionsJson :: TestTree
191148testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
192149 where
@@ -279,17 +236,6 @@ testNetworkingConfigJson = testGroup "Testing NetworkingConfig JSON" [testSample
279236 ]
280237 ]
281238
282−testDisconnectConfigJson :: TestTree
283−testDisconnectConfigJson = testGroup "Testing DisconnectConfig JSON" [testSampleEncode]
284− where
285− testSampleEncode =
286− let config = DisconnectConfig "mycontainer" True
287− in testCase "Test toJSON" $ assert $ JSON.toJSON config ==
288− JSON.object
289− [ "Container" .= ("mycontainer" :: Text)
290− , "Force" .= True
291− ]
292−
293239integrationTests :: TestTree
294240integrationTests =
295241 testGroup
@@ -303,10 +249,6 @@ integrationTests =
303249 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
304250 , testCase "Try to stop a container that doesn't exist" testStopNonexisting
305251 , testCase "Create and remove a network" testCreateRemoveNetwork
306− , testCase "List networks" testListNetworks
307− , testCase "Inspect a network" testInspectNetwork
308− , testCase "Connect a container to a network" testConnectNetwork
309− , testCase "Disconnect a container from a network" testDisconnectNetwork
310252 ]
311253
312254jsonTests :: TestTree
@@ -320,7 +262,6 @@ jsonTests =
320262 , testEntrypointJson
321263 , testEnvVarJson
322264 , testNetworkingConfigJson
323− , testDisconnectConfigJson
324265 ]
325266
326267setup :: IO ()