@@ -2,7 +2,6 @@
22
33module Main where
44
5−import Data.Either (rights)
65import Prelude hiding (all)
76import qualified Test.QuickCheck.Monadic as QCM
87import Test.Tasty
@@ -24,7 +23,7 @@ import qualified Data.ByteString.Lazy as BL
2423import qualified Data.HashMap.Strict as HM
2524import Data.Int (Int)
2625import qualified Data.Map as M
27−import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)
26+import Data.Maybe (fromJust, isJust)
2827import Data.Monoid
2928import Data.Text (Text, unpack)
3029import qualified Data.Vector as V
@@ -40,7 +39,6 @@ import Docker.Client
4039
4140-- opts = defaultClientOpts
4241testImageName = "docker-hs/test"
43−imageToDeleteFullName = "hello-world:latest"
4442
4543toStrict1 = B.concat . BL.toChunks
4644
@@ -74,27 +72,13 @@ testFindImage =
7472 where
7573 imageFullName = testImageName <> ":latest"
7674
77−testDeleteImage :: IO ()
78−testDeleteImage = runDocker $ do
79− img <- fmap fromJust findTestImage
80− result <- deleteImage defaultImageDeleteOpts (imageId img)
81− lift $ assert $ isRight result
82− maybeTestImageAfter <- findTestImage
83− lift $ assert $ isNothing maybeTestImageAfter
84− where
85− findTestImage =
86− do
87− images <- listImages defaultListOpts >>= fromRight
88− return $ listToMaybe
89− $ filter (elem imageToDeleteFullName . imageRepoTags) images
90−
9175testListContainers :: IO ()
9276testListContainers =
9377 runDocker $
9478 do containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
9579 c <- fromRight containerId
9680 res <- listContainers $ ListOpts { all=True }
97− deleteContainer (ContainerDeleteOpts True True) c
81+ deleteContainer (DeleteOpts True True) c
9882 lift $ assert $ isRight res
9983
10084testBuildFromDockerfile :: IO ()
@@ -116,7 +100,6 @@ testRunAndReadLogHelper :: NetworkingConfig -> IO ()
116100testRunAndReadLogHelper networkingConfig =
117101 runDocker $
118102 do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
119− createdNetworks <- rights <$> mapM createNetworkWithName networkNames
120103 containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
121104 c <- fromRight containerId
122105 status1 <- startContainer defaultStartOpts c
@@ -125,15 +108,11 @@ testRunAndReadLogHelper networkingConfig =
125108 lift $ assertBool ("starting the container, unexpected status: " ++ show status1) $ isRightUnit status1
126109 logs <- getContainerLogs defaultLogOpts c >>= fromRight
127110 lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
128− status3 <- deleteContainer (ContainerDeleteOpts True True) c
111+ status3 <- deleteContainer (DeleteOpts True True) c
129112 lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3
130− mapM_ removeNetwork createdNetworks
131113 where
132114 isRightUnit (Right ()) = True
133115 isRightUnit _ = False
134− networkNames = HM.keys $ endpointsConfig networkingConfig
135− createNetworkWithName name = createNetwork $
136− (defaultCreateNetworkOpts name) { createNetworkCheckDuplicate = True }
137116
138117testCreateRemoveNetwork :: IO ()
139118testCreateRemoveNetwork = do
@@ -243,7 +222,6 @@ integrationTests =
243222 [ testCase "Get docker version" testDockerVersion
244223 , testCase "Build image from Dockerfile" testBuildFromDockerfile
245224 , testCase "Find image by name" testFindImage
246− , testCase "Delete image" testDeleteImage
247225 , testCase "List containers" testListContainers
248226 , testCase "Run a dummy container and read its log" testRunAndReadLog
249227 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
@@ -265,11 +243,7 @@ jsonTests =
265243 ]
266244
267245setup :: IO ()
268−setup =
269− mapM_ system
270− [ "docker pull " ++ unpack imageToDeleteFullName
271− , "docker build -t " ++ unpack testImageName ++ " tests"
272− ]
246+setup = system ("docker build -t " ++ unpack testImageName ++ " tests") >> return ()
273247
274248isLeft = not . isRight
275249