master..5406510 · docker-hs

git.iko.soy/docker-hs

on 5406510 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+4

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

24 -- * Network

25 , createNetwork

26 , removeNetwork

27+ , listNetworks

27 -- * Other

28 -- * Other

28 , getDockerVersion

29 , getDockerVersion

29 ) where

30 ) where

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

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

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

226removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

227removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid

227

228

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,3 +288,8 @@ 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+15−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,7 @@ 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)]

82getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

84getEndpointRequestBody :: Endpoint -> Maybe HTTP.RequestBody

83getEndpointRequestBody VersionEndpoint = Nothing

85getEndpointRequestBody VersionEndpoint = Nothing

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

101

103

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

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

103getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

105getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing

106+getEndpointRequestBody (ListNetworksEndpoint _) = Nothing

104

107

105getEndpointContentType :: Endpoint -> BSC.ByteString

108getEndpointContentType :: Endpoint -> BSC.ByteString

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

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

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

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

79 , EndpointConfig(..)

88 , EndpointConfig(..)

80 , Ulimit(..)

89 , Ulimit(..)

81 , ContainerResources(..)

90 , ContainerResources(..)

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

114import Data.Time.Clock (UTCTime)

123import Data.Time.Clock (UTCTime)

115import qualified Data.Vector as V

124import qualified Data.Vector as V

116import GHC.Generics (Generic)

125import GHC.Generics (Generic)

126+import Numeric (readDec)

117import Prelude hiding (all, tail)

127import Prelude hiding (all, tail)

118import Text.Read (readMaybe)

128import Text.Read (readMaybe)

119

129

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

139 | DeleteImageEndpoint ImageDeleteOpts ImageID

149 | DeleteImageEndpoint ImageDeleteOpts ImageID

140 | CreateNetworkEndpoint CreateNetworkOpts

150 | CreateNetworkEndpoint CreateNetworkOpts

141 | RemoveNetworkEndpoint NetworkID

151 | RemoveNetworkEndpoint NetworkID

152+ | ListNetworksEndpoint [NetworkFilter]

142 deriving (Eq, Show)

153 deriving (Eq, Show)

143

154

144-- | We should newtype this

155-- | We should newtype this

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

858 , "EnableIPv6" .= createNetworkEnableIPv6 opts

869 , "EnableIPv6" .= createNetworkEnableIPv6 opts

859 ]

870 ]

860

871

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+

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

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

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

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

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

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

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

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

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

1028 parseJSON _ = fail "Unknown NetworkMode"

1186 parseJSON _ = fail "Unknown NetworkMode"

1029

1187

1188+fromNetworkMode :: NetworkMode -> Text

1189+fromNetworkMode NetworkBridge = "bridge"

1190+fromNetworkMode NetworkHost = "host"

1191+fromNetworkMode NetworkDisabled = "none"

1192+fromNetworkMode (NetworkNamed n) = n

1193+

1030instance ToJSON NetworkMode where

1194instance ToJSON NetworkMode where

1031− toJSON NetworkBridge = JSON.String "bridge"

1195+ toJSON = JSON.String . fromNetworkMode

1032− toJSON NetworkHost = JSON.String "host"

1033− toJSON NetworkDisabled = JSON.String "none"

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

1035

1196

1036newtype NetworkID = NetworkID Text

1197newtype NetworkID = NetworkID Text

1037 deriving (Eq, Show)

1198 deriving (Eq, Show)

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

1564 macAddress labels stopSignal

1725 macAddress labels stopSignal

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

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

1566

1727

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

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

1569−#else

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

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

1571−#endif

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

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

1573 Nothing ->

1730 Nothing ->

1574 fail "Could not parse Integer"

1731 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+9

@@ -144,6 +144,14 @@ 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+

147testLogDriverOptionsJson :: TestTree

155testLogDriverOptionsJson :: TestTree

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

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

149 where

157 where

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

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

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

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

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

251 , testCase "Create and remove a network" testCreateRemoveNetwork

259 , testCase "Create and remove a network" testCreateRemoveNetwork

260+ , testCase "List networks" testListNetworks

252 ]

261 ]

253

262

254jsonTests :: TestTree

263jsonTests :: TestTree