git.iko.soy/docker-hs
on master help sign in
Reorganizes tests a bit and adds json test for ExposedPorts
35e5d76Deni Bertovic
docker.cabal+5
compare with master
unifiedsplit
@@ -51,6 +51,9 @@ test-suite docker-hs-tests
51 , bytestring
51 , bytestring
52 , connection
52 , connection
53 , docker
53 , docker
54+ , aeson
55+ , containers
56+ , unordered-containers
54 , http-client
57 , http-client
55 , http-client-tls
58 , http-client-tls
56 , http-types
59 , http-types
@@ -58,6 +61,8 @@ test-suite docker-hs-tests
58 , tasty-hunit
61 , tasty-hunit
59 , tasty-quickcheck
62 , tasty-quickcheck
60 , text
63 , text
64+ , lens
65+ , lens-aeson
61 , transformers
66 , transformers
62 , QuickCheck
67 , QuickCheck
63 , process
68 , process
tests/tests.hs+37−18
@@ -5,17 +5,23 @@ module Main where
5import qualified Test.QuickCheck.Monadic as QCM
5import qualified Test.QuickCheck.Monadic as QCM
6import Test.Tasty
6import Test.Tasty
7import Test.Tasty.HUnit
7import Test.Tasty.HUnit
8−import qualified Test.Tasty.QuickCheck as QC
8+import Test.Tasty.QuickCheck (testProperty)
9
9
10import Control.Concurrent (threadDelay)
10import Control.Concurrent (threadDelay)
11+import Control.Lens ((^.), (^?))
11import Control.Monad.IO.Class
12import Control.Monad.IO.Class
12import Control.Monad.Trans.Class (MonadTrans, lift)
13import Control.Monad.Trans.Class (MonadTrans, lift)
14+import qualified Data.Aeson as JSON
15+import Data.Aeson.Lens (key, _Object, _String, _Value)
13import qualified Data.ByteString as B
16import qualified Data.ByteString as B
14import qualified Data.ByteString.Char8 as C
17import qualified Data.ByteString.Char8 as C
15import qualified Data.ByteString.Lazy as BL
18import qualified Data.ByteString.Lazy as BL
19+import qualified Data.HashMap.Strict as HM
20+import Data.Int (Int)
21+import qualified Data.Map as M
16import Data.Maybe (fromJust, isJust)
22import Data.Maybe (fromJust, isJust)
17import Data.Monoid
23import Data.Monoid
18−import Data.Text (unpack)
24+import Data.Text (Text, unpack)
19import Network.Connection (TLSSettings (..))
25import Network.Connection (TLSSettings (..))
20import Network.HTTP.Client (newManager)
26import Network.HTTP.Client (newManager)
21import Network.HTTP.Client.TLS
27import Network.HTTP.Client.TLS
@@ -38,19 +44,19 @@ runDocker f = do
38 -- mgr <- newManager settings
44 -- mgr <- newManager settings
39 runDockerT (defaultClientOpts, defaultHttpHandler) f
45 runDockerT (defaultClientOpts, defaultHttpHandler) f
40
46
41−checkDockerVersion :: IO ()
47+testDockerVersion :: IO ()
42−checkDockerVersion = runDocker $ do
48+testDockerVersion = runDocker $ do
43 v <- getDockerVersion
49 v <- getDockerVersion
44 lift $ assert $ isRight v
50 lift $ assert $ isRight v
45
51
46−findTestImage :: IO ()
52+testFindImage :: IO ()
47−findTestImage = runDocker $ do
53+testFindImage = runDocker $ do
48 images <- listImages defaultListOpts >>= fromRight
54 images <- listImages defaultListOpts >>= fromRight
49 let x = filter ((== [testImageName<>":latest"]) . imageRepoTags) images
55 let x = filter ((== [testImageName<>":latest"]) . imageRepoTags) images
50 lift $ assert $ length x == 1
56 lift $ assert $ length x == 1
51
57
52−runAndReadLog :: IO ()
58+testRunAndReadLog :: IO ()
53−runAndReadLog = runDocker $ do
59+testRunAndReadLog = runDocker $ do
54 containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest"))
60 containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest"))
55 c <- fromRight containerId
61 c <- fromRight containerId
56 status1 <- startContainer defaultStartOpts c
62 status1 <- startContainer defaultStartOpts c
@@ -64,20 +70,27 @@ runAndReadLog = runDocker $ do
64 lift $ assert $ status3 == Right ()
70 lift $ assert $ status3 == Right ()
65
71
66
72
73+sampleEP = ExposedPorts $ M.fromList [(80, TCP), (1337, UDP)]
74+
75+testExposedPorts :: TestTree
76+testExposedPorts = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]
77+ where
78+ testTCP = testCase "tcp port" $ assert $ JSON.toJSON sampleEP ^. key "80/tcp" . _Object == HM.empty
79+ testUDP = testCase "udp port" $ assert $ JSON.toJSON sampleEP ^. key "1337/tcp" . _Object == HM.empty
80+
81+
67−tests :: TestTree
82+integrationTests :: TestTree
68−tests = testGroup "Metrics tests" [
83+integrationTests = testGroup "Integration Tests" [
69− testCase "Get docker version" checkDockerVersion,
84+ testCase "Get docker version" testDockerVersion,
70− testCase "Find image by name" findTestImage,
85+ testCase "Find image by name" testFindImage,
71− testCase "Run a dummy container and read its log" runAndReadLog]
86+ testCase "Run a dummy container and read its log" testRunAndReadLog]
87+
88+jsonTests :: TestTree
89+jsonTests = testGroup "JSON Tests" [testExposedPorts]
72
90
73setup :: IO ()
91setup :: IO ()
74setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()
92setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()
75
93
76−main :: IO ()
77−main = do
78− setup
79− defaultMain tests
80−
81isRight (Left _) = False
94isRight (Left _) = False
82isRight (Right _) = True
95isRight (Right _) = True
83
96
@@ -86,3 +99,9 @@ fromRight (Left l) = do
86 liftIO $ assertFailure $ "Left: " ++ show l
99 liftIO $ assertFailure $ "Left: " ++ show l
87 undefined
100 undefined
88fromRight (Right r) = return r
101fromRight (Right r) = return r
102+
103+main :: IO ()
104+main = do
105+ setup
106+ defaultMain $ testGroup "Tests" [jsonTests, integrationTests]
107+