amqp 0.20.0.1 → 0.21.0

raw patch · 9 files changed

+377/−357 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Network.AMQP: isNormalChannelClose :: SomeException -> Bool

Files

Network/AMQP.hs +90/−99
Network/AMQP/ChannelAllocator.hs +1/−1
Network/AMQP/Helpers.hs +2/−2
Network/AMQP/Internal.hs +252/−227
Network/AMQP/Lifted.hs +1/−4
Network/AMQP/Protocol.hs +13/−12
Network/AMQP/Types.hs +12/−11
amqp.cabal +1/−1
changelog.md +5/−0

Network/AMQP.hs view

@@ -73,6 +73,7 @@     openChannel,
     addReturnListener,
     addChannelExceptionHandler,
+    isNormalChannelClose,
     qos,
 
     -- * Exchanges
@@ -177,19 +178,17 @@ ----- EXCHANGE -----
 
 -- | A record that contains the fields needed when creating a new exhange using 'declareExchange'. The default values apply when you use 'newExchange'.
-data ExchangeOpts = ExchangeOpts
-                {
-                    exchangeName :: Text, -- ^ (must be set); the name of the exchange
-                    exchangeType :: Text, -- ^ (must be set); the type of the exchange (\"fanout\", \"direct\", \"topic\", \"headers\")
+data ExchangeOpts = ExchangeOpts {
+    exchangeName :: Text, -- ^ (must be set); the name of the exchange
+    exchangeType :: Text, -- ^ (must be set); the type of the exchange (\"fanout\", \"direct\", \"topic\", \"headers\")
 
-                    -- optional
-                    exchangePassive :: Bool, -- ^ (default 'False'); If set, the server will not create the exchange. The client can use this to check whether an exchange exists without modifying the server state.
-                    exchangeDurable :: Bool, -- ^ (default 'True'); If set when creating a new exchange, the exchange will be marked as durable. Durable exchanges remain active when a server restarts. Non-durable exchanges (transient exchanges) are purged if/when a server restarts.
-                    exchangeAutoDelete :: Bool, -- ^ (default 'False'); If set, the exchange is deleted when all queues have finished using it.
-                    exchangeInternal :: Bool, -- ^ (default 'False'); If set, the exchange may not be used directly by publishers, but only when bound to other exchanges. Internal exchanges are used to construct wiring that is not visible to applications.
-                    exchangeArguments  :: FieldTable -- ^ (default empty); A set of arguments for the declaration. The syntax and semantics of these arguments depends on the server implementation.
-                }
-    deriving (Eq, Ord, Read, Show)
+    -- optional
+    exchangePassive :: Bool, -- ^ (default 'False'); If set, the server will not create the exchange. The client can use this to check whether an exchange exists without modifying the server state.
+    exchangeDurable :: Bool, -- ^ (default 'True'); If set when creating a new exchange, the exchange will be marked as durable. Durable exchanges remain active when a server restarts. Non-durable exchanges (transient exchanges) are purged if/when a server restarts.
+    exchangeAutoDelete :: Bool, -- ^ (default 'False'); If set, the exchange is deleted when all queues have finished using it.
+    exchangeInternal :: Bool, -- ^ (default 'False'); If set, the exchange may not be used directly by publishers, but only when bound to other exchanges. Internal exchanges are used to construct wiring that is not visible to applications.
+    exchangeArguments  :: FieldTable -- ^ (default empty); A set of arguments for the declaration. The syntax and semantics of these arguments depends on the server implementation.
+} deriving (Eq, Ord, Read, Show)
 
 -- | an 'ExchangeOpts' with defaults set; you must override at least the 'exchangeName' and 'exchangeType' fields.
 newExchange :: ExchangeOpts
@@ -259,19 +258,17 @@ ----- QUEUE -----
 
 -- | A record that contains the fields needed when creating a new queue using 'declareQueue'. The default values apply when you use 'newQueue'.
-data QueueOpts = QueueOpts
-             {
-                --must be set
-                queueName :: Text, -- ^ (default \"\"); the name of the queue; if left empty, the server will generate a new name and return it from the 'declareQueue' method
+data QueueOpts = QueueOpts {
+    --must be set
+    queueName :: Text, -- ^ (default \"\"); the name of the queue; if left empty, the server will generate a new name and return it from the 'declareQueue' method
 
-                --optional
-                queuePassive :: Bool, -- ^ (default 'False'); If set, the server will not create the queue.  The client can use this to check whether a queue exists without modifying the server state.
-                queueDurable :: Bool, -- ^ (default 'True'); If set when creating a new queue, the queue will be marked as durable. Durable queues remain active when a server restarts. Non-durable queues (transient queues) are purged if/when a server restarts. Note that durable queues do not necessarily hold persistent messages, although it does not make sense to send persistent messages to a transient queue.
-                queueExclusive :: Bool, -- ^ (default 'False'); Exclusive queues may only be consumed from by the current connection. Setting the 'exclusive' flag always implies 'auto-delete'.
-                queueAutoDelete :: Bool, -- ^ (default 'False'); If set, the queue is deleted when all consumers have finished using it. Last consumer can be cancelled either explicitly or because its channel is closed. If there was no consumer ever on the queue, it won't be deleted.
-                queueHeaders :: FieldTable -- ^ (default empty): Headers to use when creating this queue, such as @x-message-ttl@ or @x-dead-letter-exchange@.
-             }
-      deriving (Eq, Ord, Read, Show)
+    --optional
+    queuePassive :: Bool, -- ^ (default 'False'); If set, the server will not create the queue.  The client can use this to check whether a queue exists without modifying the server state.
+    queueDurable :: Bool, -- ^ (default 'True'); If set when creating a new queue, the queue will be marked as durable. Durable queues remain active when a server restarts. Non-durable queues (transient queues) are purged if/when a server restarts. Note that durable queues do not necessarily hold persistent messages, although it does not make sense to send persistent messages to a transient queue.
+    queueExclusive :: Bool, -- ^ (default 'False'); Exclusive queues may only be consumed from by the current connection. Setting the 'exclusive' flag always implies 'auto-delete'.
+    queueAutoDelete :: Bool, -- ^ (default 'False'); If set, the queue is deleted when all consumers have finished using it. Last consumer can be cancelled either explicitly or because its channel is closed. If there was no consumer ever on the queue, it won't be deleted.
+    queueHeaders :: FieldTable -- ^ (default empty): Headers to use when creating this queue, such as @x-message-ttl@ or @x-dead-letter-exchange@.
+} deriving (Eq, Ord, Read, Show)
 
 -- | a 'QueueOpts' with defaults set; you should override at least 'queueName'.
 newQueue :: QueueOpts
@@ -284,15 +281,15 @@ -- @messageCount@ is the number of messages in the queue, which will be zero for newly-created queues. @consumerCount@ is the number of active consumers for the queue.
 declareQueue :: Channel -> QueueOpts -> IO (Text, Int, Int)
 declareQueue chan queue = do
-    (SimpleMethod (Queue_declare_ok (ShortString qName) messageCount consumerCount)) <- request chan $ (SimpleMethod (Queue_declare
-            1 -- ticket
-            (ShortString $ queueName queue)
-            (queuePassive queue)
-            (queueDurable queue)
-            (queueExclusive queue)
-            (queueAutoDelete queue)
-            False -- no-wait; true means no answer from server
-            (queueHeaders queue)))
+    SimpleMethod (Queue_declare_ok (ShortString qName) messageCount consumerCount) <- request chan $ SimpleMethod $ Queue_declare
+        1 -- ticket
+        (ShortString $ queueName queue)
+        (queuePassive queue)
+        (queueDurable queue)
+        (queueExclusive queue)
+        (queueAutoDelete queue)
+        False -- no-wait; true means no answer from server
+        (queueHeaders queue)
     return (qName, fromIntegral messageCount, fromIntegral consumerCount)
 
 -- | @bindQueue chan queue exchange routingKey@ binds the queue to the exchange using the provided routing key. If @exchange@ is the empty string, the default exchange will be used.
@@ -331,30 +328,28 @@ -- | remove all messages from the queue; returns the number of messages that were in the queue
 purgeQueue :: Channel -> Text -> IO Word32
 purgeQueue chan queue = do
-    (SimpleMethod (Queue_purge_ok msgCount)) <- request chan $ (SimpleMethod (Queue_purge
+    SimpleMethod (Queue_purge_ok msgCount) <- request chan $ SimpleMethod $ Queue_purge
         1 -- ticket
         (ShortString queue) -- queue
         False -- nowait
-        ))
     return msgCount
 
 -- | deletes the queue; returns the number of messages that were in the queue before deletion
 deleteQueue :: Channel -> Text -> IO Word32
 deleteQueue chan queue = do
-    (SimpleMethod (Queue_delete_ok msgCount)) <- request chan $ (SimpleMethod (Queue_delete
+    SimpleMethod (Queue_delete_ok msgCount) <- request chan $ SimpleMethod $ Queue_delete
         1 -- ticket
         (ShortString queue) -- queue
         False -- if_unused
         False -- if_empty
         False -- nowait
-        ))
     return msgCount
 
 ----- MSG (the BASIC class in AMQP) -----
 
 -- | a 'Msg' with defaults set; you should override at least 'msgBody'
 newMsg :: Message
-newMsg = Message (BL.empty) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+newMsg = Message BL.empty Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 -- | specifies whether you have to acknowledge messages that you receive from 'consumeMsgs' or 'getMsg'. If you use 'Ack', you have to call 'ackMsg' or 'ackEnv' after you have processed a message, otherwise it might be delivered again in the future
 data Ack = Ack | NoAck
@@ -394,16 +389,16 @@ --
 -- The @callback@ will be run on the channel's receiver thread (which is responsible for handling all incoming messages on this channel, including responses to requests from the client) so DO NOT perform any blocking request on @chan@ inside the callback, as this would lead to a dead-lock. However, you CAN perform requests on other open channels inside the callback, though that would keep @chan@ blocked until the requests are done, so it is not recommended.
 --
--- Unless you're using AMQP flow control, the following functions can safely be called on @chan@: 'ackMsg', 'ackEnv', 'rejectMsg', 'publishMsg'. If you use flow-control or want to perform anything more complex, it's a good idea to wrap your requests inside 'forkIO'.
+-- Unless you're using AMQP flow control, the following functions can safely be called on @chan@: 'ackMsg', 'ackEnv', 'rejectMsg', 'publishMsg'. If you use flow-control or want to perform anything more complex, it's recommended that instead of using 'consumeMsgs' you use 'getMsg' to fetch messages in a loop (because then your message-handling code will not run in the channel's receiver thread, so there will be no problems when performing blocking requests).
 consumeMsgs :: Channel -> Text -> Ack -> ((Message,Envelope) -> IO ()) -> IO ConsumerTag
 consumeMsgs chan queue ack callback =
-  consumeMsgs' chan queue ack callback (\_ -> return ()) (FieldTable M.empty)
+    consumeMsgs' chan queue ack callback (\_ -> return ()) (FieldTable M.empty)
 
 -- | an extended version of @consumeMsgs@ that allows you to define a consumer cancellation callback and include arbitrary arguments.
 consumeMsgs' :: Channel -> Text -> Ack -> ((Message,Envelope) -> IO ()) -> (ConsumerTag -> IO ()) -> FieldTable -> IO ConsumerTag
 consumeMsgs' chan queue ack callback cancelCB args = do
     --generate a new consumer tag
-    newConsumerTag <- (fmap (T.pack . show)) $ modifyMVar (lastConsumerTag chan) $ \c -> return (c+1,c+1)
+    newConsumerTag <- fmap (T.pack . show) $ modifyMVar (lastConsumerTag chan) $ \c -> return (c+1,c+1)
 
     --register the consumer
     modifyMVar_ (consumers chan) $ return . M.insert newConsumerTag (callback, cancelCB)
@@ -423,10 +418,9 @@ -- | stops a consumer that was started with 'consumeMsgs'
 cancelConsumer :: Channel -> ConsumerTag -> IO ()
 cancelConsumer chan consumerTag = do
-    (SimpleMethod (Basic_cancel_ok _)) <- request chan $ (SimpleMethod (Basic_cancel
+    SimpleMethod (Basic_cancel_ok _) <- request chan $ SimpleMethod $ Basic_cancel
         (ShortString consumerTag) -- consumer_tag
         False -- nowait
-        ))
 
     --unregister the consumer
     modifyMVar_ (consumers chan) $ return . M.delete consumerTag
@@ -443,30 +437,31 @@ publishMsg' :: Channel -> Text -> Text -> Bool -> Message -> IO (Maybe Int)
 publishMsg' chan exchange routingKey mandatory msg = do
     modifyMVar (nextPublishSeqNum chan) $ \nxtSeqNum -> do
-        writeAssembly chan (ContentMethod (Basic_publish
-            1 -- ticket; ignored by rabbitMQ
-            (ShortString exchange)
-            (ShortString routingKey)
-            mandatory -- mandatory; if true, the server might return the msg, which is currently not handled
-            False) --immediate; not customizable, as it is currently not supported anymore by RabbitMQ
-
+        writeAssembly chan $ ContentMethod
+            (Basic_publish
+                1 -- ticket; ignored by rabbitMQ
+                (ShortString exchange)
+                (ShortString routingKey)
+                mandatory -- mandatory; if true, the server might return the msg, which is currently not handled
+                False --immediate; not customizable, as it is currently not supported anymore by RabbitMQ
+            )
             (CHBasic
-            (fmap ShortString $ msgContentType msg)
-            (fmap ShortString $ msgContentEncoding msg)
-            (msgHeaders msg)
-            (fmap deliveryModeToInt $ msgDeliveryMode msg)
-            (msgPriority msg)
-            (fmap ShortString $ msgCorrelationID msg)
-            (fmap ShortString $ msgReplyTo msg)
-            (fmap ShortString $ msgExpiration msg)
-            (fmap ShortString $ msgID msg)
-            (msgTimestamp msg)
-            (fmap ShortString $ msgType msg)
-            (fmap ShortString $ msgUserID msg)
-            (fmap ShortString $ msgApplicationID msg)
-            (fmap ShortString $ msgClusterID msg)
+                (ShortString <$> msgContentType msg)
+                (ShortString <$> msgContentEncoding msg)
+                (msgHeaders msg)
+                (deliveryModeToInt <$> msgDeliveryMode msg)
+                (msgPriority msg)
+                (ShortString <$> msgCorrelationID msg)
+                (ShortString <$> msgReplyTo msg)
+                (ShortString <$> msgExpiration msg)
+                (ShortString <$> msgID msg)
+                (msgTimestamp msg)
+                (ShortString <$> msgType msg)
+                (ShortString <$> msgUserID msg)
+                (ShortString <$> msgApplicationID msg)
+                (ShortString <$> msgClusterID msg)
             )
-            (msgBody msg))
+            (msgBody msg)
 
         if nxtSeqNum /= 0
             then do
@@ -474,19 +469,20 @@                 return (succ nxtSeqNum, Just nxtSeqNum)
            else return (0, Nothing)
 
--- | @getMsg chan ack queue@ gets a message from the specified queue. If @ack=='Ack'@, you have to call 'ackMsg' or 'ackEnv' for any message that you get, otherwise it might be delivered again in the future (by calling 'recoverMsgs')
+-- | @getMsg chan ack queue@ gets a message from the specified queue. If @ack=='Ack'@, you have to call 'ackMsg' or 'ackEnv' for any message that you get, otherwise it might be delivered again in the future (by calling 'recoverMsgs').
+--
+-- Will return @Nothing@ when no message is currently available.
 getMsg :: Channel -> Ack -> Text -> IO (Maybe (Message, Envelope))
 getMsg chan ack queue = do
-    ret <- request chan (SimpleMethod (Basic_get
+    ret <- request chan $ SimpleMethod $ Basic_get
         1 -- ticket
         (ShortString queue) -- queue
         (ackToBool ack) -- no_ack
-        ))
     case ret of
         ContentMethod (Basic_get_ok deliveryTag redelivered (ShortString exchange) (ShortString routingKey) _) properties body ->
-            return $ Just $ (msgFromContentHeaderProperties properties body,
-                             Envelope {envDeliveryTag = deliveryTag, envRedelivered = redelivered,
-                             envExchangeName = exchange, envRoutingKey = routingKey, envChannel = chan})
+            return $ Just (msgFromContentHeaderProperties properties body,
+                           Envelope {envDeliveryTag = deliveryTag, envRedelivered = redelivered,
+                                     envExchangeName = exchange, envRoutingKey = routingKey, envChannel = chan})
         _ -> return Nothing
 
 {- | @ackMsg chan deliveryTag multiple@ acknowledges one or more messages. A message MUST not be acknowledged more than once.
@@ -497,10 +493,9 @@ -}
 ackMsg :: Channel -> LongLongInt -> Bool -> IO ()
 ackMsg chan deliveryTag multiple =
-    writeAssembly chan $ (SimpleMethod (Basic_ack
+    writeAssembly chan $ SimpleMethod $ Basic_ack
         deliveryTag -- delivery_tag
         multiple -- multiple
-        ))
 
 -- | Acknowledges a single message. This is a wrapper for 'ackMsg' in case you have the 'Envelope' at hand.
 ackEnv :: Envelope -> IO ()
@@ -514,11 +509,10 @@ -}
 nackMsg :: Channel -> LongLongInt -> Bool -> Bool -> IO ()
 nackMsg chan deliveryTag multiple requeue =
-    writeAssembly chan $ (SimpleMethod (Basic_nack
+    writeAssembly chan $ SimpleMethod $ Basic_nack
         deliveryTag -- delivery_tag
         multiple -- multiple
         requeue -- requeue
-        ))
 
 -- | Reject a single message. This is a wrapper for 'nackMsg' in case you have the 'Envelope' at hand.
 nackEnv :: Envelope -> IO ()
@@ -529,10 +523,9 @@ -- NOTE: RabbitMQ 1.7 doesn't implement this command
 rejectMsg :: Channel -> LongLongInt -> Bool -> IO ()
 rejectMsg chan deliveryTag requeue =
-    writeAssembly chan $ (SimpleMethod (Basic_reject
+    writeAssembly chan $ SimpleMethod $ Basic_reject
         deliveryTag -- delivery_tag
         requeue -- requeue
-        ))
 
 -- | Reject a message. This is a wrapper for 'rejectMsg' in case you have the 'Envelope' at hand.
 rejectEnv :: Envelope
@@ -544,9 +537,8 @@ --If @requeue==False@, the message will be redelivered to the original recipient. If @requeue==True@, the server will attempt to requeue the message, potentially then delivering it to an alternative subscriber.
 recoverMsgs :: Channel -> Bool -> IO ()
 recoverMsgs chan requeue = do
-    SimpleMethod Basic_recover_ok <- request chan $ (SimpleMethod (Basic_recover
+    SimpleMethod Basic_recover_ok <- request chan $ SimpleMethod $ Basic_recover
         requeue -- requeue
-        ))
     return ()
 
 ------------------- TRANSACTIONS (TX) --------------------------
@@ -554,19 +546,19 @@ -- | This method sets the channel to use standard transactions.  The client must use this method at least once on a channel before using the Commit or Rollback methods.
 txSelect :: Channel -> IO ()
 txSelect chan = do
-    (SimpleMethod Tx_select_ok) <- request chan $ SimpleMethod Tx_select
+    SimpleMethod Tx_select_ok <- request chan $ SimpleMethod Tx_select
     return ()
 
 -- | This method commits all messages published and acknowledged in the current transaction.  A new transaction starts immediately after a commit.
 txCommit :: Channel -> IO ()
 txCommit chan = do
-    (SimpleMethod Tx_commit_ok) <- request chan $ SimpleMethod Tx_commit
+    SimpleMethod Tx_commit_ok <- request chan $ SimpleMethod Tx_commit
     return ()
 
 -- | This method abandons all messages published and acknowledged in the current transaction. A new transaction starts immediately after a rollback.
 txRollback :: Channel -> IO ()
 txRollback chan = do
-    (SimpleMethod Tx_rollback_ok) <- request chan $ SimpleMethod Tx_rollback
+    SimpleMethod Tx_rollback_ok <- request chan $ SimpleMethod Tx_rollback
     return ()
 
 
@@ -603,17 +595,17 @@ -}
 waitForConfirmsUntil :: Channel -> Int -> IO ConfirmationResult
 waitForConfirmsUntil chan timeout = do
-  delay <- registerDelay timeout
-  let partial = do
-        expired <- readTVar delay
-        if expired
-           then return . Partial =<< (,,)
-                <$> swapTVar (ackedSet chan) IntSet.empty
-                <*> swapTVar (nackedSet chan) IntSet.empty
-                <*> readTVar (unconfirmedSet chan)
-           else retry
-      complete = return . Complete =<< waitForAllConfirms chan
-  atomically $ complete `orElse` partial
+    delay <- registerDelay timeout
+    let partial = do
+            expired <- readTVar delay
+            if expired
+                then Partial <$> ((,,)
+                    <$> swapTVar (ackedSet chan) IntSet.empty
+                    <*> swapTVar (nackedSet chan) IntSet.empty
+                    <*> readTVar (unconfirmedSet chan))
+                else retry
+        complete = Complete <$> waitForAllConfirms chan
+    atomically $ complete `orElse` partial
 
 {- | Adds a handler which will be invoked each time the @Channel@ receives a confirmation from the broker.
 The parameters passed to the the handler are the @deliveryTag@ for the message being confirmed, a flag
@@ -639,7 +631,7 @@     -}
 flow :: Channel -> Bool -> IO ()
 flow chan active = do
-    (SimpleMethod (Channel_flow_ok _)) <- request chan $ SimpleMethod (Channel_flow active)
+    SimpleMethod (Channel_flow_ok _) <- request chan $ SimpleMethod (Channel_flow active)
     return ()
 
 -- | Constructs default connection options with the following settings :
@@ -679,7 +671,7 @@ plain loginName loginPassword = SASLMechanism "PLAIN" initialResponse Nothing
   where
     nul = '\0'
-    initialResponse = E.encodeUtf8 $ (T.cons nul loginName) `T.append` (T.cons nul loginPassword)
+    initialResponse = E.encodeUtf8 $ T.cons nul loginName `T.append` T.cons nul loginPassword
 
 -- | The @AMQPLAIN@ SASL mechanism. See <http://www.rabbitmq.com/authentication.html>.
 amqplain :: Text -> Text -> SASLMechanism
@@ -693,7 +685,7 @@ rabbitCRdemo loginName loginPassword = SASLMechanism "RABBIT-CR-DEMO" initialResponse (Just $ const challengeResponse)
   where
     initialResponse = E.encodeUtf8 loginName
-    challengeResponse = return $ (E.encodeUtf8 "My password is ") `BS.append` (E.encodeUtf8 loginPassword)
+    challengeResponse = return $ E.encodeUtf8 "My password is " `BS.append` E.encodeUtf8 loginPassword
 
 -- | @qos chan prefetchSize prefetchCount global@ limits the amount of data the server
 -- delivers before requiring acknowledgements. @prefetchSize@ specifies the
@@ -705,11 +697,10 @@ -- NOTE: RabbitMQ does not implement prefetchSize and will throw an exception if it doesn't equal 0.
 qos :: Channel -> Word32 -> Word16 -> Bool -> IO ()
 qos chan prefetchSize prefetchCount global = do
-    (SimpleMethod Basic_qos_ok) <- request chan (SimpleMethod (Basic_qos
+    SimpleMethod Basic_qos_ok <- request chan $ SimpleMethod $ Basic_qos
         prefetchSize
         prefetchCount
         global
-        ))
     return ()
 
 -- | Parses amqp standard URI of the form @amqp://user:password@host:port/vhost@ and returns a @ConnectionOpts@ for use with @openConnection''@
@@ -717,7 +708,7 @@ fromURI :: String -> ConnectionOpts
 fromURI uri = defaultConnectionOpts {
     coServers     = hostPorts',
-    coVHost       = (T.pack vhost),
+    coVHost       = T.pack vhost,
     coAuth        = [plain (T.pack uid) (T.pack pw)],
     coTLSSettings = if tls then Just TLSTrusted else Nothing
   }

Network/AMQP/ChannelAllocator.hs view

@@ -14,7 +14,7 @@ 
 newChannelAllocator :: Int -> IO ChannelAllocator
 newChannelAllocator maxChannel =
-    fmap (ChannelAllocator maxChannel) $ V.replicate 1024 0
+    ChannelAllocator maxChannel <$> V.replicate 1024 0
 
 allocateChannel :: ChannelAllocator -> IO Int
 allocateChannel (ChannelAllocator maxChannel c) = do

Network/AMQP/Helpers.hs view

@@ -43,11 +43,11 @@ chooseMin a Nothing  = a
 
 getTimestamp :: IO Int64
-getTimestamp = fmap µs $ getTime Monotonic
+getTimestamp = µs <$> getTime Monotonic
   where
     seconds spec = (fromIntegral . sec) spec * 1000 * 1000
     micros spec = (fromIntegral . nsec) spec `div` 1000
-    µs spec = (seconds spec) + (micros spec)
+    µs spec = seconds spec + micros spec
 
 scheduleAtFixedRate :: Int -> IO () -> IO ThreadId
 scheduleAtFixedRate interval_µs action = forkIO $ forever $ do

Network/AMQP/Internal.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, OverloadedStrings, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings, ScopedTypeVariables, LambdaCase #-}
 module Network.AMQP.Internal where
 
 import Paths_amqp(version)
@@ -53,41 +53,37 @@ 
 -- | An AMQP message
 data Message = Message {
-                msgBody :: BL.ByteString, -- ^ the content of your message
-                msgDeliveryMode :: Maybe DeliveryMode, -- ^ see 'DeliveryMode'
-                msgTimestamp :: Maybe Timestamp, -- ^ use in any way you like; this doesn't affect the way the message is handled
-                msgID :: Maybe Text, -- ^ use in any way you like; this doesn't affect the way the message is handled
-                msgType :: Maybe Text, -- ^ use in any way you like; this doesn't affect the way the message is handled
-                msgUserID :: Maybe Text,
-                msgApplicationID :: Maybe Text,
-                msgClusterID :: Maybe Text,
-                msgContentType :: Maybe Text,
-                msgContentEncoding :: Maybe Text,
-                msgReplyTo :: Maybe Text,
-                msgPriority :: Maybe Octet,
-                msgCorrelationID :: Maybe Text,
-                msgExpiration :: Maybe Text,
-                msgHeaders :: Maybe FieldTable
-                }
-    deriving (Eq, Ord, Read, Show)
+    msgBody :: BL.ByteString, -- ^ the content of your message
+    msgDeliveryMode :: Maybe DeliveryMode, -- ^ see 'DeliveryMode'
+    msgTimestamp :: Maybe Timestamp, -- ^ use in any way you like; this doesn't affect the way the message is handled
+    msgID :: Maybe Text, -- ^ use in any way you like; this doesn't affect the way the message is handled
+    msgType :: Maybe Text, -- ^ use in any way you like; this doesn't affect the way the message is handled
+    msgUserID :: Maybe Text,
+    msgApplicationID :: Maybe Text,
+    msgClusterID :: Maybe Text,
+    msgContentType :: Maybe Text,
+    msgContentEncoding :: Maybe Text,
+    msgReplyTo :: Maybe Text,
+    msgPriority :: Maybe Octet,
+    msgCorrelationID :: Maybe Text,
+    msgExpiration :: Maybe Text,
+    msgHeaders :: Maybe FieldTable
+} deriving (Eq, Ord, Read, Show)
 
 -- | contains meta-information of a delivered message (through 'getMsg' or 'consumeMsgs')
-data Envelope = Envelope
-              {
-                envDeliveryTag :: LongLongInt,
-                envRedelivered :: Bool,
-                envExchangeName :: Text,
-                envRoutingKey :: Text,
-                envChannel :: Channel
-              }
+data Envelope = Envelope {
+    envDeliveryTag :: LongLongInt,
+    envRedelivered :: Bool,
+    envExchangeName :: Text,
+    envRoutingKey :: Text,
+    envChannel :: Channel
+}
 
-data PublishError = PublishError
-                  {
-                    errReplyCode :: ReturnReplyCode,
-                    errExchange :: Maybe Text,
-                    errRoutingKey :: Text
-                  }
-    deriving (Eq, Read, Show)
+data PublishError = PublishError {
+    errReplyCode :: ReturnReplyCode,
+    errExchange :: Maybe Text,
+    errRoutingKey :: Text
+} deriving (Eq, Read, Show)
 
 data ReturnReplyCode = Unroutable Text
                      | NoConsumers Text
@@ -126,7 +122,7 @@     collect x | x <= 0 = return []
     collect x = do
         (ContentBodyPayload payload) <- readChan chan
-        r <- collect (x - (BL.length payload))
+        r <- collect (x - BL.length payload)
         return $ payload : r
 
 ------------ CONNECTION -------------------
@@ -141,32 +137,33 @@ -}
 
 data Connection = Connection {
-                    connHandle :: Conn.Connection,
-                    connChanAllocator :: ChannelAllocator,
-                    connChannels :: MVar (IM.IntMap (Channel, ThreadId)), -- open channels (channelID => (Channel, ChannelThread))
-                    connMaxFrameSize :: Int, --negotiated maximum frame size
-                    connClosed :: MVar (Maybe (CloseType, String)),
-                    connClosedLock :: MVar (), -- used by closeConnection to block until connection-close handshake is complete
-                    connWriteLock :: MVar (), -- to ensure atomic writes to the socket
-                    connClosedHandlers :: MVar [IO ()],
-                    connBlockedHandlers :: MVar [(Text -> IO (), IO ())],
-                    connLastReceived :: MVar Int64, -- the timestamp from a monotonic clock when the last frame was received
-                    connLastSent :: MVar Int64, -- the timestamp from a monotonic clock when the last frame was written
-                    connServerProperties :: FieldTable -- the server properties sent in Connection_start
-                }
+    connHandle :: Conn.Connection,
+    connChanAllocator :: ChannelAllocator,
+    connChannels :: MVar (IM.IntMap (Channel, ThreadId)), -- open channels (channelID => (Channel, ChannelThread))
+    connMaxFrameSize :: Int, --negotiated maximum frame size
+    connClosed :: MVar (Maybe (CloseType, String)),
+    connClosedLock :: MVar (), -- used by closeConnection to block until connection-close handshake is complete
+    connWriteLock :: MVar (), -- to ensure atomic writes to the socket
+    connClosedHandlers :: MVar [IO ()],
+    connBlockedHandlers :: MVar [(Text -> IO (), IO ())],
+    connLastReceived :: MVar Int64, -- the timestamp from a monotonic clock when the last frame was received
+    connLastSent :: MVar Int64, -- the timestamp from a monotonic clock when the last frame was written
+    connServerProperties :: FieldTable -- the server properties sent in Connection_start
+}
 
 -- | Represents the parameters to connect to a broker or a cluster of brokers.
 -- See 'defaultConnectionOpts'.
 data ConnectionOpts = ConnectionOpts {
-                            coServers :: ![(String, PortNumber)], -- ^ A list of host-port pairs. Useful in a clustered setup to connect to the first available host.
-                            coVHost :: !Text, -- ^ The VHost to connect to.
-                            coAuth :: ![SASLMechanism], -- ^ The 'SASLMechanism's to use for authenticating with the broker.
-                            coMaxFrameSize :: !(Maybe Word32), -- ^ The maximum frame size to be used. If not specified, no limit is assumed.
-                            coHeartbeatDelay :: !(Maybe Word16), -- ^ The delay in seconds, after which the client expects a heartbeat frame from the broker. If 'Nothing', the value suggested by the broker is used. Use @Just 0@ to disable the heartbeat mechnism.
-                            coMaxChannel :: !(Maybe Word16), -- ^ The maximum number of channels the client will use.
-                            coTLSSettings :: Maybe TLSSettings, -- ^ Whether or not to connect to servers using TLS. See http://www.rabbitmq.com/ssl.html for details.
-                            coName :: !(Maybe Text) -- ^ optional connection name (will be displayed in the RabbitMQ web interface)
-                        }
+    coServers :: ![(String, PortNumber)], -- ^ A list of host-port pairs. Useful in a clustered setup to connect to the first available host.
+    coVHost :: !Text, -- ^ The VHost to connect to.
+    coAuth :: ![SASLMechanism], -- ^ The 'SASLMechanism's to use for authenticating with the broker.
+    coMaxFrameSize :: !(Maybe Word32), -- ^ The maximum frame size to be used. If not specified, no limit is assumed.
+    coHeartbeatDelay :: !(Maybe Word16), -- ^ The delay in seconds, after which the client expects a heartbeat frame from the broker. If 'Nothing', the value suggested by the broker is used. Use @Just 0@ to disable the heartbeat mechnism.
+    coMaxChannel :: !(Maybe Word16), -- ^ The maximum number of channels the client will use.
+    coTLSSettings :: Maybe TLSSettings, -- ^ Whether or not to connect to servers using TLS. See http://www.rabbitmq.com/ssl.html for details.
+    coName :: !(Maybe Text) -- ^ optional connection name (will be displayed in the RabbitMQ web interface)
+}
+
 -- | Represents the kind of TLS connection to establish.
 data TLSSettings =
     TLSTrusted   -- ^ Require trusted certificates (Recommended).
