@@ -2,6 +2,7 @@
3module Main where
3module Main where
5+import Data.Either (rights)
5import Prelude hiding (all)
6import Prelude hiding (all)
6import qualified Test.QuickCheck.Monadic as QCM
7import qualified Test.QuickCheck.Monadic as QCM
7import Test.Tasty
8import Test.Tasty
@@ -100,6 +101,7 @@ testRunAndReadLogHelper :: NetworkingConfig -> IO ()
100testRunAndReadLogHelper networkingConfig =
101testRunAndReadLogHelper networkingConfig =
101 runDocker $
102 runDocker $
102 do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
103 do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
104+ createdNetworks <- rights <$> mapM createNetworkWithName networkNames
103 containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
105 containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
104 c <- fromRight containerId
106 c <- fromRight containerId
105 status1 <- startContainer defaultStartOpts c
107 status1 <- startContainer defaultStartOpts c
@@ -110,9 +112,13 @@ testRunAndReadLogHelper networkingConfig =
110 lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
112 lift $ assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)
111 status3 <- deleteContainer (DeleteOpts True True) c
113 status3 <- deleteContainer (DeleteOpts True True) c
112 lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3
114 lift $ assertBool ("deleting container, unexpected status: " ++ show status3) $ isRightUnit status3
115+ mapM_ removeNetwork createdNetworks
114 isRightUnit (Right ()) = True
117 isRightUnit (Right ()) = True
115 isRightUnit _ = False
118 isRightUnit _ = False
119+ networkNames = HM.keys $ endpointsConfig networkingConfig
120+ createNetworkWithName name = createNetwork $
121+ (defaultCreateNetworkOpts name) { createNetworkCheckDuplicate = True }
117testCreateRemoveNetwork :: IO ()
123testCreateRemoveNetwork :: IO ()
118testCreateRemoveNetwork = do
124testCreateRemoveNetwork = do