{-|
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   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Network.MQTT.Arbitrary (
  SizeT(..),
  MatchingTopic(..),
  arbitraryTopicSegment, arbitraryTopic, arbitraryFilter,
  arbitraryMatchingTopic, v311mask
  ) where

import           Control.Applicative   (liftA2)
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy  as L
import           Data.Function         ((&))
import           Data.Maybe            (mapMaybe)
import           Data.Text             (Text)
import qualified Data.Text             as Text
import           Network.MQTT.Topic    (Filter, Topic, mkFilter, mkTopic, unTopic, unFilter)
import           Network.MQTT.Types    as MT
import           Test.QuickCheck       as QC


-- | Arbitrary type fitting variable integers.
newtype SizeT = SizeT Int deriving(SizeT -> SizeT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizeT -> SizeT -> Bool
$c/= :: SizeT -> SizeT -> Bool
== :: SizeT -> SizeT -> Bool
$c== :: SizeT -> SizeT -> Bool
Eq, Int -> SizeT -> ShowS
[SizeT] -> ShowS
SizeT -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizeT] -> ShowS
$cshowList :: [SizeT] -> ShowS
show :: SizeT -> String
$cshow :: SizeT -> String
showsPrec :: Int -> SizeT -> ShowS
$cshowsPrec :: Int -> SizeT -> ShowS
Show)

instance Arbitrary SizeT where
  arbitrary :: Gen SizeT
arbitrary = Int -> SizeT
SizeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [Gen a] -> Gen a
oneof [ forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
127),
                                forall a. Random a => (a, a) -> Gen a
choose (Int
128, Int
16383),
                                forall a. Random a => (a, a) -> Gen a
choose (Int
16384, Int
2097151),
                                forall a. Random a => (a, a) -> Gen a
choose (Int
2097152, Int
268435455)]

instance Arbitrary LastWill where
  arbitrary :: Gen LastWill
arbitrary = Bool -> QoS -> ByteString -> ByteString -> [Property] -> LastWill
LastWill forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
astr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
astr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ProtocolLevel where arbitrary :: Gen ProtocolLevel
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ConnectRequest where
  arbitrary :: Gen ConnectRequest
arbitrary = do
    Maybe ByteString
_username <- Gen (Maybe ByteString)
mastr
    Maybe ByteString
_password <- Gen (Maybe ByteString)
mastr
    ByteString
_connID <- Gen ByteString
astr
    Bool
_cleanSession <- forall a. Arbitrary a => Gen a
arbitrary
    Word16
_keepAlive <- forall a. Arbitrary a => Gen a
arbitrary
    Maybe LastWill
_lastWill <- forall a. Arbitrary a => Gen a
arbitrary
    [Property]
_connProperties <- forall a. Arbitrary a => Gen a
arbitrary

    forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectRequest{Bool
[Property]
Maybe ByteString
Maybe LastWill
Word16
ByteString
_connProperties :: [Property]
_connID :: ByteString
_keepAlive :: Word16
_cleanSession :: Bool
_lastWill :: Maybe LastWill
_password :: Maybe ByteString
_username :: Maybe ByteString
_connProperties :: [Property]
_lastWill :: Maybe LastWill
_keepAlive :: Word16
_cleanSession :: Bool
_connID :: ByteString
_password :: Maybe ByteString
_username :: Maybe ByteString
..}

mastr :: Gen (Maybe L.ByteString)
mastr :: Gen (Maybe ByteString)
mastr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
L.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeString -> String
getUnicodeString) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

astr :: Gen L.ByteString
astr :: Gen ByteString
astr = ByteString -> ByteString
L.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeString -> String
getUnicodeString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary QoS where
  arbitrary :: Gen QoS
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary SessionReuse where arbitrary :: Gen SessionReuse
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ConnACKFlags where
  arbitrary :: Gen ConnACKFlags
arbitrary = SessionReuse -> ConnACKRC -> [Property] -> ConnACKFlags
ConnACKFlags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ConnACKFlags -> [ConnACKFlags]
shrink (ConnACKFlags SessionReuse
b ConnACKRC
c [Property]
pl)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Property]
pl = []
    | Bool
otherwise = SessionReuse -> ConnACKRC -> [Property] -> ConnACKFlags
ConnACKFlags SessionReuse
b ConnACKRC
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink [Property]
pl

instance Arbitrary PublishRequest where
  arbitrary :: Gen PublishRequest
arbitrary = do
    Bool