@@ -175,18 +172,18 @@ 
 connectionTLSSettings :: TLSSettings -> Maybe Conn.TLSSettings
 connectionTLSSettings tlsSettings =
-  Just $ case tlsSettings of
-    TLSTrusted -> Conn.TLSSettingsSimple False False False
-    TLSUntrusted -> Conn.TLSSettingsSimple True False False
-    TLSCustom x -> x
+    Just $ case tlsSettings of
+        TLSTrusted -> Conn.TLSSettingsSimple False False False
+        TLSUntrusted -> Conn.TLSSettingsSimple True False False
+        TLSCustom x -> x
 
 -- | A 'SASLMechanism' is described by its name ('saslName'), its initial response ('saslInitialResponse'), and an optional function ('saslChallengeFunc') that
 -- transforms a security challenge provided by the server into response, which is then sent back to the server for verification.
 data SASLMechanism = SASLMechanism {
-                        saslName :: !Text, -- ^ mechanism name
-                        saslInitialResponse :: !BS.ByteString, -- ^ initial response
-                        saslChallengeFunc :: !(Maybe (BS.ByteString -> IO BS.ByteString)) -- ^ challenge processing function
-                    }
+    saslName :: !Text, -- ^ mechanism name
+    saslInitialResponse :: !BS.ByteString, -- ^ initial response
+    saslChallengeFunc :: !(Maybe (BS.ByteString -> IO BS.ByteString)) -- ^ challenge processing function
+}
 
 -- | reads incoming frames from socket and forwards them to the opened channels
 connectionReceiver :: Connection -> IO ()
