b6f812a · docker-hs · git.iko.soy

.gitignore+2

compare with master

unifiedsplit

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

1/.cabal-sandbox

2/cabal.sandbox.config

3/dist/

4+*~

5+.stack-work/

Network/Docker.hs+9

@@ -49,6 +49,8 @@ _dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpo

49emptyPost = "" :: String

50_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost)

51

52+_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

53+

52getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)

54getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)

53getDockerVersion = decodeResponse . _dockerGetQuery "/version"

55getDockerVersion = decodeResponse . _dockerGetQuery "/version"

54

56

@@ -79,6 +81,13 @@ pauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPos

79unpauseContainer :: DockerClientOpts -> String -> IO (Status)

81unpauseContainer :: DockerClientOpts -> String -> IO (Status)

80unpauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/unpause" containerId) clientOpts

82unpauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/unpause" containerId) clientOpts

81

83

84+deleteContainer :: DockerClientOpts -> String -> IO (Status)

85+deleteContainer = deleteContainerWithOpts defaultDeleteOpts

86+

87+deleteContainerWithOpts :: DeleteOpts -> DockerClientOpts -> String -> IO (Status)

88+deleteContainerWithOpts (DeleteOpts removeVolumes force) clientOpts containerId = (^. responseStatus) <$> _dockerEmptyDeleteQuery req clientOpts

89+ where req = printf "/containers/%s?v=%s;force=%s" containerId (show removeVolumes) (show force)

90+

82getContainerLogsStream :: DockerClientOpts -> String -> IO ()

91getContainerLogsStream :: DockerClientOpts -> String -> IO ()

83getContainerLogsStream clientOpts containerId = do

92getContainerLogsStream clientOpts containerId = do

84 req <- PH.parseUrl (fullUrl clientOpts url)

93 req <- PH.parseUrl (fullUrl clientOpts url)

Network/Docker/Types.hs+21

@@ -6,6 +6,7 @@

6

7module Network.Docker.Types where

8

9+import Prelude hiding(id)

9import Control.Applicative

10import Control.Applicative

10import Control.Lens.TH

11import Control.Lens.TH

12import Control.Lens.TH

@@ -68,6 +69,13 @@ data PortMap = PortMap

68 , _type :: PortType

69 , _type :: PortType

69 } deriving (Show, Eq)

70 } deriving (Show, Eq)

70

71

72+data DeleteOpts = DeleteOpts

73+ { removeVolumes :: Bool

74+ , force :: Bool

75+ }

76+

77+defaultDeleteOpts = DeleteOpts False False

78+

71

79

72data DockerContainer = DockerContainer

80data DockerContainer = DockerContainer

73 { _containerId :: ResourceId

81 { _containerId :: ResourceId

@@ -161,6 +169,7 @@ data StartContainerOpts = StartContainerOpts

161 , _Privileged :: Bool

169 , _Privileged :: Bool

162 , _Dns :: [T.Text]

170 , _Dns :: [T.Text]

163 , _VolumesFrom :: [T.Text]

171 , _VolumesFrom :: [T.Text]

172+ , _RestartPolicy :: RestartPolicy

164 } deriving (Show)

173 } deriving (Show)

165

174

166defaultStartOpts = StartContainerOpts

175defaultStartOpts = StartContainerOpts

@@ -172,6 +181,7 @@ defaultStartOpts = StartContainerOpts

172 , _Privileged = False

181 , _Privileged = False

173 , _Dns = []

182 , _Dns = []

174 , _VolumesFrom = []

183 , _VolumesFrom = []

184+ , _RestartPolicy = RestartNever

175 }

185 }

176

186

177instance ToJSON StartContainerOpts where

187instance ToJSON StartContainerOpts where

@@ -184,8 +194,19 @@ instance ToJSON StartContainerOpts where

184 , "Privileged" .= _Privileged

194 , "Privileged" .= _Privileged

185 , "Dns" .= _Dns

195 , "Dns" .= _Dns

186 , "VolumesFrom" .= _VolumesFrom

196 , "VolumesFrom" .= _VolumesFrom

197+ , "RestartPolicy" .= _RestartPolicy

187 ]

198 ]

188

199

200+data RestartPolicy = RestartNever

201+ | RestartAlways

202+ | RestartOnFailure Int

203+ deriving (Show)

204+

205+instance ToJSON RestartPolicy where

206+ toJSON RestartNever = object ["Name" .= (""::String), "MaximumRetryCount" .= (0::Int) ]

207+ toJSON RestartAlways = object ["Name" .= ("always"::String), "MaximumRetryCount" .= (0::Int) ]

208+ toJSON (RestartOnFailure n) = object ["Name" .= ("on-failure"::String), "MaximumRetryCount" .= n ]

209+

189makeClassy ''ResourceId

210makeClassy ''ResourceId

190

211

191-- makeLenses ''CreateContainerResponse

212-- makeLenses ''CreateContainerResponse

docker.cabal+40−13

@@ -2,7 +2,7 @@

2-- documentation, see http://haskell.org/cabal/users-guide/

3

4name: docker

5−version: 0.2.0.0

5+version: 0.2.0.1

6synopsis: Haskell wrapper for Docker Remote API

7-- description:

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

@@ -21,18 +21,45 @@ library

21 exposed-modules: Network.Docker, Network.Docker.Options, Network.Docker.Types, Network.Docker.Utils

22 -- other-modules:

