{-|
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
(SizeT -> SizeT -> Bool) -> (SizeT -> SizeT -> Bool) -> Eq SizeT
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
(Int -> SizeT -> ShowS)
-> (SizeT -> String) -> ([SizeT] -> ShowS) -> Show SizeT
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 (Int -> SizeT) -> Gen Int -> Gen SizeT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Int] -> Gen Int
forall a. [Gen a] -> Gen a
oneof [ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
127),
                                (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
128, Int
16383),
                                (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
16384, Int
2097151),
                                (Int, Int) -> Gen Int
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 (Bool -> QoS -> ByteString -> ByteString -> [Property] -> LastWill)
-> Gen Bool
-> Gen (QoS -> ByteString -> ByteString -> [Property] -> LastWill)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen (QoS -> ByteString -> ByteString -> [Property] -> LastWill)
-> Gen QoS
-> Gen (ByteString -> ByteString -> [Property] -> LastWill)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen QoS
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> ByteString -> [Property] -> LastWill)
-> Gen ByteString -> Gen (ByteString -> [Property] -> LastWill)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
astr Gen (ByteString -> [Property] -> LastWill)
-> Gen ByteString -> Gen ([Property] -> LastWill)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
astr Gen ([Property] -> LastWill) -> Gen [Property] -> Gen LastWill
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Property]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ProtocolLevel where arbitrary :: Gen ProtocolLevel
arbitrary = Gen ProtocolLevel
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 <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    Word16
_keepAlive <- Gen Word16
forall a. Arbitrary a => Gen a
arbitrary
    Maybe LastWill
_lastWill <- Gen (Maybe LastWill)
forall a. Arbitrary a => Gen a
arbitrary
    [Property]
_connProperties <- Gen [Property]
forall a. Arbitrary a => Gen a
arbitrary

    ConnectRequest -> Gen ConnectRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectRequest :: Maybe ByteString
-> Maybe ByteString
-> Maybe LastWill
-> Bool
-> Word16
-> ByteString
-> [Property]
-> ConnectRequest
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 = (UnicodeString -> ByteString)
-> Maybe UnicodeString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (UnicodeString -> ByteString) -> UnicodeString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack (String -> ByteString)
-> (UnicodeString -> String) -> UnicodeString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeString -> String
getUnicodeString) (Maybe UnicodeString -> Maybe ByteString)
-> Gen (Maybe UnicodeString) -> Gen (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe UnicodeString)
forall a. Arbitrary a => Gen a
arbitrary

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

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

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

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

instance Arbitrary PublishRequest where
  arbitrary :: Gen PublishRequest
arbitrary = do
    Bool
_pubDup <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    QoS
_pubQoS <- Gen QoS
forall a. Arbitrary a => Gen a
arbitrary
    Bool
_pubRetain <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    ByteString
_pubTopic <- Gen ByteString
astr
    Word16
_pubPktID <- if QoS
_pubQoS QoS -> QoS -> Bool
forall a. Eq a => a -> a -> Bool
== QoS
QoS0 then Word16 -> Gen Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
0 else Gen Word16
forall a. Arbitrary a => Gen a
arbitrary
    ByteString
_pubBody <- Gen ByteString
astr
    [Property]
_pubProps <- Gen [Property]
forall a. Arbitrary a => Gen a
arbitrary
    PublishRequest -> Gen PublishRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure PublishRequest :: Bool
-> QoS
-> Bool
-> ByteString
-> Word16
-> ByteString
-> [Property]
-> PublishRequest
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 (Word16 -> Word8 -> [Property] -> PubACK)
-> Gen Word16 -> Gen (Word8 -> [Property] -> PubACK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word16
forall a. Arbitrary a => Gen a
arbitrary Gen (Word8 -> [Property] -> PubACK)
-> Gen Word8 -> Gen ([Property] -> PubACK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word8
forall a. Arbitrary a => Gen a
arbitrary Gen ([Property] -> PubACK) -> Gen [Property] -> Gen PubACK
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Property]
forall a. Arbitrary a => Gen a
arbitrary

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Arbitrary MQTTPkt where
  arbitrary :: Gen MQTTPkt
arbitrary = [Gen MQTTPkt] -> Gen MQTTPkt
forall a. [Gen a] -> Gen a
oneof [
    ConnectRequest -> ProtocolLevel -> MQTTPkt
ConnPkt (ConnectRequest -> ProtocolLevel -> MQTTPkt)
-> Gen ConnectRequest -> Gen (ProtocolLevel -> MQTTPkt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ConnectRequest
forall a. Arbitrary a => Gen a
arbitrary Gen (ProtocolLevel -> MQTTPkt) -> Gen ProtocolLevel -> Gen MQTTPkt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolLevel -> Gen ProtocolLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProtocolLevel
Protocol50,
    ConnACKFlags -> MQTTPkt
ConnACKPkt (ConnACKFlags -> MQTTPkt) -> Gen ConnACKFlags -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ConnACKFlags
forall a. Arbitrary a => Gen a
arbitrary,
    PublishRequest -> MQTTPkt
PublishPkt (PublishRequest -> MQTTPkt) -> Gen PublishRequest -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PublishRequest
forall a. Arbitrary a => Gen a
arbitrary,
    PubACK -> MQTTPkt
PubACKPkt (PubACK -> MQTTPkt) -> Gen PubACK -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PubACK
forall a. Arbitrary a => Gen a
arbitrary,
    PubREL -> MQTTPkt
PubRELPkt (PubREL -> MQTTPkt) -> Gen PubREL -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PubREL
forall a. Arbitrary a => Gen a
arbitrary,
    PubREC -> MQTTPkt
PubRECPkt (PubREC -> MQTTPkt) -> Gen PubREC -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PubREC
forall a. Arbitrary a => Gen a
arbitrary,
    PubCOMP -> MQTTPkt
PubCOMPPkt (PubCOMP -> MQTTPkt) -> Gen PubCOMP -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PubCOMP
forall a. Arbitrary a => Gen a
arbitrary,
    SubscribeRequest -> MQTTPkt
SubscribePkt (SubscribeRequest -> MQTTPkt)
-> Gen SubscribeRequest -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SubscribeRequest
forall a. Arbitrary a => Gen a
arbitrary,
    SubscribeResponse -> MQTTPkt
SubACKPkt (SubscribeResponse -> MQTTPkt)
-> Gen SubscribeResponse -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SubscribeResponse
forall a. Arbitrary a => Gen a
arbitrary,
    UnsubscribeRequest -> MQTTPkt
UnsubscribePkt (UnsubscribeRequest -> MQTTPkt)
-> Gen UnsubscribeRequest -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UnsubscribeRequest
forall a. Arbitrary a => Gen a
arbitrary,
    UnsubscribeResponse -> MQTTPkt
UnsubACKPkt (UnsubscribeResponse -> MQTTPkt)
-> Gen UnsubscribeResponse -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UnsubscribeResponse
forall a. Arbitrary a => Gen a
arbitrary,
    MQTTPkt -> Gen MQTTPkt
forall (f :: * -> *) a. Applicative f => a -> f a
pure MQTTPkt
PingPkt, MQTTPkt -> Gen MQTTPkt
forall (f :: * -> *) a. Applicative f => a -> f a
pure MQTTPkt
PongPkt,
    DisconnectRequest -> MQTTPkt
DisconnectPkt (DisconnectRequest -> MQTTPkt)
-> Gen DisconnectRequest -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DisconnectRequest
forall a. Arbitrary a => Gen a
arbitrary,
    AuthRequest -> MQTTPkt
AuthPkt (AuthRequest -> MQTTPkt) -> Gen AuthRequest -> Gen MQTTPkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AuthRequest
forall a. Arbitrary a => Gen a
arbitrary
    ]
  shrink :: MQTTPkt -> [MQTTPkt]
shrink (SubACKPkt SubscribeResponse
x)      = SubscribeResponse -> MQTTPkt
SubACKPkt (SubscribeResponse -> MQTTPkt) -> [SubscribeResponse] -> [MQTTPkt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubscribeResponse -> [SubscribeResponse]
forall a. Arbitrary a => a -> [a]
shrink SubscribeResponse
x
  shrink (ConnACKPkt ConnACKFlags
x)     = ConnACKFlags -> MQTTPkt
ConnACKPkt (ConnACKFlags -> MQTTPkt) -> [ConnACKFlags] -> [MQTTPkt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnACKFlags -> [ConnACKFlags]
forall a. Arbitrary a => a -> [a]
shrink ConnACKFlags
x
  shrink (UnsubscribePkt UnsubscribeRequest
x) = UnsubscribeRequest -> MQTTPkt
UnsubscribePkt (UnsubscribeRequest -> MQTTPkt)
-> [UnsubscribeRequest] -> [MQTTPkt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsubscribeRequest -> [UnsubscribeRequest]
forall a. Arbitrary a => a -> [a]
shrink UnsubscribeRequest
x
  shrink (SubscribePkt SubscribeRequest
x)   = SubscribeRequest -> MQTTPkt
SubscribePkt (SubscribeRequest -> MQTTPkt) -> [SubscribeRequest] -> [MQTTPkt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubscribeRequest -> [SubscribeRequest]
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=[Property]
forall a. Monoid a => a
mempty,
                                                       _password :: Maybe ByteString
_password=Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall a a. Maybe a -> Maybe a -> Maybe a
mpw Maybe ByteString
_username Maybe ByteString
_password,
                                                       _lastWill :: Maybe LastWill
_lastWill=LastWill -> LastWill
cl (LastWill -> LastWill) -> Maybe LastWill -> Maybe LastWill
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=[Property]
forall a. Monoid a => a
mempty}
        mpw :: Maybe a -> Maybe a -> Maybe a
mpw Maybe a
Nothing Maybe a
_ = 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 [Property]
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 [Property]
forall a. Monoid a => a
mempty)
  where c :: [(ByteString, SubOptions)]
c = ((ByteString, SubOptions) -> (ByteString, SubOptions))
-> [(ByteString, SubOptions)] -> [(ByteString, SubOptions)]
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 [Property]
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 [Property]
forall a. Monoid a => a
mempty)
v311mask (UnsubACKPkt (UnsubscribeResponse Word16
p [Property]
_ [UnsubStatus]
_)) = UnsubscribeResponse -> MQTTPkt
UnsubACKPkt (Word16 -> [Property] -> [UnsubStatus] -> UnsubscribeResponse
UnsubscribeResponse Word16
p [Property]
forall a. Monoid a => a
mempty [UnsubStatus]
forall a. Monoid a => a
mempty)
v311mask (PublishPkt PublishRequest
req) = PublishRequest -> MQTTPkt
PublishPkt PublishRequest
req{_pubProps :: [Property]
_pubProps=[Property]
forall a. Monoid a => a
mempty}
v311mask (DisconnectPkt DisconnectRequest
_) = DisconnectRequest -> MQTTPkt
DisconnectPkt (DiscoReason -> [Property] -> DisconnectRequest
DisconnectRequest DiscoReason
DiscoNormalDisconnection [Property]
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 [Property]
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 [Property]
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 [Property]
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 [Property]
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) = ([Text] -> Maybe Topic) -> [[Text]] -> [Topic]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Topic
mkTopic (Text -> Maybe Topic) -> ([Text] -> Text) -> [Text] -> Maybe Topic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/") ([[Text]] -> [Topic]) -> ([Text] -> [[Text]]) -> [Text] -> [Topic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList Text -> [Text]
shrinkWord ([Text] -> [Topic]) -> [Text] -> [Topic]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Text.splitOn Text
"/" Text
x
    where shrinkWord :: Text -> [Text]
shrinkWord = (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack ([String] -> [Text]) -> (Text -> [String]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. Arbitrary a => a -> [a]
shrink (String -> [String]) -> (Text -> String) -> Text -> [String]
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
(MatchingTopic -> MatchingTopic -> Bool)
-> (MatchingTopic -> MatchingTopic -> Bool) -> Eq MatchingTopic
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
(Int -> MatchingTopic -> ShowS)
-> (MatchingTopic -> String)
-> ([MatchingTopic] -> ShowS)
-> Show MatchingTopic
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 ((Topic, [Filter]) -> MatchingTopic)
-> Gen (Topic, [Filter]) -> Gen 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)) = ([Filter] -> MatchingTopic) -> [[Filter]] -> [MatchingTopic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Topic, [Filter]) -> MatchingTopic
MatchingTopic ((Topic, [Filter]) -> MatchingTopic)
-> ([Filter] -> (Topic, [Filter])) -> [Filter] -> MatchingTopic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Topic
t,)) ([[Filter]] -> [MatchingTopic])
-> ([Filter] -> [[Filter]]) -> [Filter] -> [MatchingTopic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Filter -> [Filter]) -> [Filter] -> [[Filter]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList ([Filter] -> Filter -> [Filter]
forall a b. a -> b -> a
const []) ([Filter] -> [MatchingTopic]) -> [Filter] -> [MatchingTopic]
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 (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen String
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (String -> Gen Char
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 Gen [Text] -> ([Text] -> Maybe Topic) -> Gen Topic
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` (Text -> Maybe Topic
mkTopic (Text -> Maybe Topic) -> ([Text] -> Text) -> [Text] -> Maybe Topic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/")
    where someSegs :: Gen [Text]
someSegs = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
nsegs Gen Int -> (Int -> Gen [Text]) -> Gen [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Gen Text -> Gen [Text]) -> Gen Text -> Int -> Gen [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Gen Text -> Gen [Text]
forall a. Int -> Gen a -> Gen [a]
vectorOf Gen Text
aSeg
          aSeg :: Gen Text
aSeg = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
seglen Gen Int -> (Int -> Gen Text) -> Gen Text
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 <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
nfilts
    [[Text -> Text]]
reps <- Int -> Gen [Text -> Text] -> Gen [[Text -> Text]]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
fn (Gen [Text -> Text] -> Gen [[Text -> Text]])
-> Gen [Text -> Text] -> Gen [[Text -> Text]]
forall a b. (a -> b) -> a -> b
$ Int -> Gen (Text -> Text) -> Gen [Text -> Text]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
tsegs) ([Text -> Text] -> Gen (Text -> Text)
forall a. [a] -> Gen a
elements [Text -> Text
forall a. a -> a
id, Text -> Text -> Text
forall a b. a -> b -> a
const Text
"+", Text -> Text -> Text
forall a b. a -> b -> a
const Text
"#"])
    let m :: [Filter]
m = ([Text -> Text] -> Maybe Filter) -> [[Text -> Text]] -> [Filter]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Filter
mkFilter (Text -> Maybe Filter)
-> ([Text -> Text] -> Text) -> [Text -> Text] -> Maybe Filter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/" ([Text] -> Text)
-> ([Text -> Text] -> [Text]) -> [Text -> Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. (Eq a, IsString a) => [a] -> [a]
clean ([Text] -> [Text])
-> ([Text -> Text] -> [Text]) -> [Text -> Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (Text -> Text) -> Text)
-> [Text] -> [Text -> Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
(&) [Text]
tsegs) [[Text -> Text]]
reps
    (Topic, [Filter]) -> Gen (Topic, [Filter])
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 a -> [a] -> [a]
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 Gen [Text] -> ([Text] -> Maybe Filter) -> Gen Filter
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` (Text -> Maybe Filter
mkFilter (Text -> Maybe Filter)
-> ([Text] -> Text) -> [Text] -> Maybe Filter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/")
    where someSegs :: Gen [Text]
someSegs = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
nsegs Gen Int -> (Int -> Gen [Text]) -> Gen [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Gen Text -> Gen [Text]) -> Gen Text -> Int -> Gen [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Gen Text -> Gen [Text]
forall a. Int -> Gen a -> Gen [a]
vectorOf Gen Text
aSeg
          aSeg :: Gen Text
aSeg = [Gen Text] -> Gen Text
forall a. [Gen a] -> Gen a
oneof [
            Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"+", Text -> Gen Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"#",
            (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int, Int)
seglen Gen Int -> (Int -> Gen Text) -> Gen Text
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) = ([Text] -> Maybe Filter) -> [[Text]] -> [Filter]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Filter
mkFilter (Text -> Maybe Filter)
-> ([Text] -> Text) -> [Text] -> Maybe Filter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"/") ([[Text]] -> [Filter])
-> ([Text] -> [[Text]]) -> [Text] -> [Filter]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList Text -> [Text]
shrinkWord ([Text] -> [Filter]) -> [Text] -> [Filter]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
Text.splitOn Text
"/" Text
x
    where shrinkWord :: Text -> [Text]
shrinkWord = (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack ([String] -> [Text]) -> (Text -> [String]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. Arbitrary a => a -> [a]
shrink (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack