@@ -5,17 +5,23 @@ module Main where
55import qualified Test.QuickCheck.Monadic as QCM
66import Test.Tasty
77import Test.Tasty.HUnit
8−import qualified Test.Tasty.QuickCheck as QC
8+import Test.Tasty.QuickCheck (testProperty)
99
1010import Control.Concurrent (threadDelay)
11+import Control.Lens ((^.), (^?))
1112import Control.Monad.IO.Class
1213import Control.Monad.Trans.Class (MonadTrans, lift)
14+import qualified Data.Aeson as JSON
15+import Data.Aeson.Lens (key, _Object, _String, _Value)
1316import qualified Data.ByteString as B
1417import qualified Data.ByteString.Char8 as C
1518import 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
1622import Data.Maybe (fromJust, isJust)
1723import Data.Monoid
18−import Data.Text (unpack)
24+import Data.Text (Text, unpack)
1925import Network.Connection (TLSSettings (..))
2026import Network.HTTP.Client (newManager)
2127import Network.HTTP.Client.TLS
@@ -38,19 +44,19 @@ runDocker f = do
3844 -- mgr <- newManager settings
3945 runDockerT (defaultClientOpts, defaultHttpHandler) f
4046
41−checkDockerVersion :: IO ()
42−checkDockerVersion = runDocker $ do
47+testDockerVersion :: IO ()
48+testDockerVersion = runDocker $ do
4349 v <- getDockerVersion
4450 lift $ assert $ isRight v
4551
46−findTestImage :: IO ()
47−findTestImage = runDocker $ do
52+testFindImage :: IO ()
53+testFindImage = runDocker $ do
4854 images <- listImages defaultListOpts >>= fromRight
4955 let x = filter ((== [testImageName<>":latest"]) . imageRepoTags) images
5056 lift $ assert $ length x == 1
5157
52−runAndReadLog :: IO ()
53−runAndReadLog = runDocker $ do
58+testRunAndReadLog :: IO ()
59+testRunAndReadLog = runDocker $ do
5460 containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest"))
5561 c <- fromRight containerId
5662 status1 <- startContainer defaultStartOpts c
@@ -64,20 +70,27 @@ runAndReadLog = runDocker $ do
6470 lift $ assert $ status3 == Right ()
6571
6672
67−tests :: TestTree
68−tests = testGroup "Metrics tests" [
69− testCase "Get docker version" checkDockerVersion,
70− testCase "Find image by name" findTestImage,
71− testCase "Run a dummy container and read its log" runAndReadLog]
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+
82+integrationTests :: TestTree
83+integrationTests = testGroup "Integration Tests" [
84+ testCase "Get docker version" testDockerVersion,
85+ testCase "Find image by name" testFindImage,
86+ testCase "Run a dummy container and read its log" testRunAndReadLog]
87+
88+jsonTests :: TestTree
89+jsonTests = testGroup "JSON Tests" [testExposedPorts]
7290
7391setup :: IO ()
7492setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()
7593
76−main :: IO ()
77−main = do
78− setup
79− defaultMain tests
80−
8194isRight (Left _) = False
8295isRight (Right _) = True
8396
@@ -86,3 +99,9 @@ fromRight (Left l) = do
8699 liftIO $ assertFailure $ "Left: " ++ show l
87100 undefined
88101fromRight (Right r) = return r
102+
103+main :: IO ()
104+main = do
105+ setup
106+ defaultMain $ testGroup "Tests" [jsonTests, integrationTests]
107+