net-mqtt 0.5.0.2 → 0.5.1.0

raw patch · 5 files changed

+232/−188 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Changelog.md +11/−0
• net-mqtt.cabal +7/−4
• src/Network/MQTT/Arbitrary.hs +209/−0
• src/Network/MQTT/Types.hs +2/−2
• test/Spec.hs +3/−182

@@ -1,5 +1,16 @@ # Changelog for net-mqtt +## 0.5.1.0++The QuickCheck Arbitrary instances are exported in a module now,+allowing programs to generate useful tests other implementations of+mqtt.  I've been using this package to test a C implementation.++Also, don't allow 3.1.1 to generate a password without a username.+That's kind of a weird limitation in the older protocol I'm not sure+anyone's run into, but the spec says not to encode things on the wire+that way, so it's useful for interop testing.+ ## 0.5.0.2  With a few attempts to misuse the library, I found some places where

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3c221d190f39c9b883915e0e17701983e95297762972cda53caf5f87b53856c1+-- hash: ae5e3dfe2f39a8729bd34aa29df254e2761a1537f932d801ec64c90aee241705  name:           net-mqtt-version:        0.5.0.2+version:        0.5.1.0 synopsis:       An MQTT Protocol Implementation. description:    Please see the README on GitHub at <https://github.com/dustin/mqtt-hs#readme> category:       Network@@ -29,6 +29,7 @@  library   exposed-modules:+      Network.MQTT.Arbitrary       Network.MQTT.Client       Network.MQTT.Topic       Network.MQTT.Types@@ -38,7 +39,8 @@       src   ghc-options: -Wall   build-depends:-      async >=2.2.1 && <2.3+      QuickCheck+    , async >=2.2.1 && <2.3     , attoparsec >=0.13.2 && <0.14     , attoparsec-binary >=0.2 && <1.0     , base >=4.7 && <5@@ -61,7 +63,8 @@       app   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:-      async >=2.2.1 && <2.3+      QuickCheck+    , async >=2.2.1 && <2.3     , attoparsec >=0.13.2 && <0.14     , attoparsec-binary >=0.2 && <1.0     , base >=4.7 && <5

