Add expiry policy on queue

This should delete the queue after it's unused for over 1 Minute.

Author: supersven

integration/test/Testlib/Run.hs

@@ -171,7 +171,17 @@ deleteFederationQueues testDomains opts username password = do
     page <- client.listQueuesByVHost opts.vHost (fromString $ "^backend-notifications\\." <> domain <> "$") True 100 1
     for_ page.items $ \queue -> do
       putStrLn $ "Deleting queue " <> T.unpack queue.name
-      void $ deleteQueue client opts.vHost queue.name
+      void $
+        addPolicy
+          client
+          opts.vHost
+          (T.pack "expiry")
+          ( RabbitMQPolicy
+              { polPattern = (fromString $ "^backend-notifications\\." <> domain <> "$"),
+                polApplyTo = Queues,
+                polDefinition = RabbitMQPolicyDefinition {expires = Just 60000}
+              }
+          )
 
 doListTests :: [(String, String, String, x)] -> IO ()
 doListTests tests = for_ tests $ \(qname, _desc, _full, _) -> do

libs/extended/src/Network/RabbitMqAdmin.hs

@@ -30,6 +30,56 @@ instance (ToJSON a) => ToJSON (Page a) where
         { fieldLabelModifier = camelTo2 '_'
         }
 
+-- | Target(s) of a `RabbitMQPolicy`
+--
+-- This type is incomplete. Add more constructors when needed.
+data RabbitMQPolicyTarget = Queues
+  deriving (Show, Generic)
+
+instance FromJSON RabbitMQPolicyTarget
+
+instance ToJSON RabbitMQPolicyTarget
+
+data RabbitMQPolicyDefinition = RabbitMQPolicyDefinition
+  { expires :: Maybe Word
+  }
+  deriving (Show, Generic)
+
+instance FromJSON RabbitMQPolicyDefinition
+
+instance ToJSON RabbitMQPolicyDefinition
+
+data RabbitMQPolicy = RabbitMQPolicy
+  { polPattern :: Text,
+    polApplyTo :: RabbitMQPolicyTarget,
+    polDefinition :: RabbitMQPolicyDefinition
+  }
+  deriving (Show, Generic)
+
+dropPrefixLabelModifier :: String -> String
+dropPrefixLabelModifier = lowerFirst . dropPrefix
+  where
+    lowerFirst :: String -> String
+    lowerFirst (x : xs) = toLower x : xs
+    lowerFirst [] = ""
+
+    dropPrefix :: String -> String
+    dropPrefix = drop (length ("pol" :: String))
+
+instance FromJSON RabbitMQPolicy where
+  parseJSON =
+    genericParseJSON $
+      defaultOptions
+        { fieldLabelModifier = dropPrefixLabelModifier
+        }
+
+instance ToJSON RabbitMQPolicy where
+  toJSON =
+    genericToJSON $
+      defaultOptions
+        { fieldLabelModifier = dropPrefixLabelModifier
+        }
+
 -- | Upstream Docs:
 -- https://rawcdn.githack.com/rabbitmq/rabbitmq-server/v3.12.0/deps/rabbitmq_management/priv/www/api/index.html
 data AdminAPI route = AdminAPI
@@ -50,6 +100,14 @@ data AdminAPI route = AdminAPI
           :> Capture "vhost" VHost
           :> Capture "queue" QueueName
           :> DeleteNoContent,
+    addPolicy ::
+      route
+        :- "api"
+          :> "policies"
+          :> Capture "vhost" VHost
+          :> Capture "policy_name" Text
+          :> ReqBody '[JSON] RabbitMQPolicy
+          :> PutNoContent,
     listConnectionsByVHost ::
       route
         :- "api"

services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs

@@ -403,6 +403,7 @@ mockApi mockAdmin =
   AdminAPI
     { listQueuesByVHost = mockListQueuesByVHost mockAdmin,
       deleteQueue = mockListDeleteQueue mockAdmin,
+      addPolicy = todo ("Not required yet." :: String),
       listConnectionsByVHost = mockListConnectionsByVHost mockAdmin,
       deleteConnection = mockDeleteConnection mockAdmin
     }