net-mqtt 0.6.2.0 → 0.6.2.1

raw patch · 4 files changed

+58/−31 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Changelog.md +6/−0
• app/mqtt-watch/Main.hs +18/−6
• net-mqtt.cabal +2/−2
• src/Network/MQTT/Client.hs +32/−23

@@ -1,5 +1,11 @@ # Changelog for net-mqtt +## 0.6.2.1++Added function to get original connection ACK response packet.++- connACK (in IO) and connACKSTM+ ## 0.6.2.0  Added low-level support for correlated responses.

@@ -9,13 +9,15 @@ import           Control.Concurrent.STM   (TChan, atomically, newTChanIO,                                            readTChan, writeTChan) import           Control.Exception        (Handler (..), IOException, catches)-import           Control.Monad            (forever, void, when)+import           Control.Monad            (forever, when) import qualified Data.ByteString.Lazy     as BL import           Data.Maybe               (fromJust) import qualified Data.Text.IO             as TIO+import           Data.Word                (Word32) import           Network.MQTT.Client+import           Network.MQTT.Types       (ConnACKFlags (..)) import           Network.URI-import           Options.Applicative      (Parser, argument, execParser,+import           Options.Applicative      (Parser, argument, auto, execParser,                                            fullDesc, help, helper, info, long,                                            maybeReader, metavar, option,                                            progDesc, short, showDefault, some,@@ -25,15 +27,19 @@ data Msg = Msg Topic BL.ByteString [Property]  data Options = Options {-  optUri         :: URI-  , optHideProps :: Bool-  , optTopics    :: [Topic]+  optUri           :: URI+  , optHideProps   :: Bool+  , optSessionTime :: Word32+  , optVerbose     :: Bool+  , optTopics      :: [Topic]   }  options :: Parser Options options = Options   <$> option (maybeReader parseURI) (long "mqtt-uri" <> short 'u' <> showDefault <> value (fromJust $ parseURI "mqtt://localhost/") <> help "mqtt broker URI")   <*> switch (short 'p' <> help "hide properties")+  <*> option auto (long "session-timeout" <> showDefault <> value 0 <> help "mqtt session timeout (0 == clean)")+  <*> switch (short 'v' <> long "verbose" <> help "enable debug logging")   <*> some (argument str (metavar "topics..."))  printer :: TChan Msg -> Bool -> IO ()@@ -55,13 +61,19 @@   where     go ch = do       mc <- connectURI mqttConfig{_msgCB=SimpleCallback (showme ch), _protocol=Protocol50,+                                  _cleanSession=optSessionTime == 0,                                   _connProps=[PropReceiveMaximum 65535,                                               PropTopicAliasMaximum 10,+                                              PropSessionExpiryInterval optSessionTime,                                               PropRequestResponseInformation 1,                                               PropRequestProblemInformation 1]}         optUri -      void $ subscribe mc [(t, subOptions) | t <- optTopics] mempty+      (ConnACKFlags sp _ props) <- connACK mc+      when optVerbose $ putStrLn (if sp then "<resuming session>" else "<new session>")+      when optVerbose $ putStrLn ("Properties: " <> show props)+      subres <- subscribe mc [(t, subOptions) | t <- optTopics] mempty+      when optVerbose $ print subres        print =<< waitForClient mc 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5602a18bc959d07604ceba74369d151f6f3296000f0673b64a4539234b49d3e5+-- hash: c2a4b0d05fac2cbfd290e0b0b8b6c2d564370d3b63f467144979056c4f492ed1  name:           net-mqtt-version:        0.6.2.0+version:        0.6.2.1 synopsis:       An MQTT Protocol Implementation. description:    Please see the README on GitHub at <https://github.com/dustin/mqtt-hs#readme> category:       Network

@@ -29,9 +29,9 @@   disconnect, normalDisconnect,   -- * General client interactions.   subscribe, unsubscribe, publish, publishq, pubAliased,-  svrProps, MQTTException(..),+  svrProps, connACK, MQTTException(..),   -- * Low-level bits-  runMQTTConduit, MQTTConduit, isConnectedSTM,+  runMQTTConduit, MQTTConduit, isConnectedSTM, connACKSTM,   registerCorrelated, unregisterCorrelated   ) where @@ -101,16 +101,16 @@ -- -- See 'connectURI' for the most straightforward example. data MQTTClient = MQTTClient {-  _ch         :: TChan MQTTPkt-  , _pktID    :: TVar Word16-  , _cb       :: MessageCallback-  , _acks     :: TVar (Map (DispatchType,Word16) (TChan MQTTPkt))-  , _st       :: TVar ConnState-  , _ct       :: TVar (Async ())-  , _outA     :: TVar (Map Topic Word16)-  , _inA      :: TVar (Map Word16 Topic)-  , _svrProps :: TVar [Property]-  , _corr     :: TVar (Map BL.ByteString MessageCallback)+  _ch             :: TChan MQTTPkt+  , _pktID        :: TVar Word16+  , _cb           :: MessageCallback+  , _acks         :: TVar (Map (DispatchType,Word16) (TChan MQTTPkt))+  , _st           :: TVar ConnState+  , _ct           :: TVar (Async ())+  , _outA         :: TVar (Map Topic Word16)+  , _inA          :: TVar (Map Word16 Topic)+  , _connACKFlags :: TVar ConnACKFlags+  , _corr         :: TVar (Map BL.ByteString MessageCallback)   }  -- | Configuration for setting up an MQTT client.@@ -289,7 +289,7 @@   _ct <- newTVarIO undefined   _outA <- newTVarIO mempty   _inA <- newTVarIO mempty-  _svrProps <- newTVarIO mempty+  _connACKFlags <- newTVarIO (ConnACKFlags False ConnUnspecifiedError mempty)   _corr <- newTVarIO mempty   let _cb = _msgCB       cli = MQTTClient{..}@@ -405,14 +405,14 @@     PongPkt                                   -> atomically . writeTChan pch $ True     x                                         -> print x -  where connACKd connr@(ConnACKFlags _ val props) = case val of-                                                      ConnAccepted -> atomically $ do-                                                        writeTVar _svrProps props-                                                        writeTVar _st Connected-                                                      _ -> do-                                                        t <- readTVarIO _ct-                                                        atomically $ writeTVar _st (ConnErr connr)-                                                        cancelWith t (MQTTException $ show connr)+  where connACKd connr@(ConnACKFlags _ val _) = case val of+                                                  ConnAccepted -> atomically $ do+                                                    writeTVar _connACKFlags connr+                                                    writeTVar _st Connected+                                                  _ -> do+                                                    t <- readTVarIO _ct+                                                    atomically $ writeTVar _st (ConnErr connr)+                                                    cancelWith t (MQTTException $ show connr)          delegate dt pid = atomically $ do           m <- readTVar _acks@@ -640,10 +640,19 @@  -- | Get the list of properties that were sent from the broker at connect time. svrProps :: MQTTClient -> IO [Property]-svrProps MQTTClient{..} = readTVarIO _svrProps+svrProps mc = p <$> atomically (connACKSTM mc)+  where p (ConnACKFlags _ _ props) = props +-- | Get the complete connection ACK packet from the beginning of this session.+connACKSTM :: MQTTClient -> STM ConnACKFlags+connACKSTM MQTTClient{_connACKFlags} = readTVar _connACKFlags++-- | Get the complete connection aCK packet from the beginning of this session.+connACK :: MQTTClient -> IO ConnACKFlags+connACK = atomically . connACKSTM+ maxAliases :: MQTTClient -> IO Word16-maxAliases MQTTClient{..} = foldr f 0 <$> readTVarIO _svrProps+maxAliases mc = foldr f 0 <$> svrProps mc   where     f (PropTopicAliasMaximum n) _ = n     f _ o                         = o