23 other-extensions: OverloadedStrings, DeriveFunctor, FlexibleContexts, TemplateHaskell

24− build-depends: base >=4.7 && <4.8

24+ build-depends: base >=4.7

25− , lens >=4.2 && <4.3

25+ , lens >=4.2

26− , aeson >=0.7 && <0.8

26+ , aeson >=0.7

27+ , lens-aeson

27− , bytestring >=0.10 && <0.11

28+ , bytestring >= 0.10

28− , text >=1.1 && <1.2

29+ , text >=1.1

29− , wreq >=0.1 && <0.2

30+ , wreq >=0.3

30− , containers >=0.5 && <0.6

31+ , containers >= 0.5

32+ , data-default >= 0.5.3

33+ , network-uri >= 2.6.0.1

34+ , pipes-http >= 1.0.0

35+ , pipes >= 4.1.2

36+ , pipes-text >= 0.0.0.12

37+ , pipes-bytestring >= 2.1.0

38+ -- hs-source-dirs:

39+ default-language: Haskell2010

40+

41+test-suite tests

42+ build-depends: base >=4.7

43+ , docker

44+ , lens >=4.2

45+ , aeson >=0.7

46+ , lens-aeson

47+ , bytestring >= 0.10

48+ , text >=1.1

49+ , wreq >=0.3

50+ , containers >= 0.5

31 , data-default >= 0.5.3

51 , data-default >= 0.5.3

32− , network-uri >= 2.6.0.1

52+ , pipes >= 4.1.2

33− , pipes-http >= 1.0.0, pipes >= 4.1.2

53+ , pipes-http >= 1.0.0

34 , pipes-text >= 0.0.0.12

54 , pipes-text >= 0.0.0.12

35 , pipes-bytestring >= 2.1.0

55 , pipes-bytestring >= 2.1.0

36− , free >= 4.9

56+ , tasty >= 0.10.1

57+ , tasty-quickcheck >= 0.8.2

58+ , QuickCheck >= 2.7

59+ , tasty-hunit >= 0.8

60+ , process

61+ , http-types

62+ type: exitcode-stdio-1.0

63+ main-is: tests.hs

37− -- hs-source-dirs:

64+ hs-source-dirs: tests

38− default-language: Haskell2010

65+ default-language: Haskell2010

stack.yamlnew file+12

@@ -0,0 +1,12 @@

1+flags: {}

2+packages:

3+- '.'

4+extra-deps:

5+- wreq-0.4.0.0

6+- pipes-http-1.0.2

7+- pipes-group-1.0.2

8+- pipes-safe-2.2.2

9+- pipes-text-0.0.0.16

10+- pipes-bytestring-2.1.1

11+- psqueues-0.2.0.2

12+resolver: lts-1.15

tests/Dockerfilenew file+7

@@ -0,0 +1,7 @@

1+FROM debian

2+

3+RUN apt-get update && apt-get install -y python

4+

5+RUN echo "#!/usr/bin/python\nprint '123'" > /entrypoint.py

6+RUN chmod +x /entrypoint.py

7+CMD ["python", "entrypoint.py"]

tests/tests.hsnew file+62

@@ -0,0 +1,62 @@

1+module Main where

2+

3+import Network.Docker

4+import Network.Docker.Types

5+

6+import Test.Tasty

7+import Test.Tasty.HUnit

8+import qualified Test.Tasty.QuickCheck as QC

9+import qualified Test.QuickCheck.Monadic as QCM

10+

11+import Data.Maybe (isJust, fromJust)

12+import System.Process (system)

13+import Data.Text (unpack)

14+import Control.Concurrent (threadDelay)

15+import Network.HTTP.Types.Status

16+import qualified Data.ByteString.Char8 as C

17+import qualified Data.ByteString as B

18+import qualified Data.ByteString.Lazy as BL

19+

20+opts = defaultClientOpts { baseUrl = "http://127.0.0.1:2375/" }

21+

22+test_image_name = "docker-hs-test"

23+

24+toStrict1 = B.concat . BL.toChunks

25+

26+checkDockerVersion :: IO ()

27+checkDockerVersion = do v <- getDockerVersion opts

28+ assert $ isJust v

29+

30+findTestImage :: IO ()

31+findTestImage = do images <- getDockerImages opts

32+ let x = fmap (filter ((== [test_image_name++":latest"]) . _repoTags)) images

33+ assert $ fmap length x == Just 1

34+

35+runAndReadLog :: IO ()

36+runAndReadLog = do containerId <- createContainer opts (defaultCreateOpts {_image = test_image_name++":latest"})

37+ assert $ isJust containerId

38+ let c = unpack $ fromJust containerId

39+ status1 <- startContainer opts c defaultStartOpts

40+ threadDelay 300000 -- give 300ms for the application to finish

41+ assert $ status1 == status204

42+ status2 <- killContainer opts c

43+ logs <- getContainerLogs opts c

44+ assert $ status2 == status204

45+ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)

46+ status3 <- deleteContainer opts c

47+ assert $ status3 == status204

48+

49+

50+tests :: TestTree

51+tests = testGroup "Metrics tests" [

52+ testCase "Get docker version" checkDockerVersion,

53+ testCase "Find image by name" findTestImage,

54+ testCase "Run a dummy container and read its log" runAndReadLog]

55+

56+setup :: IO()

57+setup = system ("docker build -t "++test_image_name++" tests") >> return ()

58+

59+main :: IO()

60+main = do

61+ setup

62+ defaultMain tests