@@ -199,10 +196,10 @@         (\(e :: CE.IOException) -> myThreadId >>= killConnection conn Abnormal (CE.toException e))
     connectionReceiver conn
   where
-
     closedByUserEx = ConnectionClosedException Normal "closed by user"
 
-    forwardToChannel 0 (MethodPayload Connection_close_ok) =  myThreadId >>= killConnection conn Normal (CE.toException closedByUserEx)
+    forwardToChannel 0 (MethodPayload Connection_close_ok) =
+        myThreadId >>= killConnection conn Normal (CE.toException closedByUserEx)
     forwardToChannel 0 (MethodPayload (Connection_close _ (ShortString errorMsg) _ _)) = do
         writeFrame (connHandle conn) $ Frame 0 $ MethodPayload Connection_close_ok
         myThreadId >>= killConnection conn Abnormal (CE.toException . ConnectionClosedException Abnormal . T.unpack $ errorMsg)
@@ -215,6 +212,8 @@         withMVar (connChannels conn) $ \cs -> do
             case IM.lookup (fromIntegral chanID) cs of
                 Just c -> writeChan (inQueue $ fst c) payload
+                -- TODO: It's unclear how to handle this, although it probably never
+                --   happens in practice.
                 Nothing -> hPutStrLn stderr $ "ERROR: channel not open " ++ show chanID
 
     handleBlocked (ShortString reason) = do
