@@ -9,7 +9,13 @@ import Data.Foldable
9
9
import Data.Function
10
10
import Data.Functor
11
11
import Data.List
12
+ import Data.Maybe (fromMaybe )
13
+ import Data.String (IsString (fromString ))
14
+ import Data.Text (Text )
15
+ import qualified Data.Text as T
12
16
import Data.Time.Clock
17
+ import Network.AMQP.Extended
18
+ import Network.RabbitMqAdmin
13
19
import RunAllTests
14
20
import System.Directory
15
21
import System.Environment
@@ -133,11 +139,51 @@ runTests tests mXMLOutput cfg = do
133
139
pure (TestSuiteReport [TestCaseReport qname TestSuccess tm])
134
140
writeChan output Nothing
135
141
wait displayThread
142
+ deleteFederationV0AndV1Queues genv
136
143
printReport report
137
144
mapM_ (saveXMLReport report) mXMLOutput
138
145
when (any (\ testCase -> testCase. result /= TestSuccess ) report. cases) $
139
146
exitFailure
140
147
148
+ deleteFederationV0AndV1Queues :: GlobalEnv -> IO ()
149
+ deleteFederationV0AndV1Queues env = do
150
+ let testDomains = env. gDomain1 : env. gDomain2 : env. gDynamicDomains
151
+ putStrLn " Attempting to delete federation V0 queues..."
152
+ (mV0User, mV0Pass) <- readCredsFromEnvWithSuffix " V0"
153
+ fromMaybe (putStrLn " No or incomplete credentials for fed V0 RabbitMQ" ) $
154
+ deleteFederationQueues testDomains env. gRabbitMQConfigV0 <$> mV0User <*> mV0Pass
155
+
156
+ putStrLn " Attempting to delete federation V1 queues..."
157
+ (mV1User, mV1Pass) <- readCredsFromEnvWithSuffix " V1"
158
+ fromMaybe (putStrLn " No or incomplete credentials for fed V1 RabbitMQ" ) $
159
+ deleteFederationQueues testDomains env. gRabbitMQConfigV1 <$> mV1User <*> mV1Pass
160
+ where
161
+ readCredsFromEnvWithSuffix :: String -> IO (Maybe Text , Maybe Text )
162
+ readCredsFromEnvWithSuffix suffix =
163
+ (,)
164
+ <$> (fmap fromString <$> lookupEnv (" RABBITMQ_USERNAME_" <> suffix))
165
+ <*> (fmap fromString <$> lookupEnv (" RABBITMQ_PASSWORD_" <> suffix))
166
+
167
+ deleteFederationQueues :: [String ] -> RabbitMQConfig -> Text -> Text -> IO ()
168
+ deleteFederationQueues testDomains rc username password = do
169
+ let opts =
170
+ RabbitMqAdminOpts
171
+ { host = rc. host,
172
+ port = 0 ,
173
+ adminPort = fromIntegral rc. adminPort,
174
+ vHost = fromString rc. vHost,
175
+ tls =
176
+ if rc. tls
177
+ then Just (RabbitMqTlsOpts Nothing True )
178
+ else Nothing
179
+ }
180
+ client <- mkRabbitMqAdminClientEnvWithCreds opts username password
181
+ for_ testDomains $ \ domain -> do
182
+ page <- client. listQueuesByVHost (fromString rc. vHost) (fromString $ " ^backend-notifications\\ ." <> domain <> " $" ) True 100 1
183
+ for_ page. items $ \ queue -> do
184
+ putStrLn $ " Deleting queue " <> T. unpack queue. name
185
+ void $ deleteQueue client (fromString rc. vHost) queue. name
186
+
141
187
doListTests :: [(String , String , String , x )] -> IO ()
142
188
doListTests tests = for_ tests $ \ (qname, _desc, _full, _) -> do
143
189
putStrLn qname
0 commit comments