_pubDup <- forall a. Arbitrary a => Gen a
arbitrary
    QoS
_pubQoS <- forall a. Arbitrary a => Gen a
arbitrary
    Bool
_pubRetain <- forall a. Arbitrary a => Gen a
arbitrary
    ByteString
_pubTopic <- Gen ByteString
astr
    Word16
_pubPktID <- if QoS
_pubQoS forall a. Eq a => a -> a -> Bool
== QoS
QoS0 then forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
0 else forall a. Arbitrary a => Gen a
arbitrary
    ByteString
_pubBody <- Gen ByteString
astr
    [Property]
_pubProps <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure PublishRequest{Bool
[Property]
Word16
ByteString
QoS
_pubProps :: [Property]
_pubBody :: ByteString
_pubPktID :: Word16
_pubTopic :: ByteString
_pubRetain :: Bool
_pubQoS :: QoS
_pubDup :: Bool
_pubProps :: [Property]
_pubBody :: ByteString
_pubPktID :: Word16
_pubTopic :: ByteString
_pubRetain :: Bool
_pubQoS :: QoS
_pubDup :: Bool
..}

instance Arbitrary PubACK where
  arbitrary :: Gen PubACK
arbitrary = Word16 -> Word8 -> [Property] -> PubACK
PubACK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PubREL where
  arbitrary :: Gen PubREL
arbitrary = Word16 -> Word8 -> [Property] -> PubREL
PubREL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PubREC where
  arbitrary :: Gen PubREC
arbitrary = Word16 -> Word8 -> [Property] -> PubREC
PubREC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PubCOMP where
  arbitrary :: Gen PubCOMP
arbitrary = Word16 -> Word8 -> [Property] -> PubCOMP
PubCOMP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary SubscribeRequest where
  arbitrary :: Gen SubscribeRequest
arbitrary = forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word16
pid -> forall a. Random a => (a, a) -> Gen a
choose (Int
1,Int
11) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> Word16
-> [(ByteString, SubOptions)] -> [Property] -> SubscribeRequest
SubscribeRequest Word16
pid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (ByteString, SubOptions)
sub forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    where sub :: Gen (ByteString, SubOptions)
sub = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Gen ByteString
astr forall a. Arbitrary a => Gen a
arbitrary

  shrink :: SubscribeRequest -> [SubscribeRequest]
shrink (SubscribeRequest Word16
w [(ByteString, SubOptions)]
s [Property]
p) =
    if forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ByteString, SubOptions)]
s forall a. Ord a => a -> a -> Bool
< Int
2 then []
    else [Word16
-> [(ByteString, SubOptions)] -> [Property] -> SubscribeRequest
SubscribeRequest Word16
w (forall a. Int -> [a] -> [a]
take Int
1 [(ByteString, SubOptions)]
s) [Property]
p' | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Property]
p), [Property]
p' <- forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall a b. a -> b -> a
const []) [Property]
p]

instance Arbitrary SubOptions where
  arbitrary :: Gen SubOptions
arbitrary = RetainHandling -> Bool -> Bool -> QoS -> SubOptions
SubOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary SubErr where arbitrary :: Gen SubErr
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary SubscribeResponse where
  arbitrary :: Gen SubscribeResponse
arbitrary = forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word16
pid -> forall a. Random a => (a, a) -> Gen a
choose (Int
1,Int
11) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> Word16 -> [Either SubErr QoS] -> [Property] -> SubscribeResponse
SubscribeResponse Word16
pid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

  shrink :: SubscribeResponse -> [SubscribeResponse]
shrink (SubscribeResponse Word16
pid [Either SubErr QoS]
l [Property]
props)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either SubErr QoS]
l forall a. Eq a => a -> a -> Bool
== Int
1 = []
    | Bool
otherwise = [Word16 -> [Either SubErr QoS] -> [Property] -> SubscribeResponse
SubscribeResponse Word16
pid [Either SubErr QoS]
sl [Property]
props | [Either SubErr QoS]
sl <- forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall a b. a -> b -> a
const []) [Either SubErr QoS]
l, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Either SubErr QoS]
sl)]

instance Arbitrary UnsubscribeRequest where
  arbitrary :: Gen UnsubscribeRequest