@@ -233,12 +232,12 @@     handle <- connect [] $ coServers connOpts
     (maxFrameSize, maxChannel, heartbeatTimeout, serverProps) <- CE.handle (\(_ :: CE.IOException) -> CE.throwIO $ ConnectionClosedException Abnormal "Handshake failed. Please check the RabbitMQ logs for more information") $ do
         Conn.connectionPut handle $ BS.append (BC.pack "AMQP")
-                (BS.pack [
-                          1
-                        , 1 --TCP/IP
-                        , 0 --Major Version
-                        , 9 --Minor Version
-                       ])
+            (BS.pack [
+                      1
+                    , 1 --TCP/IP
+                    , 0 --Major Version
+                    , 9 --Minor Version
+                    ])
 
         -- S: connection.start
         Frame 0 (MethodPayload (Connection_start _ _ serverProps (LongString serverMechanisms) _)) <- readFrame handle
@@ -283,33 +282,33 @@ 
     --spawn the connectionReceiver
     connThread <- forkFinally' (connectionReceiver conn) $ \res -> do
-                -- try closing socket
-                CE.catch (Conn.connectionClose handle) (\(_ :: CE.SomeException) -> return ())
+        -- try closing socket
+        CE.catch (Conn.connectionClose handle) (\(_ :: CE.SomeException) -> return ())
 