@@ -0,0 +1,209 @@+{-|+Module       : Network.MQTT.Arbitrary+Description  : Arbitrary instances for QuickCheck.+Copyright    : (c) Dustin Sallings, 2019+License      : BSD3+Maintainer   : dustin@spy.net+Stability    : experimental++Arbitrary instances for QuickCheck.+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Network.MQTT.Arbitrary (+  SizeT(..),+  v311mask+  ) where++import           Control.Applicative   (liftA2)+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy  as L+import           Network.MQTT.Types    as MT+import           Test.QuickCheck       as QC++++-- | Arbitrary type fitting variable integers.+newtype SizeT = SizeT Int deriving(Eq, Show)++instance Arbitrary SizeT where+  arbitrary = SizeT <$> oneof [ choose (0, 127),+                                choose (128, 16383),+                                choose (16384, 2097151),+                                choose (2097152, 268435455)]++instance Arbitrary LastWill where+  arbitrary = LastWill <$> arbitrary <*> arbitrary <*> astr <*> astr <*> arbitrary++instance Arbitrary ProtocolLevel where arbitrary = arbitraryBoundedEnum++instance Arbitrary ConnectRequest where+  arbitrary = do+    _username <- mastr+    _password <- mastr+    _connID <- astr+    _cleanSession <- arbitrary+    _keepAlive <- arbitrary+    _lastWill <- arbitrary+    _properties <- arbitrary++    pure ConnectRequest{..}++mastr :: Gen (Maybe L.ByteString)+mastr = fmap (L.fromStrict . BC.pack . getUnicodeString) <$> arbitrary++astr :: Gen L.ByteString+astr = L.fromStrict . BC.pack . getUnicodeString <$> arbitrary++instance Arbitrary QoS where+  arbitrary = arbitraryBoundedEnum++instance Arbitrary ConnACKFlags where+  arbitrary = ConnACKFlags <$> arbitrary <*> arbitrary <*> arbitrary+  shrink (ConnACKFlags b c pl)+    | null pl = []+    | otherwise = ConnACKFlags b c <$> shrink pl++instance Arbitrary PublishRequest where+  arbitrary = do+    _pubDup <- arbitrary+    _pubQoS <- arbitrary+    _pubRetain <- arbitrary+    _pubTopic <- astr+    _pubPktID <- if _pubQoS == QoS0 then pure 0 else arbitrary+    _pubBody <- astr+    _pubProps <- arbitrary+    pure PublishRequest{..}++instance Arbitrary PubACK where+  arbitrary = PubACK <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary PubREL where+  arbitrary = PubREL <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary PubREC where+  arbitrary = PubREC <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary PubCOMP where+  arbitrary = PubCOMP <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary SubscribeRequest where+  arbitrary = arbitrary >>= \pid -> choose (1,11) >>= \n -> SubscribeRequest pid <$> vectorOf n sub <*> arbitrary+    where sub = liftA2 (,) astr arbitrary++  shrink (SubscribeRequest w s p) =+    if length s < 2 then []+    else [SubscribeRequest w (take 1 s) p' | p' <- shrinkList (:[]) p, length p > 1]++instance Arbitrary SubOptions where+  arbitrary = SubOptions <$> arbitraryBoundedEnum <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary SubErr where arbitrary = arbitraryBoundedEnum++instance Arbitrary SubscribeResponse where+  arbitrary = arbitrary >>= \pid -> choose (1,11) >>= \n -> SubscribeResponse pid <$> vectorOf n arbitrary <*> arbitrary++  shrink (SubscribeResponse pid l props)+    | length l == 1 = []+    | otherwise = [SubscribeResponse pid sl props | sl <- shrinkList (:[]) l, not (null sl)]++instance Arbitrary UnsubscribeRequest where+  arbitrary = arbitrary >>= \pid -> choose (1,11) >>= \n -> UnsubscribeRequest pid <$> vectorOf n astr <*> arbitrary+  shrink (UnsubscribeRequest p l props)+    | length l == 1 = []+    | otherwise = [UnsubscribeRequest p sl props | sl <- shrinkList (:[]) l, not (null sl)]++instance Arbitrary UnsubStatus where arbitrary = arbitraryBoundedEnum++instance Arbitrary UnsubscribeResponse where+  arbitrary = UnsubscribeResponse <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary MT.Property where+  arbitrary = oneof [+    PropPayloadFormatIndicator <$> arbitrary,+    PropMessageExpiryInterval <$> arbitrary,+    PropMessageExpiryInterval <$> arbitrary,+    PropContentType <$> astr,+    PropResponseTopic <$> astr,+    PropCorrelationData <$> astr,+    PropSubscriptionIdentifier <$> arbitrary `suchThat` (>= 0),+    PropSessionExpiryInterval <$> arbitrary,+    PropAssignedClientIdentifier <$> astr,+    PropServerKeepAlive <$> arbitrary,+    PropAuthenticationMethod <$> astr,+    PropAuthenticationData <$> astr,+    PropRequestProblemInformation <$> arbitrary,+    PropWillDelayInterval <$> arbitrary,+    PropRequestResponseInformation <$> arbitrary,+    PropResponseInformation <$> astr,+    PropServerReference <$> astr,+    PropReasonString <$> astr,+    PropReceiveMaximum <$> arbitrary,+    PropTopicAliasMaximum <$> arbitrary,+    PropTopicAlias <$> arbitrary,+    PropMaximumQoS <$> arbitrary,+    PropRetainAvailable <$> arbitrary,+    PropUserProperty <$> astr <*> astr,+    PropMaximumPacketSize <$> arbitrary,+    PropWildcardSubscriptionAvailable <$> arbitrary,+    PropSubscriptionIdentifierAvailable <$> arbitrary,+    PropSharedSubscriptionAvailable <$> arbitrary+    ]++instance Arbitrary AuthRequest where+  arbitrary = AuthRequest <$> arbitrary <*> arbitrary++instance Arbitrary ConnACKRC where arbitrary = arbitraryBoundedEnum++instance Arbitrary DiscoReason where arbitrary = arbitraryBoundedEnum++instance Arbitrary DisconnectRequest where+  arbitrary = DisconnectRequest <$> arbitrary <*> arbitrary++instance Arbitrary MQTTPkt where+  arbitrary = oneof [+    ConnPkt <$> arbitrary,+    ConnACKPkt <$> arbitrary,+    PublishPkt <$> arbitrary,+    PubACKPkt <$> arbitrary,+    PubRELPkt <$> arbitrary,+    PubRECPkt <$> arbitrary,+    PubCOMPPkt <$> arbitrary,+    SubscribePkt <$> arbitrary,+    SubACKPkt <$> arbitrary,+    UnsubscribePkt <$> arbitrary,+    UnsubACKPkt <$> arbitrary,+    pure PingPkt, pure PongPkt,+    DisconnectPkt <$> arbitrary,+    AuthPkt <$> arbitrary+    ]+  shrink (SubACKPkt x)      = SubACKPkt <$> shrink x+  shrink (ConnACKPkt x)     = ConnACKPkt <$> shrink x+  shrink (UnsubscribePkt x) = UnsubscribePkt <$> shrink x+  shrink (SubscribePkt x)   = SubscribePkt <$> shrink x+  shrink _                  = []++-- | v311mask strips all the v5 specific bits from an MQTTPkt.+v311mask :: MQTTPkt -> MQTTPkt+v311mask (ConnPkt c@ConnectRequest{..}) = ConnPkt (c{_properties=mempty,+                                                     _password=mpw _username _password,+                                                     _lastWill=cl <$> _lastWill})+  where cl lw = lw{_willProps=mempty}+        mpw Nothing _ = Nothing+        mpw _ p       = p+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,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 mempty)+v311mask (PublishPkt req) = PublishPkt req{_pubProps=mempty}+v311mask (DisconnectPkt _) = DisconnectPkt (DisconnectRequest DiscoNormalDisconnection mempty)+v311mask (PubACKPkt (PubACK x _ _)) = PubACKPkt (PubACK x 0 mempty)+v311mask (PubRECPkt (PubREC x _ _)) = PubRECPkt (PubREC x 0 mempty)+v311mask (PubRELPkt (PubREL x _ _)) = PubRELPkt (PubREL x 0 mempty)+v311mask (PubCOMPPkt (PubCOMP x _ _)) = PubCOMPPkt (PubCOMP x 0 mempty)+v311mask x = x

