5406510..master · docker-hs

git.iko.soy/docker-hs

on master help sign in

.travis.yml+4

since splitsnapshots

unifiedsplit

@@ -43,6 +43,10 @@ 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+

46addons:

50addons:

47 apt:

51 apt:

48 packages:

52 packages:

CHANGELOG.md+6

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

1# CHANGELOG

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

5+- Support for ghc 8.8.2.

6+- Bump dependency version.

7+- Use MonadFail for later versions.

3## 0.6.0.1 (2019-05-23)

9## 0.6.0.1 (2019-05-23)

5- Support ghc 8.6.4.

11- Support ghc 8.6.4.

docker.cabal+4−4

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

1name: docker

2−version: 0.6.0.2

2+version: 0.6.0.3

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.6.0

33+ , http-client >= 0.4.0 && < 0.7.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 && < 1.9.0

54+ , time >= 1.5.0 && < 2.0.0

55 , scientific >= 0.3.0 && < 0.4.0

56− , tls >= 1.3.7 && < 1.5.0

56+ , tls >= 1.3.7 && < 1.6.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−4

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

24 -- * Network

25 , createNetwork

26 , removeNetwork

27− , listNetworks

28 -- * Other

27 -- * Other

29 , getDockerVersion

28 , getDockerVersion

30 ) where

29 ) where

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

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

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

227removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

228

227

229−-- | Lists networks optionally matching a list of 'Filter's

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

231−listNetworks nfs = requestHelper GET (ListNetworksEndpoint nfs) >>= parseResponse

src/Docker/Client/Http.hs−5

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

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

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

84getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

85getEndpointRequestBody VersionEndpoint = Nothing

83getEndpointRequestBody VersionEndpoint = Nothing

@@ -103,7 +101,6 @@ getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing

103

101

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

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

105getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

103getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

106−getEndpointRequestBody (ListNetworksEndpoint _) = Nothing

107

104

108getEndpointContentType :: Endpoint -> BSC.ByteString

105getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

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

@@ -76,15 +76,6 @@ 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− , NetworkFilter(..)

88 , EndpointConfig(..)

79 , EndpointConfig(..)

89 , Ulimit(..)

80 , Ulimit(..)

90 , ContainerResources(..)

81 , ContainerResources(..)

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

123import Data.Time.Clock (UTCTime)

114import Data.Time.Clock (UTCTime)

124import qualified Data.Vector as V

115import qualified Data.Vector as V

125import GHC.Generics (Generic)

116import GHC.Generics (Generic)

126−import Numeric (readDec)

127import Prelude hiding (all, tail)

117import Prelude hiding (all, tail)

128import Text.Read (readMaybe)

118import Text.Read (readMaybe)

129

119

@@ -149,7 +139,6 @@ data Endpoint =

149 | DeleteImageEndpoint ImageDeleteOpts ImageID

139 | DeleteImageEndpoint ImageDeleteOpts ImageID

150 | CreateNetworkEndpoint CreateNetworkOpts

140 | CreateNetworkEndpoint CreateNetworkOpts

151 | RemoveNetworkEndpoint NetworkID

141 | RemoveNetworkEndpoint NetworkID

152− | ListNetworksEndpoint [NetworkFilter]

153 deriving (Eq, Show)

142 deriving (Eq, Show)

154

143

155-- | We should newtype this

144-- | We should newtype this

@@ -869,153 +858,6 @@ instance ToJSON CreateNetworkOpts where

869 , "EnableIPv6" .= createNetworkEnableIPv6 opts

858 , "EnableIPv6" .= createNetworkEnableIPv6 opts

870 ]

859 ]

871

860

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

873−

874−fromNetworkScope :: NetworkScope -> Text

875−fromNetworkScope LocalScope = "local"

876−fromNetworkScope GlobalScope = "global"

877−fromNetworkScope SwarmScope = "swarm"

878−

879−instance ToJSON NetworkScope where

880− toJSON = JSON.String . fromNetworkScope

881−

882−instance FromJSON NetworkScope where

883− parseJSON "local" = return LocalScope