-                -- mark as closed
-                modifyMVar_ cClosed $ return . Just . fromMaybe (Abnormal, "unknown reason")
+        -- mark as closed
+        modifyMVar_ cClosed $ return . Just . fromMaybe (Abnormal, "unknown reason")
 
-                -- kill all channel-threads, making sure the channel threads will
-                -- be killed taking into account the overall state of the
-                -- connection: if the thread died for an unexpected exception,
-                -- inform the channel threads downstream accordingly. Otherwise
-                -- just use a normal 'killThread' finaliser.
-                let finaliser = ChanThreadKilledException $ case res of
-                        Left ex -> ex
-                        Right _ -> CE.toException CE.ThreadKilled
-                modifyMVar_ cChannels $ \x -> do
-                    mapM_ (flip CE.throwTo finaliser . snd) $ IM.elems x
-                    return IM.empty
+        -- kill all channel-threads, making sure the channel threads will
+        -- be killed taking into account the overall state of the
+        -- connection: if the thread died for an unexpected exception,
+        -- inform the channel threads downstream accordingly. Otherwise
+        -- just use a normal 'killThread' finaliser.
+        let finaliser = ChanThreadKilledException $ case res of
+                Left ex -> ex
+                Right _ -> CE.toException CE.ThreadKilled
+        modifyMVar_ cChannels $ \x -> do
+            mapM_ (flip CE.throwTo finaliser . snd) $ IM.elems x
+            return IM.empty
 
-                -- mark connection as closed, so all pending calls to 'closeConnection' can now return
-                void $ tryPutMVar ccl ()
+        -- mark connection as closed, so all pending calls to 'closeConnection' can now return
+        void $ tryPutMVar ccl ()
 
-                -- notify connection-close-handlers
-                withMVar cClosedHandlers sequence_
+        -- notify connection-close-handlers
+        withMVar cClosedHandlers sequence_
 
     case heartbeatTimeout of
         Nothing      -> return ()
-        Just timeout ->  do
+        Just timeout -> do
             heartbeatThread <- watchHeartbeats conn (fromIntegral timeout) connThread
             addConnectionClosedHandler conn True (killThread heartbeatThread)
 
@@ -317,17 +316,15 @@   where
     connect excs ((host, port) : rest) = do
         ctx <- Conn.initConnectionContext
-        result <- CE.try (Conn.connectTo ctx $ Conn.ConnectionParams
-                              { Conn.connectionHostname  = host
-                              , Conn.connectionPort      = port
-                              , Conn.connectionUseSecure = tlsSettings
-                              , Conn.connectionUseSocks  = Nothing
-                              })
-        either
-            (\(ex :: CE.SomeException) -> do
-                connect (ex:excs) rest)
-            (return)
-            result
+        result <- CE.try $ Conn.connectTo ctx $ Conn.ConnectionParams
+                    { Conn.connectionHostname  = host
+                    , Conn.connectionPort      = port
+                    , Conn.connectionUseSecure = tlsSettings
+                    , Conn.connectionUseSocks  = Nothing
+                    }
+        either (\(ex :: CE.SomeException) -> connect (ex:excs) rest)
+               return
+               result
     connect excs [] = CE.throwIO $ ConnectionClosedException Abnormal $ "Could not connect to any of the provided brokers: " ++ show (zip (coServers connOpts) (reverse excs))
     tlsSettings = maybe Nothing connectionTLSSettings (coTLSSettings connOpts)
     selectSASLMechanism handle serverMechanisms =
@@ -338,17 +335,22 @@         in abortIfNothing maybeSasl handle
             ("None of the provided SASL mechanisms "++show clientSaslList++" is supported by the server "++show serverSaslList++".")
 
-    start_ok sasl = (Frame 0 (MethodPayload (Connection_start_ok clientProperties
-                                             (ShortString $ saslName sasl)
-                                             (LongString $ saslInitialResponse sasl)
-                                             (ShortString "en_US")) ))
-                    where clientProperties = FieldTable $ M.fromList $ [ ("platform", FVString "Haskell")
-                                                                       , ("version" , FVString . E.encodeUtf8 . T.pack $ showVersion version)
-                                                                       , ("capabilities", FVFieldTable clientCapabilities)
-                                                                       ] ++ maybe [] (\x -> [("connection_name", FVString $ E.encodeUtf8 x)]) (coName connOpts)
+    start_ok sasl = Frame 0 $ MethodPayload $ Connection_start_ok
+                        clientProperties
+                        (ShortString $ saslName sasl)
+                        (LongString $ saslInitialResponse sasl)
+                        (ShortString "en_US")
+      where
+        clientProperties = FieldTable $ M.fromList $ [
+            ("platform", FVString "Haskell"),
+            ("version" , FVString . E.encodeUtf8 . T.pack $ showVersion version),
+            ("capabilities", FVFieldTable clientCapabilities)
+          ] ++ maybe [] (\x -> [("connection_name", FVString $ E.encodeUtf8 x)]) (coName connOpts)
 
-                          clientCapabilities = FieldTable $ M.fromList $ [ ("consumer_cancel_notify", FVBool True),
-                                                                           ("connection.blocked", FVBool True) ]
+        clientCapabilities = FieldTable $ M.fromList [
+            ("consumer_cancel_notify", FVBool True),
+            ("connection.blocked", FVBool True)
+          ]
 
     handleSecureUntilTune handle sasl = do
         tuneOrSecure <- readFrame handle
@@ -360,13 +362,13 @@                 writeFrame handle (Frame 0 (MethodPayload (Connection_secure_ok (LongString challengeResponse))))
                 handleSecureUntilTune handle sasl
 
-            tune@(Frame 0 (MethodPayload (Connection_tune _ _ _))) -> return tune
+            tune@(Frame 0 (MethodPayload Connection_tune{})) -> return tune
             x -> error $ "handleSecureUntilTune fail. received message: "++show x
 
-    open = (Frame 0 (MethodPayload (Connection_open
+    open = Frame 0 $ MethodPayload $ Connection_open
         (ShortString $ coVHost connOpts)
         (ShortString $ T.pack "") -- capabilities; deprecated in 0-9-1
-        True))) -- insist; deprecated in 0-9-1
+        True -- insist; deprecated in 0-9-1
 
     abortHandshake handle msg = do
         Conn.connectionClose handle
@@ -383,21 +385,20 @@     checkReceiveTimeout
   where
     rate = timeout * 1000 * 250 -- timeout / 4 in µs
-    receiveTimeout = (fromIntegral rate) * 4 * 2 -- 2*timeout in µs
-    sendTimeout = (fromIntegral rate) * 2 -- timeout/2 in µs
+    receiveTimeout = fromIntegral rate * 4 * 2 -- 2*timeout in µs
+    sendTimeout = fromIntegral rate * 2 -- timeout/2 in µs
 
     skippedBeatEx = ConnectionClosedException Abnormal "killed connection after missing 2 consecutive heartbeats"
 
-    checkReceiveTimeout = doCheck (connLastReceived conn) receiveTimeout
-        (killConnection conn Abnormal (CE.toException skippedBeatEx) connThread)
+    checkReceiveTimeout = doCheck (connLastReceived conn) receiveTimeout $
+        killConnection conn Abnormal (CE.toException skippedBeatEx) connThread
 
-    checkSendTimeout = doCheck (connLastSent conn) sendTimeout
-        (writeFrame (connHandle conn) (Frame 0 HeartbeatPayload))
+    checkSendTimeout = doCheck (connLastSent conn) sendTimeout $
+        writeFrame (connHandle conn) (Frame 0 HeartbeatPayload)
 
     doCheck var timeout_µs action = withMVar var $ \lastFrameTime -> do
         time <- getTimestamp
-        when (time >= lastFrameTime + timeout_µs) $ do
-            action
+        when (time >= lastFrameTime + timeout_µs) action
 
 updateLastSent :: Connection -> IO ()
 updateLastSent conn = modifyMVar_ (connLastSent conn) (const getTimestamp)
@@ -417,14 +418,13 @@ closeConnection :: Connection -> IO ()
 closeConnection c = do
     CE.catch (
-        withMVar (connWriteLock c) $ \_ -> writeFrame (connHandle c) $ (Frame 0 (MethodPayload (Connection_close
+        withMVar (connWriteLock c) $ \_ -> writeFrame (connHandle c) $ Frame 0 $ MethodPayload $ Connection_close
             --TODO: set these values
             0 -- reply_code
             (ShortString "") -- reply_text
             0 -- class_id
             0 -- method_id
-            )))
-            )
+        )
         (\ (_ :: CE.IOException) ->
             --do nothing if connection is already closed
             return ()
@@ -441,13 +441,12 @@ -- | @addConnectionClosedHandler conn ifClosed handler@ adds a @handler@ that will be called after the connection is closed (either by calling @closeConnection@ or by an exception). If the @ifClosed@ parameter is True and the connection is already closed, the handler will be called immediately. If @ifClosed == False@ and the connection is already closed, the handler will never be called
 addConnectionClosedHandler :: Connection -> Bool -> IO () -> IO ()
 addConnectionClosedHandler conn ifClosed handler = do
-    withMVar (connClosed conn) $ \cc ->
-        case cc of
-            -- connection is already closed, so call the handler directly
-            Just _ | ifClosed == True -> handler
+    withMVar (connClosed conn) $ \case
+        -- connection is already closed, so call the handler directly
+        Just _ | ifClosed -> handler
 
-            -- otherwise add it to the list
-            _ -> modifyMVar_ (connClosedHandlers conn) $ \old -> return $ handler:old
+        -- otherwise add it to the list
+        _ -> modifyMVar_ (connClosedHandlers conn) $ \old -> return $ handler:old
 
 -- | @addConnectionBlockedHandler conn blockedHandler unblockedHandler@ adds handlers that will be called
 -- when a connection gets blocked/unlocked due to server resource constraints.
@@ -489,7 +488,7 @@           | y == x = return bs
           | otherwise = do
             next <- Conn.connectionGet conn (x - y)
-            loop (BS.append bs next) (y + (BS.length next))
+            loop (BS.append bs next) (y + BS.length next)
 
 writeFrame :: Conn.Connection -> Frame -> IO ()
 writeFrame handle f = do
@@ -500,25 +499,25 @@ {- | A connection to an AMQP server is made up of separate channels. It is recommended to use a separate channel for each thread in your application that talks to the AMQP server (but you don't have to as channels are thread-safe)
 -}
 data Channel = Channel {
-                    connection :: Connection,
-                    inQueue :: Chan FramePayload, --incoming frames (from Connection)
-                    outstandingResponses :: MVar (Seq.Seq (MVar Assembly)), -- for every request an MVar is stored here waiting for the response
-                    channelID :: Word16,
-                    lastConsumerTag :: MVar Int,
+    connection :: Connection,
+    inQueue :: Chan FramePayload, -- incoming frames (from Connection)
+    outstandingResponses :: MVar (Seq.Seq (MVar Assembly)), -- for every request an MVar is stored here waiting for the response
+    channelID :: Word16,
+    lastConsumerTag :: MVar Int,
 
-                    nextPublishSeqNum :: MVar Int,
-                    unconfirmedSet :: TVar IntSet.IntSet,
-                    ackedSet :: TVar IntSet.IntSet,  --delivery tags
-                    nackedSet :: TVar IntSet.IntSet, --accumulate here.
+    nextPublishSeqNum :: MVar Int,
+    unconfirmedSet :: TVar IntSet.IntSet,
+    ackedSet :: TVar IntSet.IntSet,  -- delivery tags
+    nackedSet :: TVar IntSet.IntSet, -- accumulate here.
 
-                    chanActive :: Lock, -- used for flow-control. if lock is closed, no content methods will be sent
-                    chanClosed :: MVar (Maybe (CloseType, String)),
-                    consumers :: MVar (M.Map Text ((Message, Envelope) -> IO (),    -- who is consumer of a queue? (consumerTag => callback)
-                                                   (ConsumerTag -> IO ()))),        -- cancellation notification callback
-                    returnListeners :: MVar ([(Message, PublishError) -> IO ()]),
-                    confirmListeners :: MVar ([(Word64, Bool, AckType) -> IO ()]),
-                    chanExceptionHandlers :: MVar [CE.SomeException -> IO ()]
-                }
+    chanActive :: Lock, -- used for flow-control. if lock is closed, no content methods will be sent
+    chanClosed :: MVar (Maybe (CloseType, String)),
+    consumers :: MVar (M.Map Text ((Message, Envelope) -> IO (), -- who is consumer of a queue? (consumerTag => callback)
+                                   ConsumerTag -> IO ())),    -- cancellation notification callback
+    returnListeners :: MVar [(Message, PublishError) -> IO ()],
+    confirmListeners :: MVar [(Word64, Bool, AckType) -> IO ()],
+    chanExceptionHandlers :: MVar [CE.SomeException -> IO ()]
+}
 
 -- | Thrown in the channel thread when the connection gets closed.
 -- When handling exceptions in a subscription callback, make sure to re-throw this so the channel thread can be stopped.
@@ -527,6 +526,8 @@ 
 instance CE.Exception ChanThreadKilledException
 
+-- | If the given exception is an instance of ChanThreadKilledException, this method returns
+--    the inner exception. Otherwise the exception is returned unchanged.
 unwrapChanThreadKilledException :: CE.SomeException -> CE.SomeException
 unwrapChanThreadKilledException e = maybe e cause $ CE.fromException e
 
@@ -567,12 +568,12 @@     channelReceiver chan
   where
     isResponse :: Assembly -> Bool
-    isResponse (ContentMethod (Basic_deliver _ _ _ _ _) _ _) = False
-    isResponse (ContentMethod (Basic_return _ _ _ _) _ _) = False
+    isResponse (ContentMethod Basic_deliver{} _ _) = False
+    isResponse (ContentMethod Basic_return{} _ _) = False
     isResponse (SimpleMethod (Channel_flow _)) = False
-    isResponse (SimpleMethod (Channel_close _ _ _ _)) = False
+    isResponse (SimpleMethod Channel_close{}) = False
     isResponse (SimpleMethod (Basic_ack _ _)) = False
-    isResponse (SimpleMethod (Basic_nack _ _ _)) = False
+    isResponse (SimpleMethod Basic_nack{}) = False
     isResponse (SimpleMethod (Basic_cancel _ _)) = False
     isResponse _ = True
 
@@ -587,25 +588,22 @@                     let env = Envelope {envDeliveryTag = deliveryTag, envRedelivered = redelivered,
                                     envExchangeName = exchange, envRoutingKey = routingKey, envChannel = chan}
 
-                    CE.catches (subscriber (msg, env))
-                        [
-                          CE.Handler (\(e::ChanThreadKilledException) -> CE.throwIO $ cause e),
-                          CE.Handler (\(e::CE.SomeException) -> hPutStrLn stderr $ "AMQP callback threw exception: " ++ show e)
-                        ]
+                    CE.catches (subscriber (msg, env)) [
+                        CE.Handler (\(e::ChanThreadKilledException) -> CE.throwIO $ cause e),
+                        CE.Handler (\(e::CE.SomeException) -> hPutStrLn stderr $ "AMQP callback threw exception: " ++ show e)
+                      ]
                 Nothing ->
                     -- got a message, but have no registered subscriber; so drop it
                     return ()
             )
     handleAsync (SimpleMethod (Channel_close _ (ShortString errorMsg) _ _)) = do
-      CE.catch (
-        writeAssembly' chan (SimpleMethod (Channel_close_ok))
-        )
-        (\ (_ :: CE.IOException) ->
-              --do nothing if connection is already closed
+        CE.catch (writeAssembly' chan (SimpleMethod Channel_close_ok))
+            (\ (_ :: CE.IOException) ->
+              -- do nothing if connection is already closed
               return ()
-        )
-      closeChannel' chan Abnormal errorMsg
-      myThreadId >>= flip CE.throwTo (ChannelClosedException Abnormal . T.unpack $ errorMsg)
+            )
+        closeChannel' chan Abnormal errorMsg
+        myThreadId >>= flip CE.throwTo (ChannelClosedException Abnormal . T.unpack $ errorMsg)
     handleAsync (SimpleMethod (Channel_flow active)) = do
         if active
             then openLock $ chanActive chan
@@ -613,12 +611,12 @@         -- in theory we should respond with flow_ok but rabbitMQ 1.7 ignores that, so it doesn't matter
         return ()
     --Basic.return
-    handleAsync (ContentMethod basicReturn@(Basic_return _ _ _ _) props body) = do
+    handleAsync (ContentMethod basicReturn@Basic_return{} props body) = do
         let msg      = msgFromContentHeaderProperties props body
             pubError = basicReturnToPublishError basicReturn
         withMVar (returnListeners chan) $ \listeners ->
             forM_ listeners $ \l -> CE.catch (l (msg, pubError)) $ \(ex :: CE.SomeException) ->
-                hPutStrLn stderr $ "return listener on channel ["++(show $ channelID chan)++"] handling error ["++show pubError++"] threw exception: "++show ex
+                hPutStrLn stderr $ "return listener on channel ["++show (channelID chan)++"] handling error ["++show pubError++"] threw exception: "++show ex
     handleAsync (SimpleMethod (Basic_ack deliveryTag multiple)) = handleConfirm deliveryTag multiple BasicAck
     handleAsync (SimpleMethod (Basic_nack deliveryTag multiple _)) = handleConfirm deliveryTag multiple BasicNack
     handleAsync (SimpleMethod (Basic_cancel consumerTag _)) = handleCancel consumerTag
@@ -627,30 +625,30 @@     handleConfirm deliveryTag multiple k = do
         withMVar (confirmListeners chan) $ \listeners ->
             forM_ listeners $ \l -> CE.catch (l (deliveryTag, multiple, k)) $ \(ex :: CE.SomeException) ->
-                hPutStrLn stderr $ "confirm listener on channel ["++(show $ channelID chan)++"] handling method "++(show k)++" threw exception: "++ show ex
+                hPutStrLn stderr $ "confirm listener on channel ["++show (channelID chan)++"] handling method "++show k++" threw exception: "++show ex
 
         let seqNum = fromIntegral deliveryTag
         let targetSet = case k of
-              BasicAck  -> (ackedSet chan)
-              BasicNack -> (nackedSet chan)
+              BasicAck  -> ackedSet chan
+              BasicNack -> nackedSet chan
         atomically $ do
-          unconfSet <- readTVar (unconfirmedSet chan)
-          let (merge, pending) = if multiple
-                                     then (IntSet.union confs, pending')
-                                     else (IntSet.insert seqNum, IntSet.delete seqNum unconfSet)
-                                  where
-                                    confs = fst parts
-                                    pending' = snd parts
-                                    parts = IntSet.partition (\n -> n <= seqNum) unconfSet
-          modifyTVar' targetSet (\ts -> merge ts)
-          writeTVar (unconfirmedSet chan) pending
+            unconfSet <- readTVar (unconfirmedSet chan)
+            let (merge, pending) = if multiple
+                                       then (IntSet.union confs, pending')
+                                       else (IntSet.insert seqNum, IntSet.delete seqNum unconfSet)
+                                    where
+                                      confs = fst parts
+                                      pending' = snd parts
+                                      parts = IntSet.partition (\n -> n <= seqNum) unconfSet
+            modifyTVar' targetSet (\ts -> merge ts)
+            writeTVar (unconfirmedSet chan) pending
 
     handleCancel (ShortString consumerTag) =
         withMVar (consumers chan) (\s -> do
             case M.lookup consumerTag s of
                 Just (_, cancelCB) ->
                     CE.catch (cancelCB consumerTag) $ \(ex :: CE.SomeException) ->
-                        hPutStrLn stderr $ "consumer cancellation listener "++(show consumerTag)++" on channel ["++(show $ channelID chan)++"] threw exception: "++ show ex
+                        hPutStrLn stderr $ "consumer cancellation listener "++show consumerTag++" on channel ["++show (channelID chan)++"] threw exception: "++ show ex
                 Nothing ->
                     -- got a cancellation notification, but have no registered subscriber; so drop it
                     return ()
@@ -661,21 +659,38 @@                 312 -> Unroutable errText
                 313 -> NoConsumers errText
                 404 -> NotFound errText
-                num -> error $ "unexpected return error code: " ++ (show num)
+                num -> error $ "unexpected return error code: " ++show num
             pubError = PublishError replyError (Just exchange) routingKey
         in pubError
     basicReturnToPublishError x = error $ "basicReturnToPublishError fail: "++show x
 
--- | registers a callback function that is called whenever a message is returned from the broker ('basic.return').
+-- | Registers a callback function that is called whenever a message is returned from the broker ('basic.return').
 addReturnListener :: Channel -> ((Message, PublishError) -> IO ()) -> IO ()
 addReturnListener chan listener = do
     modifyMVar_ (returnListeners chan) $ \listeners -> return $ listener:listeners
 
--- | registers a callback function that is called whenever a channel is closed by an exception.
+-- | Registers a callback function that is called whenever a channel is closed by an exception.
+--
+-- This method will always be called when a channel is closed, whether through normal means
+--  ('closeChannel', 'closeConnection') or by some AMQP exception.
+--
+-- You can use 'isNormalChannelClose' to figure out if the exception was normal or due to an
+--  AMQP exception.
 addChannelExceptionHandler :: Channel -> (CE.SomeException -> IO ()) -> IO ()
 addChannelExceptionHandler chan handler = do
     modifyMVar_ (chanExceptionHandlers chan) $ \handlers -> return $ handler:handlers
 
+-- | This can be used with the exception passed to 'addChannelExceptionHandler'.
+--
+-- Returns True if the argument is a 'ConnectionClosedException' or 'ChannelClosedException' that happened
+--  normally (i.e. by the user calling 'closeChannel' or 'closeConnection') and not due to some
+--  AMQP exception.
+isNormalChannelClose :: CE.SomeException -> Bool
+isNormalChannelClose e = case CE.fromException e :: Maybe AMQPException of
+    Just (ChannelClosedException Normal _) -> True
+    Just (ConnectionClosedException Normal _) -> True
+    _ -> False
+
 -- closes the channel internally; but doesn't tell the server
 closeChannel' :: Channel -> CloseType -> Text -> IO ()
 closeChannel' c closeType reason = do
@@ -684,7 +699,7 @@             then do
                 modifyMVar_ (connChannels $ connection c) $ \old -> do
                     ret <- freeChannel (connChanAllocator $ connection c) $ fromIntegral $ channelID c
-                    when (not ret) $ hPutStrLn stderr "closeChannel error: channel already freed"
+                    unless ret $ hPutStrLn stderr "closeChannel error: channel already freed"
                     return $ IM.delete (fromIntegral $ channelID c) old
 
                 void $ killLock $ chanActive c
@@ -696,11 +711,20 @@     killOutstandingResponses outResps = do
         modifyMVar_ outResps $ \val -> do
             F.mapM_ (\x -> tryPutMVar x $ error "channel closed") val
+            -- Intentionally put 'undefined' into the MVar, so that reading from it will throw.
+            -- This MVar will be read from the 'request' method, where we appropriately catch ErrorCall exceptions.
             return undefined
 
 -- | opens a new channel on the connection
 --
 -- By default, if a channel is closed by an AMQP exception, this exception will be printed to stderr. You can prevent this behaviour by setting a custom exception handler (using 'addChannelExceptionHandler').
+--
+-- Example of adding an exception-handler:
+--
+-- > chan <- openChannel conn
+-- > addChannelExceptionHandler chan $ \e -> do
+-- >     unless (isNormalChannelClose e) $ do
+-- >         putStrLn $ "channel exception: "++show e
 openChannel :: Connection -> IO Channel
 openChannel c = do
     newInQueue <- newChan
@@ -717,33 +741,36 @@     cnfListeners <- newMVar []
     handlers <- newMVar []
 
-    --add new channel to connection's channel map
+    -- add new channel to connection's channel map
     newChannel <- modifyMVar (connChannels c) $ \mp -> do
         newChannelID <- allocateChannel (connChanAllocator c)
         let newChannel = Channel c newInQueue outRes (fromIntegral newChannelID) lastConsTag nxtSeq unconfSet aSet nSet ca closed conss retListeners cnfListeners handlers
         thrID <- forkFinally' (channelReceiver newChannel) $ \res -> do
-                   closeChannel' newChannel Normal "closed"
-                   case res of
-                     Right _ -> return ()
-                     Left ex -> do
-                        let unwrappedExc = unwrapChanThreadKilledException ex
-                        handlers' <- readMVar handlers
+            closeChannel' newChannel Normal "closed"
+            case res of
+                Right _ -> return ()
+                Left ex -> do
+                   let unwrappedExc = unwrapChanThreadKilledException ex
+                   handlers' <- readMVar handlers
 
-                        case (null handlers', fromAbnormalChannelClose unwrappedExc) of
-                            (True, Just reason) -> hPutStrLn stderr $ "unhandled AMQP channel exception (chanId="++show newChannelID++"): "++reason
-                            _ -> mapM_ ($ unwrappedExc) handlers'
+                   case (null handlers', fromAbnormalChannelClose unwrappedExc) of
+                       (True, Just reason) -> hPutStrLn stderr $ "unhandled AMQP channel exception (chanId="++show newChannelID++"): "++reason
+                       _ -> mapM_ ($ unwrappedExc) handlers'
         when (IM.member newChannelID mp) $ CE.throwIO $ userError "openChannel fail: channel already open"
         return (IM.insert newChannelID (newChannel, thrID) mp, newChannel)
 
-    SimpleMethod (Channel_open_ok _) <- request newChannel (SimpleMethod (Channel_open (ShortString "")))
+    SimpleMethod (Channel_open_ok _) <- request newChannel $ SimpleMethod $ Channel_open (ShortString "")
     return newChannel
 
   where
     fromAbnormalChannelClose :: CE.SomeException -> Maybe String
     fromAbnormalChannelClose exc =
         case CE.fromException exc :: Maybe AMQPException of
+            Just (ConnectionClosedException _ _) -> Nothing
+            Just (ChannelClosedException Normal _) -> Nothing
             Just (ChannelClosedException Abnormal reason) -> Just reason
-            _ -> Nothing
+            Just (AllChannelsAllocatedException _) -> Just "all channels allocated"
+            Nothing -> Just $ show exc
 
 -- | closes a channel. It is typically not necessary to manually call this as closing a connection will implicitly close all channels.
 closeChannel :: Channel -> IO ()
@@ -756,45 +783,44 @@ 
 -- | writes multiple frames to the channel atomically
 writeFrames :: Channel -> [FramePayload] -> IO ()
-writeFrames chan payloads =
-    let conn = connection chan in
-        withMVar (connChannels conn) $ \chans ->
-            if IM.member (fromIntegral $ channelID chan) chans
-                then
-                    CE.catch
-                        -- ensure at most one thread is writing to the socket at any time
-                        (do
-                            withMVar (connWriteLock conn) $ \_ ->
-                                mapM_ (\payload -> writeFrame (connHandle conn) (Frame (channelID chan) payload)) payloads
-                            updateLastSent conn)
-                        ( \(_ :: CE.IOException) -> do
-                            CE.throwIO $ userError "connection not open"
-                        )
-                else do
-                    CE.throwIO $ userError "channel not open"
+writeFrames chan payloads = do
+    let conn = connection chan
+    withMVar (connChannels conn) $ \chans ->
+        if IM.member (fromIntegral $ channelID chan) chans
+            then CE.catch
+                -- ensure at most one thread is writing to the socket at any time
+                (do
+                    withMVar (connWriteLock conn) $ \_ ->
+                        mapM_ (\payload -> writeFrame (connHandle conn) (Frame (channelID chan) payload)) payloads
+                    updateLastSent conn)
+                (\(_ :: CE.IOException) -> do
+                    CE.throwIO $ userError "connection not open"
+                )
+            else do
+                CE.throwIO $ userError "channel not open"
 
 writeAssembly' :: Channel -> Assembly -> IO ()
 writeAssembly' chan (ContentMethod m properties msg) = do
     -- wait iff the AMQP server instructed us to withhold sending content data (flow control)
     waitLock $ chanActive chan
-    let !toWrite =
-           [(MethodPayload m),
-            (ContentHeaderPayload
+    let !toWrite = [
+            MethodPayload m,
+            ContentHeaderPayload
                 (getClassIDOf properties) --classID
                 0 --weight is deprecated in AMQP 0-9
                 (fromIntegral $ BL.length msg) --bodySize
-                properties)] ++
+                properties] ++
             (if BL.length msg > 0
              then do
                 -- split into frames of maxFrameSize
                 -- (need to substract 8 bytes to account for frame header and end-marker)
                 map ContentBodyPayload
-                    (splitLen msg $ (fromIntegral $ connMaxFrameSize $ connection chan) - 8)
+                    (splitLen msg $ fromIntegral (connMaxFrameSize $ connection chan) - 8)
              else []
             )
     writeFrames chan toWrite
   where
-    splitLen str len | BL.length str > len = (BL.take len str):(splitLen (BL.drop len str) len)
+    splitLen str len | BL.length str > len = BL.take len str : splitLen (BL.drop len str) len
     splitLen str _ = [str]
 writeAssembly' chan (SimpleMethod m) = writeFrames chan [MethodPayload m]
 
@@ -845,8 +871,7 @@ 
 waitForAllConfirms :: Channel -> STM (IntSet.IntSet, IntSet.IntSet)
 waitForAllConfirms chan = do
-  pending <- readTVar $ (unconfirmedSet chan)
-  check (IntSet.null pending)
-  return =<< (,)
-    <$> swapTVar (ackedSet chan) IntSet.empty
-    <*> swapTVar (nackedSet chan) IntSet.empty
+    pending <- readTVar $ unconfirmedSet chan
+    check (IntSet.null pending)
+    (,) <$> swapTVar (ackedSet chan) IntSet.empty
+        <*> swapTVar (nackedSet chan) IntSet.empty

Network/AMQP/Lifted.hs view

@@ -12,10 +12,7 @@ import Data.Text (Text)
 import Control.Monad
 
--- | @consumeMsgs chan queueName ack callback@ subscribes to the given queue and returns a consumerTag. For any incoming message, the callback will be run. If @ack == 'Ack'@ you will have to acknowledge all incoming messages (see 'ackMsg' and 'ackEnv')
---
--- NOTE: The callback will be run on the same thread as the channel thread (every channel spawns its own thread to listen for incoming data) so DO NOT perform any request on @chan@ inside the callback (however, you CAN perform requests on other open channels inside the callback, though I wouldn't recommend it).
--- Functions that can safely be called on @chan@ are 'ackMsg', 'ackEnv', 'rejectMsg', 'recoverMsgs'. If you want to perform anything more complex, it's a good idea to wrap it inside 'forkIO'.
+-- | Lifted version of 'Network.AMQP.consumeMsgs' (please look there for documentation).
 --
 -- In addition, while the callback function @(('Message', 'Envelope') -> m ())@
 -- has access to the captured state, all its side-effects in m are discarded.

Network/AMQP/Protocol.hs view

@@ -12,9 +12,9 @@ 
 --True if a content (contentheader and possibly contentbody) will follow the method
 hasContent :: FramePayload -> Bool
-hasContent (MethodPayload (Basic_get_ok _ _ _ _ _)) = True
-hasContent (MethodPayload (Basic_deliver _ _ _ _ _)) = True
-hasContent (MethodPayload (Basic_return _ _ _ _)) = True
+hasContent (MethodPayload Basic_get_ok{}) = True
+hasContent (MethodPayload Basic_deliver{}) = True
+hasContent (MethodPayload Basic_return{}) = True
 hasContent _ = False
 
 data Frame = Frame ChannelID FramePayload --channel, payload
@@ -42,20 +42,20 @@ peekFrameSize = runGet f
   where
     f = do
-      void $ getWord8 -- 1 byte
-      void $ (get :: Get ChannelID) -- 2 bytes
-      get :: Get PayloadSize -- 4 bytes
+        void getWord8 -- 1 byte
+        void (get :: Get ChannelID) -- 2 bytes
+        get :: Get PayloadSize -- 4 bytes
 
 data FramePayload =
-               MethodPayload MethodPayload
-             | ContentHeaderPayload ShortInt ShortInt LongLongInt ContentHeaderProperties --classID, weight, bodySize, propertyFields
-             | ContentBodyPayload BL.ByteString
-             | HeartbeatPayload
+      MethodPayload MethodPayload
+    | ContentHeaderPayload ShortInt ShortInt LongLongInt ContentHeaderProperties --classID, weight, bodySize, propertyFields
+    | ContentBodyPayload BL.ByteString
+    | HeartbeatPayload
     deriving Show
 
 frameType :: FramePayload -> Word8
 frameType (MethodPayload _) = 1
-frameType (ContentHeaderPayload _ _ _ _) = 2
+frameType ContentHeaderPayload{} = 2
 frameType (ContentBodyPayload _) = 3
 frameType HeartbeatPayload = 8
 
@@ -76,6 +76,7 @@     -- ignoring the actual payload, but still need to read the bytes from the network buffer
     _ <- getLazyByteString $ fromIntegral payloadSize
     return HeartbeatPayload
+-- this should never happen:
 getPayload n _ = error ("Unknown frame payload: " ++ show n)
 
 putPayload :: FramePayload -> Put
@@ -86,4 +87,4 @@     put bodySize
     putContentHeaderProperties p
 putPayload (ContentBodyPayload payload) = putLazyByteString payload
-putPayload HeartbeatPayload = putLazyByteString BL.empty+putPayload HeartbeatPayload = putLazyByteString BL.empty

Network/AMQP/Types.hs view

@@ -45,8 +45,8 @@     deriving (Typeable, Show, Ord, Eq)
 
 data AMQPException =
-    -- | the 'String' contains the reason why the channel was closed
-    ChannelClosedException CloseType String
+      -- | the 'String' contains the reason why the channel was closed
+      ChannelClosedException CloseType String
     | ConnectionClosedException CloseType String -- ^ String may contain a reason
     | AllChannelsAllocatedException Int -- ^ the 'Int' contains the channel-max property of the connection (i.e. the highest permitted channel id)
   deriving (Typeable, Show, Ord, Eq)
@@ -86,9 +86,9 @@     deriving (Eq, Ord, Read, Show)
 instance Binary ShortString where
     get = do
-      len <- getWord8
-      dat <- getByteString (fromIntegral len)
-      return $ ShortString $ T.decodeUtf8 dat
+        len <- getWord8
+        dat <- getByteString (fromIntegral len)
+        return $ ShortString $ T.decodeUtf8 dat
 
     put (ShortString x) = do
         let s = T.encodeUtf8 x
@@ -102,9 +102,9 @@     deriving (Eq, Ord, Read, Show)
 instance Binary LongString where
     get = do
-      len <- getWord32be
-      dat <- getByteString (fromIntegral len)
-      return $ LongString dat
+        len <- getWord32be
+        dat <- getByteString (fromIntegral len)
+        return $ LongString dat
 
     put (LongString x) = do
         putWord32be $ fromIntegral (BS.length x)
@@ -125,7 +125,7 @@                 fvp <- getLazyByteString (fromIntegral len)
                 let !fields = readMany fvp
                 return $ FieldTable $ M.fromList $ map (\(ShortString a, b) -> (a,b)) fields
-            else return $ FieldTable $ M.empty
+            else return $ FieldTable M.empty
 
     put (FieldTable fvp) = do
         let bytes = runPut (putMany $ map (\(a,b) -> (ShortString a, b)) $ M.toList fvp) :: BL.ByteString
@@ -179,6 +179,7 @@             'x' -> do
                 len <- get :: Get Word32
                 FVByteArray <$> getByteString (fromIntegral len)
+            -- this should never happen:
             c   -> error ("Unknown field type: " ++ show c)
 
     put (FVBool x) = put 't' >> put x
@@ -192,7 +193,7 @@     put (FVString x) = put 'S' >> put (LongString x)
     put (FVFieldArray x) = do
         put 'A'
-        if length x == 0
+        if null x
             then put (0 :: Int32)
             else do
                 let bytes = runPut (putMany x) :: BL.ByteString
@@ -200,7 +201,7 @@                 putLazyByteString bytes
     put (FVTimestamp s)    = put 'T' >> put s
     put (FVFieldTable s)   = put 'F' >> put s
-    put (FVVoid) = put 'V'
+    put FVVoid = put 'V'
     put (FVByteArray x) = do
         put 'x'
         let len = fromIntegral (BS.length x) :: Word32

amqp.cabal view

@@ -1,5 +1,5 @@ Name:                amqp
-Version:             0.20.0.1
+Version:             0.21.0
 Synopsis:            Client library for AMQP servers (currently only RabbitMQ)
 Description:         Client library for AMQP servers (currently only RabbitMQ)
 License:             BSD3

changelog.md view

@@ -1,3 +1,8 @@+### Version 0.21.0
+
+* added method `isNormalChannelClose`
+* Channels that have no explicit exception handlers (added using `addChannelExceptionHandler`) will now print all exceptions to `stderr`, even if those are not of type `ChannelClosedException`. This is an uncommon situation, so it should not have an observable effect for most users.
+
 ### Version 0.20.0
 
 * `fromURI` now activates TLS if the URI starts with `ampqs://`. Previously it only changed the port, without activating TLS.