arbitrary = forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word16
pid -> forall a. Random a => (a, a) -> Gen a
choose (Int
1,Int
11) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> Word16 -> [ByteString] -> [Property] -> UnsubscribeRequest
UnsubscribeRequest Word16
pid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen ByteString
astr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: UnsubscribeRequest -> [UnsubscribeRequest]
shrink (UnsubscribeRequest Word16
p [ByteString]
l [Property]
props)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
l forall a. Eq a => a -> a -> Bool
== Int
1 = []
    | Bool
otherwise = [Word16 -> [ByteString] -> [Property] -> UnsubscribeRequest
UnsubscribeRequest Word16
p [ByteString]
sl [Property]
props | [ByteString]
sl <- forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall a b. a -> b -> a
const []) [ByteString]
l, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
sl)]

instance Arbitrary UnsubStatus where arbitrary :: Gen UnsubStatus
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary UnsubscribeResponse where
  arbitrary :: Gen UnsubscribeResponse
arbitrary = Word16 -> [Property] -> [UnsubStatus] -> UnsubscribeResponse
UnsubscribeResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary MT.Property where
  arbitrary :: Gen Property
arbitrary = forall a. [Gen a] -> Gen a
oneof [
    Word8 -> Property
PropPayloadFormatIndicator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word32 -> Property
PropMessageExpiryInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word32 -> Property
PropMessageExpiryInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    ByteString -> Property
PropContentType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    ByteString -> Property
PropResponseTopic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    ByteString -> Property
PropCorrelationData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    Int -> Property
PropSubscriptionIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (forall a. Ord a => a -> a -> Bool
>= Int
0),
    Word32 -> Property
PropSessionExpiryInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    ByteString -> Property
PropAssignedClientIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    Word16 -> Property
PropServerKeepAlive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    ByteString -> Property
PropAuthenticationMethod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    ByteString -> Property
PropAuthenticationData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    Word8 -> Property
PropRequestProblemInformation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word32 -> Property
PropWillDelayInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word8 -> Property
PropRequestResponseInformation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    ByteString -> Property
PropResponseInformation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    ByteString -> Property
PropServerReference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    ByteString -> Property
PropReasonString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr,
    Word16 -> Property
PropReceiveMaximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word16 -> Property
PropTopicAliasMaximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word16 -> Property
PropTopicAlias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word8 -> Property
PropMaximumQoS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word8 -> Property
PropRetainAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    ByteString -> ByteString -> Property
PropUserProperty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
astr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
astr,
    Word32 -> Property
PropMaximumPacketSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word8 -> Property
PropWildcardSubscriptionAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word8 -> Property
PropSubscriptionIdentifierAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    Word8 -> Property
PropSharedSubscriptionAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    ]

instance Arbitrary AuthRequest where
  arbitrary :: Gen AuthRequest
arbitrary = Word8 -> [Property] -> AuthRequest
AuthRequest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ConnACKRC where arbitrary :: Gen ConnACKRC
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary DiscoReason where arbitrary :: Gen DiscoReason
arbitrary = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary DisconnectRequest where
  arbitrary :: Gen DisconnectRequest
arbitrary = DiscoReason -> [Property] -> DisconnectRequest
DisconnectRequest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary MQTTPkt where
  arbitrary :: Gen MQTTPkt
arbitrary = forall a. [Gen a] -> Gen a
oneof [
    ConnectRequest -> ProtocolLevel -> MQTTPkt
ConnPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProtocolLevel
Protocol50,
    ConnACKFlags -> MQTTPkt
ConnACKPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    PublishRequest -> MQTTPkt
PublishPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    PubACK -> MQTTPkt
PubACKPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    PubREL -> MQTTPkt
PubRELPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    PubREC -> MQTTPkt
PubRECPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    PubCOMP -> MQTTPkt
PubCOMPPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    SubscribeRequest -> MQTTPkt
SubscribePkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    SubscribeResponse -> MQTTPkt
SubACKPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    UnsubscribeRequest -> MQTTPkt
UnsubscribePkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    UnsubscribeResponse -> MQTTPkt
UnsubACKPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MQTTPkt
PingPkt, forall (f :: * -> *) a. Applicative f => a -> f a
pure MQTTPkt
PongPkt,
    DisconnectRequest -> MQTTPkt
DisconnectPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary,
    AuthRequest -> MQTTPkt
AuthPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    ]
  shrink :: MQTTPkt -> [MQTTPkt]
