on master help sign in
10 files changed+40−224
since splitsnapshots
unifiedsplit
.travis.yml+4 CHANGELOG.md+6 docker.cabal+4−4 src/Docker/Client/Api.hs−9 src/Docker/Client/Http.hs−10 src/Docker/Client/Internal.hs+12−17 src/Docker/Client/Types.hs+8−168 stack-7.10.yaml+1 stack-8.8.2.yaml+5 tests/tests.hs−16
.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−9
@@ -24,8 +24,6 @@ module Docker.Client.Api (
2424 -- * Network
2525 , createNetwork
2626 , removeNetwork
27− , listNetworks
28− , inspectNetwork
2927 -- * Other
3028 , getDockerVersion
3129 ) where
@@ -227,10 +225,3 @@ createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseR
227225removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ())
228226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid
229227
230−-- | Lists networks optionally matching a list of 'NetworkFilter's.
231−listNetworks :: forall m . (MonadIO m, MonadMask m) => [NetworkFilter] -> DockerT m (Either DockerError [NetworkDetails])
232−listNetworks nfs = requestHelper GET (ListNetworksEndpoint nfs) >>= parseResponse
233−
234−-- | Gets 'NetworkDetails' for a network, given its name or id.
235−inspectNetwork :: forall m . (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError NetworkDetails)
236−inspectNetwork nid = requestHelper GET (InspectNetworkEndpoint nid) >>= parseResponse
src/Docker/Client/Http.hs−10
@@ -288,13 +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
src/Docker/Client/Internal.hs+12−17
@@ -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,8 +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 nfs) = encodeURLWithQuery [v, "networks"] [("filters", Just . BSLC.toStrict $ JSON.encode nfs)]
83−getEndpoint v (InspectNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid]
8481
8582getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody
8683getEndpointRequestBody VersionEndpoint = Nothing
@@ -104,8 +101,6 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing
104101
105102getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts)
106103getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing
107−getEndpointRequestBody (ListNetworksEndpoint _) = Nothing
108−getEndpointRequestBody (InspectNetworkEndpoint _) = Nothing
109104
110105getEndpointContentType :: Endpoint -> BSC.ByteString
111106getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
src/Docker/Client/Types.hs+8−168
@@ -76,16 +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(..)
8979 , EndpointConfig(..)
9080 , Ulimit(..)
9181 , ContainerResources(..)
@@ -124,7 +114,6 @@ import qualified Data.Text as T
124114import Data.Time.Clock (UTCTime)
125115import qualified Data.Vector as V
126116import GHC.Generics (Generic)
127−import Numeric (readDec)
128117import Prelude hiding (all, tail)
129118import Text.Read (readMaybe)
130119
@@ -150,8 +139,6 @@ data Endpoint =
150139 | DeleteImageEndpoint ImageDeleteOpts ImageID
151140 | CreateNetworkEndpoint CreateNetworkOpts
152141 | RemoveNetworkEndpoint NetworkID
153− | ListNetworksEndpoint [NetworkFilter]
154− | InspectNetworkEndpoint NetworkID
155142 deriving (Eq, Show)
156143
157144-- | We should newtype this
@@ -871,154 +858,6 @@ instance ToJSON CreateNetworkOpts where
871858 , "EnableIPv6" .= createNetworkEnableIPv6 opts
872859 ]
873860
874−data NetworkScope = LocalScope | GlobalScope | SwarmScope deriving (Eq, Show)
875−
876−fromNetworkScope :: NetworkScope -> Text
877−fromNetworkScope LocalScope = "local"
878−fromNetworkScope GlobalScope = "global"
879−fromNetworkScope SwarmScope = "swarm"
880−
881−instance ToJSON NetworkScope where
882− toJSON = JSON.String . fromNetworkScope
883−
884−instance FromJSON NetworkScope where
885− parseJSON "local" = return LocalScope
886− parseJSON "global" = return GlobalScope
887− parseJSON "swarm" = return SwarmScope
888− parseJSON _ = fail "Failed to parse NetworkScope"
889−
890−data CIDR = CIDR Text Int deriving (Eq, Show)
891−
892−instance FromJSON CIDR where
893− parseJSON (JSON.String t) = case T.splitOn "/" t of
894− [a,p] -> CIDR a <$> parsePrefixLen p
895− _ -> fail "Failed to parse CIDR"
896− where
897− parsePrefixLen p = case readDec (T.unpack p) of
898− (n,""):_ -> return n
899− _ -> fail "Failed to parse CIDR prefix length"
900− parseJSON _ = fail "Failed to parse CIDR"
901−
902−data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show)
903−
904−instance FromJSON IPAMDriver where
905− parseJSON (JSON.String "default") = return DefaultIPAMDriver
906− parseJSON (JSON.String t) = return $ NamedIPAMDriver t
907− parseJSON _ = fail "IPAMDriver is not a string"
908−
909−data IPAMConfig = IPAMConfig
910− { ipamConfigSubnet :: CIDR
911− , ipamConfigIPRange :: Maybe CIDR
912− , ipamSubnetGateway :: Maybe Text
913− , ipamConfigAuxAddress :: Maybe Text
914− } deriving (Eq, Show)
915−
916−instance FromJSON IPAMConfig where
917− parseJSON (JSON.Object o) = IPAMConfig
918− <$> o .: "Subnet"
919− <*> o .:? "IPRange"
920− <*> o .:? "Gateway"
921− <*> o .:? "AuxAddress"
922− parseJSON _ = fail "IPAMConfig is not an object"
923−
924−data IPAM = IPAM
925− { ipamDriver :: IPAMDriver
926− , ipamConfig :: [IPAMConfig]
927− , ipamOptions :: HM.HashMap Text Text
928− } deriving (Eq, Show)
929−
930−instance FromJSON IPAM where
931− parseJSON (JSON.Object o) = IPAM
932− <$> o .:? "Driver" .!= DefaultIPAMDriver
933− <*> o .:? "Config" .!= []
934− <*> o .:? "Options" .!= HM.empty
935− parseJSON _ = fail "IPAM is not an object"
936−
937−data NetworkContainer = NetworkContainer
938− { networkContainerName :: ContainerName
939− , networkContainerEndpointID :: Text
940− , networkContainerMacAddress :: Text
941− , networkContainerIPv4Address :: Text
942− , networkContainerIPv6Address :: Text
943− } deriving (Eq, Show)
944−
945−instance FromJSON NetworkContainer where
946− parseJSON (JSON.Object o) = NetworkContainer
947− <$> o .: "Name"
948− <*> o .: "EndpointID"
949− <*> o .: "MacAddress"
950− <*> o .: "IPv4Address"
951− <*> o .: "IPv6Address"
952− parseJSON _ = fail "NetworkContainer is not an object"
953−
954−data NetworkDetails = NetworkDetails
955− { networkDetailsName :: Text
956− , networkDetailsID :: NetworkID
957− , networkDetailsCreated :: UTCTime
958− , networkDetailsScope :: NetworkScope
959− , networkDetailsDriver :: NetworkMode
960− , networkDetailsEnableIPv6 :: Bool
961− , networkDetailsInternal :: Bool
962− , networkDetailsAttachable :: Bool
963− , networkDetailsIngress :: Bool
964− , networkDetailsIPAM :: IPAM
965− , networkDetailsOptions :: HM.HashMap Text Text
966− , networkDetailsLabels :: HM.HashMap Text Text
967− , networkDetailsContainers :: HM.HashMap Text NetworkContainer
968− } deriving (Eq, Show)
969−
970−instance FromJSON NetworkDetails where
971− parseJSON v@(JSON.Object o) = NetworkDetails
972− <$> o .: "Name"
973− <*> parseJSON v
974− <*> o .: "Created"
975− <*> o .: "Scope"
976− <*> o .: "Driver"
977− <*> o .: "EnableIPv6"
978− <*> o .: "Internal"
979− <*> o .: "Attachable"
980− <*> o .: "Ingress"
981− <*> o .: "IPAM"
982− <*> o .:? "Options" .!= HM.empty
983− <*> o .:? "Labels" .!= HM.empty
984− <*> o .:? "Containers" .!= HM.empty
985− parseJSON _ = fail "NetworkDetails is not an object"
986−
987−data NetworkType = BuiltinNetwork | CustomNetwork deriving (Eq, Show)
988−
989−fromNetworkType :: NetworkType -> Text
990−fromNetworkType BuiltinNetwork = "builtin"
991−fromNetworkType CustomNetwork = "custom"
992−
993−type NetworkName = Text
994−
995−instance ToJSON NetworkType where
996− toJSON = JSON.String . fromNetworkType
997−
998−instance FromJSON NetworkType where
999− parseJSON (JSON.String "builtin") = return BuiltinNetwork
1000− parseJSON (JSON.String "custom") = return CustomNetwork
1001− parseJSON _ = fail "Failed to parse NetworkType"
1002−
1003−data NetworkFilter
1004− = NetworkFilterName Text
1005− | NetworkFilterID NetworkID
1006− | NetworkFilterLabel Text
1007− | NetworkFilterDriver NetworkMode
1008− | NetworkFilterScope NetworkScope
1009− | NetworkFilterType NetworkType
1010− deriving (Eq, Show)
1011−
1012−instance {-# OVERLAPPING #-} ToJSON [NetworkFilter] where
1013− toJSON = object . fmap toKV
1014− where
1015− toKV (NetworkFilterName n) = "name" .= [n]
1016− toKV (NetworkFilterID i) = "id" .= [fromNetworkID i]
1017− toKV (NetworkFilterLabel l) = "label" .= [l]
1018− toKV (NetworkFilterDriver d) = "driver" .= [fromNetworkMode d]
1019− toKV (NetworkFilterScope s) = "scope" .= [fromNetworkScope s]
1020− toKV (NetworkFilterType t) = "type" .= [fromNetworkType t]
1021−
1022861-- TOOD: Add support for SELinux Volume labels (eg. "ro,z" or "ro/Z")
1023862-- | Set permissions on volumes that you mount in the container.
1024863data VolumePermission = ReadWrite | ReadOnly deriving (Eq, Show, Generic)
@@ -1188,14 +1027,11 @@ instance FromJSON NetworkMode where
11881027 parseJSON (JSON.String n) = return $ NetworkNamed n
11891028 parseJSON _ = fail "Unknown NetworkMode"
11901029
1191−fromNetworkMode :: NetworkMode -> Text
1192−fromNetworkMode NetworkBridge = "bridge"
1193−fromNetworkMode NetworkHost = "host"
1194−fromNetworkMode NetworkDisabled = "none"
1195−fromNetworkMode (NetworkNamed n) = n
1196−
11971030instance ToJSON NetworkMode where
1198− 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
11991035
12001036newtype NetworkID = NetworkID Text
12011037 deriving (Eq, Show)
@@ -1728,7 +1564,11 @@ instance FromJSON ContainerConfig where
17281564 macAddress labels stopSignal
17291565 parseJSON _ = fail "NetworkSettings is not an object."
17301566
1567+#if MIN_VERSION_base(4,13,0)
1568+parseIntegerText :: (MonadFail m) => Text -> m Integer
1569+#else
17311570parseIntegerText :: (Monad m) => Text -> m Integer
1571+#endif
17321572parseIntegerText t = case readMaybe $ T.unpack t of
17331573 Nothing ->
17341574 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−16
@@ -144,21 +144,6 @@ testCreateRemoveNetwork = do
144144 removeStatus <- removeNetwork nid
145145 lift $ assertBool ("removing a network, unexpected status: " ++ show removeStatus) $ isRight removeStatus
146146
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, unewxpected status: " ++ show res) $ isRight res
160−
161−
162147testLogDriverOptionsJson :: TestTree
163148testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [test1, test2, test3]
164149 where
@@ -264,7 +249,6 @@ integrationTests =
264249 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
265250 , testCase "Try to stop a container that doesn't exist" testStopNonexisting
266251 , testCase "Create and remove a network" testCreateRemoveNetwork
267− , testCase "List networks" testListNetworks
268252 ]
269253
270254jsonTests :: TestTree