884− parseJSON "global" = return GlobalScope

885− parseJSON "swarm" = return SwarmScope

886− parseJSON _ = fail "Failed to parse NetworkScope"

887−

888−data CIDR = CIDR Text Int deriving (Eq, Show)

889−

890−instance FromJSON CIDR where

891− parseJSON (JSON.String t) = case T.splitOn "/" t of

892− [a,p] -> CIDR a <$> parsePrefixLen p

893− _ -> fail "Failed to parse CIDR"

894− where

895− parsePrefixLen p = case readDec (T.unpack p) of

896− (n,""):_ -> return n

897− _ -> fail "Failed to parse CIDR prefix length"

898− parseJSON _ = fail "Failed to parse CIDR"

899−

900−data IPAMDriver = DefaultIPAMDriver | NamedIPAMDriver Text deriving (Eq, Show)

901−

902−instance FromJSON IPAMDriver where

903− parseJSON (JSON.String "default") = return DefaultIPAMDriver

904− parseJSON (JSON.String t) = return $ NamedIPAMDriver t

905− parseJSON _ = fail "IPAMDriver is not a string"

906−

907−data IPAMConfig = IPAMConfig

908− { ipamConfigSubnet :: CIDR

909− , ipamConfigIPRange :: Maybe CIDR

910− , ipamSubnetGateway :: Maybe Text

911− , ipamConfigAuxAddress :: Maybe Text

912− } deriving (Eq, Show)

913−

914−instance FromJSON IPAMConfig where

915− parseJSON (JSON.Object o) = IPAMConfig

916− <$> o .: "Subnet"

917− <*> o .:? "IPRange"

918− <*> o .:? "Gateway"

919− <*> o .:? "AuxAddress"

920− parseJSON _ = fail "IPAMConfig is not an object"

921−

922−data IPAM = IPAM

923− { ipamDriver :: IPAMDriver

924− , ipamConfig :: [IPAMConfig]

925− , ipamOptions :: HM.HashMap Text Text

926− } deriving (Eq, Show)

927−

928−instance FromJSON IPAM where

929− parseJSON (JSON.Object o) = IPAM

930− <$> o .:? "Driver" .!= DefaultIPAMDriver

931− <*> o .:? "Config" .!= []

932− <*> o .:? "Options" .!= HM.empty

933− parseJSON _ = fail "IPAM is not an object"

934−

935−data NetworkContainer = NetworkContainer

936− { networkContainerName :: Text

937− , networkContainerEndpointID :: Text

938− , networkContainerMacAddress :: Text

939− , networkContainerIPv4Address :: Text

940− , networkContainerIPv6Address :: Text

941− } deriving (Eq, Show)

942−

943−instance FromJSON NetworkContainer where

944− parseJSON (JSON.Object o) = NetworkContainer

945− <$> o .: "Name"

946− <*> o .: "EndpointID"

947− <*> o .: "MacAddress"

948− <*> o .: "IPv4Address"

949− <*> o .: "IPv6Address"

950− parseJSON _ = fail "NetworkContainer is not an object"

951−

952−data NetworkDetails = NetworkDetails

953− { networkDetailsName :: Text

954− , networkDetailsID :: NetworkID

955− , networkDetailsCreated :: UTCTime

956− , networkDetailsScope :: NetworkScope

957− , networkDetailsDriver :: NetworkMode

958− , networkDetailsEnableIPv6 :: Bool

959− , networkDetailsInternal :: Bool

960− , networkDetailsAttachable :: Bool

961− , networkDetailsIngress :: Bool

962− , networkDetailsIPAM :: IPAM

963− , networkDetailsOptions :: HM.HashMap Text Text

964− , networkDetailsLabels :: HM.HashMap Text Text

965− , networkDetailsContainers :: HM.HashMap Text NetworkContainer

966− } deriving (Eq, Show)

967−

968−instance FromJSON NetworkDetails where

969− parseJSON v@(JSON.Object o) = NetworkDetails

970− <$> o .: "Name"

971− <*> parseJSON v

972− <*> o .: "Created"

973− <*> o .: "Scope"

974− <*> o .: "Driver"

975− <*> o .: "EnableIPv6"

976− <*> o .: "Internal"

977− <*> o .: "Attachable"

978− <*> o .: "Ingress"

979− <*> o .: "IPAM"

980− <*> o .:? "Options" .!= HM.empty

981− <*> o .:? "Labels" .!= HM.empty

982− <*> o .:? "Containers" .!= HM.empty

983− parseJSON _ = fail "NetworkDetails is not an object"

984−

985−data NetworkType = BuiltinNetwork | CustomNetwork deriving (Eq, Show)

986−

987−fromNetworkType :: NetworkType -> Text

988−fromNetworkType BuiltinNetwork = "builtin"

989−fromNetworkType CustomNetwork = "custom"

990−

991−instance ToJSON NetworkType where

992− toJSON = JSON.String . fromNetworkType

993−

994−instance FromJSON NetworkType where

995− parseJSON (JSON.String "builtin") = return BuiltinNetwork

996− parseJSON (JSON.String "custom") = return CustomNetwork

997− parseJSON _ = fail "Failed to parse NetworkType"

998−

999−data NetworkFilter

1000− = NetworkFilterName Text

1001− | NetworkFilterID NetworkID

1002− | NetworkFilterLabel Text

1003− | NetworkFilterDriver NetworkMode

1004− | NetworkFilterScope NetworkScope

1005− | NetworkFilterType NetworkType

1006− deriving (Eq, Show)

1007−

1008−

1009−instance {-# OVERLAPPING #-} ToJSON [NetworkFilter] where

1010− toJSON = object . fmap toKV

1011− where

1012− toKV (NetworkFilterName n) = "name" .= [n]

1013− toKV (NetworkFilterID i) = "id" .= [fromNetworkID i]

1014− toKV (NetworkFilterLabel l) = "label" .= [l]

1015− toKV (NetworkFilterDriver d) = "driver" .= [fromNetworkMode d]

1016− toKV (NetworkFilterScope s) = "scope" .= [fromNetworkScope s]

1017− toKV (NetworkFilterType t) = "type" .= [fromNetworkType t]

1018−

1019-- 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")

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

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

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

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

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

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

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

1186 parseJSON _ = fail "Unknown NetworkMode"

1028 parseJSON _ = fail "Unknown NetworkMode"

1187

1029

1188−fromNetworkMode :: NetworkMode -> Text

1189−fromNetworkMode NetworkBridge = "bridge"

1190−fromNetworkMode NetworkHost = "host"

1191−fromNetworkMode NetworkDisabled = "none"

1192−fromNetworkMode (NetworkNamed n) = n

1193−

1194instance ToJSON NetworkMode where

1030instance ToJSON NetworkMode where

1195− 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

1196

1035

1197newtype NetworkID = NetworkID Text

1036newtype NetworkID = NetworkID Text

1198 deriving (Eq, Show)

1037 deriving (Eq, Show)

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

1725 macAddress labels stopSignal

1564 macAddress labels stopSignal

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

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

1727

1566

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

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

1569+#else

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

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

1571+#endif

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

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

1730 Nothing ->

1573 Nothing ->

1731 fail "Could not parse Integer"

1574 fail "Could not parse Integer"

stack-7.10.yaml+1

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

14extra-deps:

15- directory-1.2.7.0

16- unliftio-core-0.1.1.0

17+- process-1.6.5.1

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

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

19# system-ghc: true

20# 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: []

tests/tests.hs−9

@@ -144,14 +144,6 @@ 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 ns -> assertBool "listing networks, bridge network missing" $ length ns == 1

154−

155testLogDriverOptionsJson :: TestTree

147testLogDriverOptionsJson :: TestTree

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

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

157 where

149 where

@@ -257,7 +249,6 @@ integrationTests =

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

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

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

259 , testCase "Create and remove a network" testCreateRemoveNetwork

251 , testCase "Create and remove a network" testCreateRemoveNetwork

260− , testCase "List networks" testListNetworks

261 ]

252 ]

262

253

263jsonTests :: TestTree

254jsonTests :: TestTree