shrink (SubACKPkt SubscribeResponse
x)      = SubscribeResponse -> MQTTPkt
SubACKPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink SubscribeResponse
x
  shrink (ConnACKPkt ConnACKFlags
x)     = ConnACKFlags -> MQTTPkt
ConnACKPkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink ConnACKFlags
x
  shrink (UnsubscribePkt UnsubscribeRequest
x) = UnsubscribeRequest -> MQTTPkt
UnsubscribePkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink UnsubscribeRequest
x
  shrink (SubscribePkt SubscribeRequest
x)   = SubscribeRequest -> MQTTPkt
SubscribePkt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink SubscribeRequest
x
  shrink MQTTPkt
_                  = []

-- | v311mask strips all the v5 specific bits from an MQTTPkt.
v311mask :: MQTTPkt -> MQTTPkt
v311mask :: MQTTPkt -> MQTTPkt
v311mask (ConnPkt c :: ConnectRequest
c@ConnectRequest{Bool
[Property]
Maybe ByteString
Maybe LastWill
Word16
ByteString
_connProperties :: [Property]
_connID :: ByteString
_keepAlive :: Word16
_cleanSession :: Bool
_lastWill :: Maybe LastWill
_password :: Maybe ByteString
_username :: Maybe ByteString
_connProperties :: ConnectRequest -> [Property]
_connID :: ConnectRequest -> ByteString
_keepAlive :: ConnectRequest -> Word16
_cleanSession :: ConnectRequest -> Bool
_lastWill :: ConnectRequest -> Maybe LastWill
_password :: ConnectRequest -> Maybe ByteString
_username :: ConnectRequest -> Maybe ByteString
..} ProtocolLevel
_) = ConnectRequest -> ProtocolLevel -> MQTTPkt
ConnPkt (ConnectRequest
c{_connProperties :: [Property]
_connProperties=forall a. Monoid a => a
mempty,
                                                       _password :: Maybe ByteString
_password=forall {a} {a}. Maybe a -> Maybe a -> Maybe a
mpw Maybe ByteString
_username Maybe ByteString
_password,
                                                       _lastWill :: Maybe LastWill
_lastWill=LastWill -> LastWill
cl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LastWill
_lastWill}) ProtocolLevel
Protocol311
  where cl :: LastWill -> LastWill
cl LastWill
lw = LastWill
lw{_willProps :: [Property]
_willProps=forall a. Monoid a => a
mempty}
        mpw :: Maybe a -> Maybe a -> Maybe a
mpw Maybe a
Nothing Maybe a
_ = forall a. Maybe a
Nothing
        mpw Maybe a
_ Maybe a
p       = Maybe a
p
v311mask (ConnACKPkt (ConnACKFlags SessionReuse
a ConnACKRC
b [Property]
_)) = ConnACKFlags -> MQTTPkt
ConnACKPkt (SessionReuse -> ConnACKRC -> [Property] -> ConnACKFlags
ConnACKFlags SessionReuse
a ConnACKRC
b forall a. Monoid a => a
mempty)
v311mask (SubscribePkt (SubscribeRequest Word16
p [(ByteString, SubOptions)]
s [Property]
_)) = SubscribeRequest -> MQTTPkt
SubscribePkt (Word16
-> [(ByteString, SubOptions)] -> [Property] -> SubscribeRequest
SubscribeRequest Word16
p [(ByteString, SubOptions)]
c forall a. Monoid a => a
mempty)
  where c :: [(ByteString, SubOptions)]
c = forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
k,SubOptions{Bool
RetainHandling
QoS
_subQoS :: SubOptions -> QoS
_noLocal :: SubOptions -> Bool
_retainAsPublished :: SubOptions -> Bool
_retainHandling :: SubOptions -> RetainHandling
_subQoS :: QoS
_noLocal :: Bool
_retainAsPublished :: Bool
_retainHandling :: RetainHandling
..}) -> (ByteString
k,SubOptions
subOptions{_subQoS :: QoS
_subQoS=QoS
_subQoS})) [(ByteString, SubOptions)]
s
v311mask (SubACKPkt (SubscribeResponse Word16
p [Either SubErr QoS]
s [Property]
_)) = SubscribeResponse -> MQTTPkt
SubACKPkt (Word16 -> [Either SubErr QoS] -> [Property] -> SubscribeResponse
SubscribeResponse Word16
p [Either SubErr QoS]
s forall a. Monoid a => a
mempty)
v311mask (UnsubscribePkt (UnsubscribeRequest Word16
p [ByteString]
l [Property]
_)) = UnsubscribeRequest -> MQTTPkt
UnsubscribePkt (Word16 -> [ByteString] -> [Property] -> UnsubscribeRequest
UnsubscribeRequest Word16
p [ByteString]
l forall a. Monoid a => a
mempty)
v311mask (UnsubACKPkt (UnsubscribeResponse Word16
p [Property]
_ [UnsubStatus]
_)) = UnsubscribeResponse -> MQTTPkt
UnsubACKPkt (Word16 -> [Property] -> [UnsubStatus] -> UnsubscribeResponse
UnsubscribeResponse Word16
p forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
v311mask (PublishPkt PublishRequest
req) = PublishRequest -> MQTTPkt
PublishPkt PublishRequest
req{_pubProps :: [Property]
_pubProps=forall a. Monoid a => a
mempty}
v311mask (DisconnectPkt DisconnectRequest
_) = DisconnectRequest -> MQTTPkt
DisconnectPkt (DiscoReason -> [Property] -> DisconnectRequest
DisconnectRequest DiscoReason
DiscoNormalDisconnection forall a. Monoid a => a
mempty)
v311mask (PubACKPkt (PubACK Word16
x Word8
_ [Property]
_)) = PubACK -> MQTTPkt
PubACKPkt (Word16 -> Word8 -> [Property] -> PubACK
PubACK Word16
x Word8
0 forall a. Monoid a => a
mempty)
v311mask (PubRECPkt (PubREC Word16
x Word8
_ [Property]
_)) = PubREC -> MQTTPkt
PubRECPkt (Word16 -> Word8 -> [Property] -> PubREC
PubREC Word16
x Word8
0 forall a. Monoid a => a
mempty)
v311mask (PubRELPkt (PubREL Word16
x Word8
_ [Property]
_)) = PubREL -> MQTTPkt
PubRELPkt (Word16 -> Word8 -> [Property] -> PubREL
PubREL Word16
x Word8
0 forall a. Monoid a => a
mempty)
v311mask (PubCOMPPkt (PubCOMP Word16
x Word8
_ [Property]
_)) = PubCOMP -> MQTTPkt
PubCOMPPkt (Word16 -> Word8 -> [Property] -> PubCOMP
PubCOMP Word16
x Word8
0 forall a. Monoid a => a
mempty)
v311mask MQTTPkt
x = MQTTPkt
x

instance Arbitrary Topic where
  arbitrary :: Gen Topic
arbitrary = String -> (Int, Int) -> (Int, Int) -> Gen Topic
arbitraryTopic [Char
'a'..Char
'z'] (Int
1,Int
6) (Int
1,Int
6)

  shrink :: Topic -> [Topic]
shrink (Topic -> Text
unTopic -> Text
x) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Topic
mkTopic forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList Text -> [Text]
shrinkWord forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Text.splitOn Text
"/" Text
x
    where shrinkWord :: Text -> [Text]
shrinkWord = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

-- | An arbitrary Topic and an arbitrary Filter that should match it.
newtype MatchingTopic = MatchingTopic (Topic, [Filter]) deriving (MatchingTopic -> MatchingTopic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchingTopic -> MatchingTopic -> Bool
$c/= :: MatchingTopic -> MatchingTopic -> Bool
== :: MatchingTopic -> MatchingTopic -> Bool
$c== :: MatchingTopic -> MatchingTopic -> Bool
Eq, Int -> MatchingTopic -> ShowS
[MatchingTopic] -> ShowS
MatchingTopic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchingTopic] -> ShowS
$cshowList :: [MatchingTopic] -> ShowS
show :: MatchingTopic -> String
$cshow :: MatchingTopic -> String
showsPrec :: Int -> MatchingTopic -> ShowS
$cshowsPrec :: Int -> MatchingTopic -> ShowS
Show)

instance Arbitrary MatchingTopic where
  arbitrary :: Gen MatchingTopic
arbitrary = (Topic, [Filter]) -> MatchingTopic
MatchingTopic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (Int, Int) -> (Int, Int) -> (Int, Int) -> Gen (Topic, [Filter])
arbitraryMatchingTopic [Char
'a'..Char
'z'] (Int
1,Int
6) (Int
1,Int
6) (Int
1,Int
6)
  shrink :: MatchingTopic -> [MatchingTopic]
shrink (MatchingTopic (Topic
t,[Filter]
ms)) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Topic, [Filter]) -> MatchingTopic
MatchingTopic forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Topic
t,)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (forall a b. a -> b -> a
const []) forall a b. (a -> b) -> a -> b
$ [Filter]
ms

-- | Generate an arbitrary topic segment (e.g. the 'X' in 'a\/X\/b') of a
-- given length from the given alphabet.
arbitraryTopicSegment :: [Char] -> Int -> Gen Text
arbitraryTopicSegment :: String -> Int -> Gen Text
arbitraryTopicSegment String
alphabet Int
n = String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (forall a. [a] -> Gen a
elements String
alphabet)

-- | Generate an arbitrary Topic from the given alphabet with lengths
-- of segments and the segment count specified by the given ranges.
arbitraryTopic :: [Char] -> (Int,Int) -> (Int,Int) -> Gen Topic
arbitraryTopic :: String -> (Int, Int) -> (Int, Int) -> Gen Topic
arbitraryTopic String
alphabet (Int, Int)
seglen (Int, Int)
nsegs = Gen [Text]
someSegs forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` (Text -> Maybe Topic
mkTopic forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/")
    where someSegs :: Gen [Text]
someSegs = forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
nsegs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> Gen a -> Gen [a]
vectorOf Gen Text
aSeg
          aSeg :: Gen Text
aSeg = forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
seglen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Gen Text
arbitraryTopicSegment String
alphabet

-- | Generate an arbitrary topic similarly to arbitraryTopic as well
-- as some arbitrary filters that should match that topic.
arbitraryMatchingTopic :: [Char] -> (Int,Int) -> (Int,Int) -> (Int,Int) -> Gen (Topic, [Filter])
arbitraryMatchingTopic :: String
-> (Int, Int) -> (Int, Int) -> (Int, Int) -> Gen (Topic, [Filter])
arbitraryMatchingTopic String
alphabet (Int, Int)
seglen (Int, Int)
nsegs (Int, Int)
nfilts = do
    Topic
t <- String -> (Int, Int) -> (Int, Int) -> Gen Topic
arbitraryTopic String
alphabet (Int, Int)
seglen (Int, Int)
nsegs
    let tsegs :: [Text]
tsegs = Text -> Text -> [Text]
Text.splitOn Text
"/" (Topic -> Text
unTopic Topic
t)
    Int
fn <- forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
nfilts
    [[Text -> Text]]
reps <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
fn forall a b. (a -> b) -> a -> b
$ forall a. Int -> Gen a -> Gen [a]
vectorOf (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
tsegs) (forall a. [a] -> Gen a
elements [forall a. a -> a
id, forall a b. a -> b -> a
const Text
"+", forall a b. a -> b -> a
const Text
"#"])
    let m :: [Filter]
m = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Filter
mkFilter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => [a] -> [a]
clean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> (a -> b) -> b
(&) [Text]
tsegs) [[Text -> Text]]
reps
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Topic
t, [Filter]
m)
      where
        clean :: [a] -> [a]
clean []      = []
        clean (a
"#":[a]
_) = [a
"#"]
        clean (a
x:[a]
xs)  = a
x forall a. a -> [a] -> [a]
: [a] -> [a]
clean [a]
xs

-- | Generate an arbitrary Filter from the given alphabet with lengths
-- of segments and the segment count specified by the given ranges.
-- Segments may contain wildcards.
arbitraryFilter :: [Char] -> (Int,Int) -> (Int,Int) -> Gen Filter
arbitraryFilter :: String -> (Int, Int) -> (Int, Int) -> Gen Filter
arbitraryFilter String
alphabet (Int, Int)
seglen (Int, Int)
nsegs = Gen [Text]
someSegs forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` (Text -> Maybe Filter
mkFilter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/")
    where someSegs :: Gen [Text]
someSegs = forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
nsegs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> Gen a -> Gen [a]
vectorOf Gen Text
aSeg
          aSeg :: Gen Text
aSeg = forall a. [Gen a] -> Gen a
oneof [
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"+", forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"#",
            forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
seglen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Gen Text
arbitraryTopicSegment String
alphabet
            ]

instance Arbitrary Filter where
  arbitrary :: Gen Filter
arbitrary = String -> (Int, Int) -> (Int, Int) -> Gen Filter
arbitraryFilter [Char
'a'..Char
'z'] (Int
1,Int
6) (Int
1,Int
6)

  shrink :: Filter -> [Filter]
shrink (Filter -> Text
unFilter -> Text
x) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Filter
mkFilter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList Text -> [Text]
shrinkWord forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Text.splitOn Text
"/" Text
x
    where shrinkWord :: Text -> [Text]
shrinkWord = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack