diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,5 +1,19 @@ # Changelog for net-mqtt +## 0.5.0.1 + +Now with no known issues. + +0.5.0.0 was released without consulting the github issues page. There +were two open bugs -- one had already been fixed in the development of +0.5, but another was still present. + +0.5.0.0 named the default subscription options `defaultSubOptions`, +but that's inconsistent with other defaults, so it was renamed to +`subOptions`. This is technically an API incompatibility being +introduced and I wouldn't normally do that, but the API's been out for +a few hours, so I'm preeptively asking for forgiveness. + ## 0.5.0.0 Major release for MQTT version 5. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,11 +19,11 @@ main :: IO main = do mc <- runClient mqttConfig{_msgCB=Just msgReceived} - print =<< subscribe mc [("tmp/topic1", QoS0), ("tmp/topic2", QoS0)] + print =<< subscribe mc [("tmp/topic1", subOptions), ("tmp/topic2", subOptions)] print =<< waitForClient mc -- wait for the the client to disconnect where - msgReceived _ t m = print (t,m) + msgReceived _ t m p = print (t,m,p) ``` [mqtt]: http://mqtt.org/ diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -21,7 +21,7 @@ PropRequestProblemInformation 1]} putStrLn "connected!" print =<< svrProps mc - print =<< subscribe mc [("oro/#", defaultSubOptions), ("tmp/#", defaultSubOptions{_subQoS=QoS2})] + print =<< subscribe mc [("oro/#", subOptions), ("tmp/#", subOptions{_subQoS=QoS2})] let pprops = [PropUserProperty "hello" "mqttv5"] p <- async $ forever $ pubAliased mc "tmp/hi/from/haskell" "hi from haskell" False QoS1 pprops >> threadDelay 10000000 diff --git a/net-mqtt.cabal b/net-mqtt.cabal --- a/net-mqtt.cabal +++ b/net-mqtt.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: d7aba3d326ea418336a888f75d196bf0c3bd7c6d1ef718accc71709d2eeb8c3c +-- hash: 0536d82db90a39cbd6059bf3945d34aa7b1be16e28039c56aab02768d106418d name: net-mqtt -version: 0.5.0.0 +version: 0.5.0.1 synopsis: An MQTT Protocol Implementation. description: Please see the README on GitHub at category: Network @@ -42,14 +42,14 @@ , attoparsec >=0.13.2 && <0.14 , attoparsec-binary >=0.2 && <1.0 , base >=4.7 && <5 - , binary >=0.8.6 && <0.9 + , binary >=0.8.5 && <0.9 , bytestring >=0.10.8 && <0.11 , conduit >=1.3.1 && <1.4 , conduit-extra >=1.3.0 && <1.4 - , containers >=0.6.0 && <0.7 + , containers >=0.5.0 && <0.7 , network-conduit-tls >=1.3.2 && <1.4 , network-uri >=2.6.1 && <2.7 - , stm >=2.5.0 && <2.6 + , stm >=2.4.0 && <2.6 , text >=1.2.3 && <1.3 default-language: Haskell2010 @@ -65,15 +65,15 @@ , attoparsec >=0.13.2 && <0.14 , attoparsec-binary >=0.2 && <1.0 , base >=4.7 && <5 - , binary >=0.8.6 && <0.9 + , binary >=0.8.5 && <0.9 , bytestring >=0.10.8 && <0.11 , conduit >=1.3.1 && <1.4 , conduit-extra >=1.3.0 && <1.4 - , containers >=0.6.0 && <0.7 + , containers >=0.5.0 && <0.7 , net-mqtt , network-conduit-tls >=1.3.2 && <1.4 , network-uri >=2.6.1 && <2.7 - , stm >=2.5.0 && <2.6 + , stm >=2.4.0 && <2.6 , text >=1.2.3 && <1.3 default-language: Haskell2010 @@ -92,15 +92,15 @@ , attoparsec >=0.13.2 && <0.14 , attoparsec-binary >=0.2 && <1.0 , base >=4.7 && <5 - , binary >=0.8.6 && <0.9 + , binary >=0.8.5 && <0.9 , bytestring >=0.10.8 && <0.11 , conduit >=1.3.1 && <1.4 , conduit-extra >=1.3.0 && <1.4 - , containers >=0.6.0 && <0.7 + , containers >=0.5.0 && <0.7 , net-mqtt , network-conduit-tls >=1.3.2 && <1.4 , network-uri >=2.6.1 && <2.7 - , stm >=2.5.0 && <2.6 + , stm >=2.4.0 && <2.6 , tasty , tasty-hunit , tasty-quickcheck diff --git a/src/Network/MQTT/Client.hs b/src/Network/MQTT/Client.hs --- a/src/Network/MQTT/Client.hs +++ b/src/Network/MQTT/Client.hs @@ -21,13 +21,14 @@ module Network.MQTT.Client ( -- * Configuring the client. MQTTConfig(..), MQTTClient, QoS(..), Topic, mqttConfig, mkLWT, LastWill(..), - ProtocolLevel(..), Property(..), SubOptions(..), defaultSubOptions, + ProtocolLevel(..), Property(..), SubOptions(..), subOptions, -- * Running and waiting for the client. runClient, runClientTLS, waitForClient, - connectURI, svrProps, + connectURI, disconnect, normalDisconnect, -- * General client interactions. - subscribe, unsubscribe, publish, publishq, pubAliased + subscribe, unsubscribe, publish, publishq, pubAliased, + svrProps ) where import Control.Concurrent (threadDelay) @@ -342,7 +343,7 @@ checkConnected c ch <- newTChan pid <- readTVar _pktID - modifyTVar' _pktID (\x -> case succ x of 0 -> 1; x' -> x') + modifyTVar' _pktID $ if pid == maxBound then const 1 else succ modifyTVar' _acks (Map.union (Map.fromList [((t, pid), ch) | t <- dts])) pure (ch,pid) diff --git a/src/Network/MQTT/Types.hs b/src/Network/MQTT/Types.hs --- a/src/Network/MQTT/Types.hs +++ b/src/Network/MQTT/Types.hs @@ -17,7 +17,7 @@ ConnectRequest(..), connectRequest, ConnACKFlags(..), ConnACKRC(..), PublishRequest(..), PubACK(..), PubREC(..), PubREL(..), PubCOMP(..), ProtocolLevel(..), Property(..), AuthRequest(..), - SubscribeRequest(..), SubOptions(..), defaultSubOptions, SubscribeResponse(..), SubErr(..), + SubscribeRequest(..), SubOptions(..), subOptions, SubscribeResponse(..), SubErr(..), RetainHandling(..), DisconnectRequest(..), UnsubscribeRequest(..), UnsubscribeResponse(..), DiscoReason(..), parsePacket, ByteMe(toByteString), @@ -569,21 +569,26 @@ where qlen QoS0 = 0 qlen _ = 2 -data RetainHandling = SendOnSubscribe | SendOnSubscribeNew | DoNotSendOnSubscribe +-- | How to process retained messages on subscriptions. +data RetainHandling = SendOnSubscribe -- ^ Send existing retained messages to a new client. + | SendOnSubscribeNew -- ^ Send existing retained messages that have not yet been sent. + | DoNotSendOnSubscribe -- ^ Don't send existing retained messages. deriving (Eq, Show, Bounded, Enum) +-- | Options used at subscribe time to define how to handle incoming messages. data SubOptions = SubOptions{ - _retainHandling :: RetainHandling - , _retainAsPublished :: Bool - , _noLocal :: Bool - , _subQoS :: QoS + _retainHandling :: RetainHandling -- ^ How to handle existing retained messages. + , _retainAsPublished :: Bool -- ^ If true, retain is propagated on subscribe. + , _noLocal :: Bool -- ^ If true, do not send messages initiated from this client back. + , _subQoS :: QoS -- ^ Maximum QoS to use for this subscription. } deriving(Eq, Show) -defaultSubOptions :: SubOptions -defaultSubOptions = SubOptions{_retainHandling=SendOnSubscribe, - _retainAsPublished=False, - _noLocal=False, - _subQoS=QoS0} +-- | Reasonable subscription option defaults at QoS0. +subOptions :: SubOptions +subOptions = SubOptions{_retainHandling=SendOnSubscribe, + _retainAsPublished=False, + _noLocal=False, + _subQoS=QoS0} instance ByteMe SubOptions where toByteString _ SubOptions{..} = BL.singleton (rh .|. rap .|. nl .|. q) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -219,7 +219,7 @@ where cl lw = lw{_willProps=mempty} v311mask (ConnACKPkt (ConnACKFlags a b _)) = ConnACKPkt (ConnACKFlags a b mempty) v311mask (SubscribePkt (SubscribeRequest p s _)) = SubscribePkt (SubscribeRequest p c mempty) - where c = map (\(k,SubOptions{..}) -> (k,defaultSubOptions{_subQoS=_subQoS})) s + where c = map (\(k,SubOptions{..}) -> (k,subOptions{_subQoS=_subQoS})) s v311mask (SubACKPkt (SubscribeResponse p s _)) = SubACKPkt (SubscribeResponse p s mempty) v311mask (UnsubscribePkt (UnsubscribeRequest p l _)) = UnsubscribePkt (UnsubscribeRequest p l mempty) v311mask (UnsubACKPkt (UnsubscribeResponse p _)) = UnsubACKPkt (UnsubscribeResponse p mempty)