@@ -319,7 +319,7 @@                         <> toByteString prot _connID                         <> lwt _lastWill                         <> perhaps _username-                        <> perhaps _password+                        <> if isJust _username then perhaps _password else ""        val Protocol50 = "\NUL\EOTMQTT\ENQ" -- MQTT + Protocol50                        <> BL.singleton connBits@@ -333,7 +333,7 @@       connBits = hasu .|. hasp .|. willBits .|. clean         where           hasu = boolBit (isJust _username) ≪ 7-          hasp = boolBit (isJust _password) ≪ 6+          hasp = boolBit ((prot == Protocol50 || isJust _username) && isJust _password) ≪ 6           clean = boolBit _cleanSession ≪ 1           willBits = case _lastWill of                        Nothing -> 0

@@ -1,30 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} -import           Control.Applicative             (liftA2) import           Control.Monad                   (mapM_) import qualified Data.Attoparsec.ByteString.Lazy as A-import qualified Data.ByteString                 as B-import qualified Data.ByteString.Char8           as BC import qualified Data.ByteString.Lazy            as L import           Data.Word                       (Word8)-import           Numeric                         (showHex)+import           Network.MQTT.Arbitrary+import           Network.MQTT.Topic+import           Network.MQTT.Types              as MT import           Test.QuickCheck                 as QC import           Test.Tasty import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck           as QC -import           Network.MQTT.Topic-import           Network.MQTT.Types              as MT--newtype SizeT = SizeT Int deriving(Eq, Show)--instance Arbitrary SizeT where-  arbitrary = SizeT <$> oneof [ choose (0, 127),-                                choose (128, 16383),-                                choose (16384, 2097151),-                                choose (2097152, 268435455)]- prop_rtLengthParser :: SizeT -> QC.Property prop_rtLengthParser (SizeT x) =   label (show (length e) <> "B") $@@ -49,157 +37,6 @@         f@A.Fail{}    -> assertFailure (show f)         (A.Done _ x') -> assertEqual (show s) x x' -instance Arbitrary LastWill where-  arbitrary = LastWill <$> arbitrary <*> arbitrary <*> astr <*> astr <*> arbitrary--instance Arbitrary ProtocolLevel where arbitrary = arbitraryBoundedEnum--instance Arbitrary ConnectRequest where-  arbitrary = do-    _username <- mastr-    _password <- mastr-    _connID <- astr-    _cleanSession <- arbitrary-    _keepAlive <- arbitrary-    _lastWill <- arbitrary-    _properties <- arbitrary--    pure ConnectRequest{..}--mastr :: Gen (Maybe L.ByteString)-mastr = fmap (L.fromStrict . BC.pack . getUnicodeString) <$> arbitrary--astr :: Gen L.ByteString-astr = L.fromStrict . BC.pack . getUnicodeString <$> arbitrary--instance Arbitrary QoS where-  arbitrary = arbitraryBoundedEnum--instance Arbitrary ConnACKFlags where-  arbitrary = ConnACKFlags <$> arbitrary <*> arbitrary <*> arbitrary-  shrink (ConnACKFlags b c pl)-    | null pl = []-    | otherwise = ConnACKFlags b c <$> shrink pl--instance Arbitrary PublishRequest where-  arbitrary = do-    _pubDup <- arbitrary-    _pubQoS <- arbitrary-    _pubRetain <- arbitrary-    _pubTopic <- astr-    _pubPktID <- if _pubQoS == QoS0 then pure 0 else arbitrary-    _pubBody <- astr-    _pubProps <- arbitrary-    pure PublishRequest{..}--instance Arbitrary PubACK where-  arbitrary = PubACK <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary PubREL where-  arbitrary = PubREL <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary PubREC where-  arbitrary = PubREC <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary PubCOMP where-  arbitrary = PubCOMP <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary SubscribeRequest where-  arbitrary = arbitrary >>= \pid -> choose (1,11) >>= \n -> SubscribeRequest pid <$> vectorOf n sub <*> arbitrary-    where sub = liftA2 (,) astr arbitrary--  shrink (SubscribeRequest w s p) =-    if length s < 2 then []-    else [SubscribeRequest w (take 1 s) p' | p' <- shrinkList (:[]) p, length p > 1]--instance Arbitrary SubOptions where-  arbitrary = SubOptions <$> arbitraryBoundedEnum <*> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary SubErr where arbitrary = arbitraryBoundedEnum--instance Arbitrary SubscribeResponse where-  arbitrary = arbitrary >>= \pid -> choose (1,11) >>= \n -> SubscribeResponse pid <$> vectorOf n arbitrary <*> arbitrary--  shrink (SubscribeResponse pid l props)-    | length l == 1 = []-    | otherwise = [SubscribeResponse pid sl props | sl <- shrinkList (:[]) l, not (null sl)]--instance Arbitrary UnsubscribeRequest where-  arbitrary = arbitrary >>= \pid -> choose (1,11) >>= \n -> UnsubscribeRequest pid <$> vectorOf n astr <*> arbitrary-  shrink (UnsubscribeRequest p l props)-    | length l == 1 = []-    | otherwise = [UnsubscribeRequest p sl props | sl <- shrinkList (:[]) l, not (null sl)]--instance Arbitrary UnsubStatus where arbitrary = arbitraryBoundedEnum--instance Arbitrary UnsubscribeResponse where-  arbitrary = UnsubscribeResponse <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary MT.Property where-  arbitrary = oneof [-    PropPayloadFormatIndicator <$> arbitrary,-    PropMessageExpiryInterval <$> arbitrary,-    PropMessageExpiryInterval <$> arbitrary,-    PropContentType <$> astr,-    PropResponseTopic <$> astr,-    PropCorrelationData <$> astr,-    PropSubscriptionIdentifier <$> arbitrary `suchThat` (>= 0),-    PropSessionExpiryInterval <$> arbitrary,-    PropAssignedClientIdentifier <$> astr,-    PropServerKeepAlive <$> arbitrary,-    PropAuthenticationMethod <$> astr,-    PropAuthenticationData <$> astr,-    PropRequestProblemInformation <$> arbitrary,-    PropWillDelayInterval <$> arbitrary,-    PropRequestResponseInformation <$> arbitrary,-    PropResponseInformation <$> astr,-    PropServerReference <$> astr,-    PropReasonString <$> astr,-    PropReceiveMaximum <$> arbitrary,-    PropTopicAliasMaximum <$> arbitrary,-    PropTopicAlias <$> arbitrary,-    PropMaximumQoS <$> arbitrary,-    PropRetainAvailable <$> arbitrary,-    PropUserProperty <$> astr <*> astr,-    PropMaximumPacketSize <$> arbitrary,-    PropWildcardSubscriptionAvailable <$> arbitrary,-    PropSubscriptionIdentifierAvailable <$> arbitrary,-    PropSharedSubscriptionAvailable <$> arbitrary-    ]--instance Arbitrary AuthRequest where-  arbitrary = AuthRequest <$> arbitrary <*> arbitrary--instance Arbitrary ConnACKRC where arbitrary = arbitraryBoundedEnum--instance Arbitrary DiscoReason where arbitrary = arbitraryBoundedEnum--instance Arbitrary DisconnectRequest where-  arbitrary = DisconnectRequest <$> arbitrary <*> arbitrary--instance Arbitrary MQTTPkt where-  arbitrary = oneof [-    ConnPkt <$> arbitrary,-    ConnACKPkt <$> arbitrary,-    PublishPkt <$> arbitrary,-    PubACKPkt <$> arbitrary,-    PubRELPkt <$> arbitrary,-    PubRECPkt <$> arbitrary,-    PubCOMPPkt <$> arbitrary,-    SubscribePkt <$> arbitrary,-    SubACKPkt <$> arbitrary,-    UnsubscribePkt <$> arbitrary,-    UnsubACKPkt <$> arbitrary,-    pure PingPkt, pure PongPkt,-    DisconnectPkt <$> arbitrary,-    AuthPkt <$> arbitrary-    ]-  shrink (SubACKPkt x)      = SubACKPkt <$> shrink x-  shrink (ConnACKPkt x)     = ConnACKPkt <$> shrink x-  shrink (UnsubscribePkt x) = UnsubscribePkt <$> shrink x-  shrink (SubscribePkt x)   = SubscribePkt <$> shrink x-  shrink _                  = []- prop_PacketRT50 :: MQTTPkt -> QC.Property prop_PacketRT50 p = label (lab p) $ case A.parse (parsePacket Protocol50) (toByteString Protocol50 p) of                                          A.Fail{}     -> False@@ -216,22 +53,6 @@    where     lab x = let (s,_) = break (== ' ') . show $ x in s-    v311mask :: MQTTPkt -> MQTTPkt-    v311mask (ConnPkt c) = ConnPkt (c{_properties=mempty, _lastWill=cl <$> _lastWill c})-      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,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 mempty)-    v311mask (PublishPkt req) = PublishPkt req{_pubProps=mempty}-    v311mask (DisconnectPkt _) = DisconnectPkt (DisconnectRequest DiscoNormalDisconnection mempty)-    v311mask (PubACKPkt (PubACK x _ _)) = PubACKPkt (PubACK x 0 mempty)-    v311mask (PubRECPkt (PubREC x _ _)) = PubRECPkt (PubREC x 0 mempty)-    v311mask (PubRELPkt (PubREL x _ _)) = PubRELPkt (PubREL x 0 mempty)-    v311mask (PubCOMPPkt (PubCOMP x _ _)) = PubCOMPPkt (PubCOMP x 0 mempty)-    v311mask x = x      available (AuthPkt _) = False     available _           = True