@@ -2,6 +2,7 @@
22
33module Main where
44
5+import Data.Either (rights)
56import Prelude hiding (all)
67import qualified Test.QuickCheck.Monadic as QCM
78import Test.Tasty
@@ -23,7 +24,7 @@ import qualified Data.ByteString.Lazy as BL
2324import qualified Data.HashMap.Strict as HM
2425import Data.Int (Int)
2526import qualified Data.Map as M
26−import Data.Maybe (fromJust, isJust)
27+import Data.Maybe (fromJust, isJust, isNothing, listToMaybe)
2728import Data.Monoid
2829import Data.Text (Text, unpack)
2930import qualified Data.Vector as V
@@ -39,6 +40,7 @@ import Docker.Client
3940
4041-- opts = defaultClientOpts
4142testImageName = "docker-hs/test"
43+imageToDeleteFullName = "hello-world:latest"
4244
4345toStrict1 = B.concat . BL.toChunks
4446
@@ -72,13 +74,27 @@ testFindImage =
7274 where
7375 imageFullName = testImageName <> ":latest"
7476
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+
7591testListContainers :: IO ()
7692testListContainers =
7793 runDocker $
7894 do containerId <- createContainer (defaultCreateOpts (testImageName <> ":latest")) Nothing
7995 c <- fromRight containerId
8096 res <- listContainers $ ListOpts { all=True }
81− deleteContainer (DeleteOpts True True) c
97+ deleteContainer (ContainerDeleteOpts True True) c
8298 lift $ assert $ isRight res
8399
84100testBuildFromDockerfile :: IO ()
@@ -100,6 +116,7 @@ testRunAndReadLogHelper :: NetworkingConfig -> IO ()
100116testRunAndReadLogHelper networkingConfig =
101117 runDocker $
102118 do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
119+ createdNetworks <- rights <$> mapM createNetworkWithName networkNames
103120 containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
104121 c <- fromRight containerId
105122 status1 <- startContainer defaultStartOpts c
@@ -108,11 +125,15 @@ testRunAndReadLogHelper networkingConfig =
108125 lift $ assertBool ("starting the container, unexpected status: " ++ show status1) $ isRightUnit status1
109126 logs <- getContainerLogs defaultLogOpts c >>= fromRight
110127 lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
111− status3 <- deleteContainer (DeleteOpts True True) c
128+ status3 <- deleteContainer (ContainerDeleteOpts True True) c
112129 lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3
130+ mapM_ removeNetwork createdNetworks
113131 where
114132 isRightUnit (Right ()) = True
115133 isRightUnit _ = False
134+ networkNames = HM.keys $ endpointsConfig networkingConfig
135+ createNetworkWithName name = createNetwork $
136+ (defaultCreateNetworkOpts name) { createNetworkCheckDuplicate = True }
116137
117138testCreateRemoveNetwork :: IO ()
118139testCreateRemoveNetwork = do
@@ -222,6 +243,7 @@ integrationTests =
222243 [ testCase "Get docker version" testDockerVersion
223244 , testCase "Build image from Dockerfile" testBuildFromDockerfile
224245 , testCase "Find image by name" testFindImage
246+ , testCase "Delete image" testDeleteImage
225247 , testCase "List containers" testListContainers
226248 , testCase "Run a dummy container and read its log" testRunAndReadLog
227249 , testCase "Run a dummy container with networking and read its log" testRunAndReadLogWithNetworking
@@ -243,7 +265,11 @@ jsonTests =
243265 ]
244266
245267setup :: IO ()
246−setup = system ("docker build -t " ++ unpack testImageName ++ " tests") >> return ()
268+setup =
269+ mapM_ system
270+ [ "docker pull " ++ unpack imageToDeleteFullName
271+ , "docker build -t " ++ unpack testImageName ++ " tests"
272+ ]
247273
248274isLeft = not . isRight
249275