on master help sign in
Merge pull request #3 from Helkafen/master

Upgrade dependencies, add deleteContainer function

commit62afde2c30227cb0233f5a414653e40f546eff5e authorDeni Bertovic <deni@denibertovic.com> dateMon 13 Jul 2015, 13:29 (11 years ago) parentf3a207f1ce1307
7 files changed+141−3
.gitignore+2−1 Network/Docker.hs+9 Network/Docker/Types.hs+8 docker.cabal+41−2 stack.yaml+12 tests/Dockerfile+7 tests/tests.hs+62
.gitignore+2−1
@@ -1,4 +1,5 @@
11/.cabal-sandbox
22/cabal.sandbox.config
33/dist/
4−*~
4+*~
5+.stack-work/
Network/Docker.hs+9
@@ -49,6 +49,8 @@ _dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpo
4949emptyPost = "" :: String
5050_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost)
5151
52+_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)
53+
5254getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)
5355getDockerVersion = decodeResponse . _dockerGetQuery "/version"
5456
@@ -79,6 +81,13 @@ pauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPos
7981unpauseContainer :: DockerClientOpts -> String -> IO (Status)
8082unpauseContainer clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/unpause" containerId) clientOpts
8183
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+
8291getContainerLogsStream :: DockerClientOpts -> String -> IO ()
8392getContainerLogsStream clientOpts containerId = do
8493 req <- PH.parseUrl (fullUrl clientOpts url)
Network/Docker/Types.hs+8
@@ -6,6 +6,7 @@
66
77module Network.Docker.Types where
88
9+import Prelude hiding(id)
910import Control.Applicative
1011import Control.Lens.TH
1112import Control.Lens.TH
@@ -68,6 +69,13 @@ data PortMap = PortMap
6869 , _type :: PortType
6970 } deriving (Show, Eq)
7071
72+data DeleteOpts = DeleteOpts
73+ { removeVolumes :: Bool
74+ , force :: Bool
75+ }
76+
77+defaultDeleteOpts = DeleteOpts False False
78+
7179
7280data DockerContainer = DockerContainer
7381 { _containerId :: ResourceId
docker.cabal+41−2
@@ -2,7 +2,7 @@
22-- documentation, see http://haskell.org/cabal/users-guide/
33
44name: docker
5−version: 0.2.0.0
5+version: 0.2.0.1
66synopsis: Haskell wrapper for Docker Remote API
77-- description:
88homepage: https://github.com/denibertovic/docker-hs
@@ -21,6 +21,45 @@ library
2121 exposed-modules: Network.Docker, Network.Docker.Options, Network.Docker.Types, Network.Docker.Utils
2222 -- other-modules:
2323 other-extensions: OverloadedStrings, DeriveFunctor, FlexibleContexts, TemplateHaskell
24− build-depends: base >=4.7 && <4.8, lens >=4.2 && <4.3, aeson >=0.7 && <0.8, bytestring >=0.10 && <0.11, text >=1.1 && <1.2, wreq >=0.1 && <0.2, containers >=0.5 && <0.6, data-default >= 0.5.3, network-uri >= 2.6.0.1, pipes-http >= 1.0.0, pipes >= 4.1.2, pipes-text >= 0.0.0.12, pipes-bytestring >= 2.1.0
24+ build-depends: base >=4.7
25+ , lens >=4.2
26+ , aeson >=0.7
27+ , lens-aeson
28+ , bytestring >= 0.10
29+ , text >=1.1
30+ , wreq >=0.3
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
2538 -- hs-source-dirs:
2639 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
51+ , data-default >= 0.5.3
52+ , pipes >= 4.1.2
53+ , pipes-http >= 1.0.0
54+ , pipes-text >= 0.0.0.12
55+ , pipes-bytestring >= 2.1.0
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
64+ hs-source-dirs: tests
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