{-|
Module      : Network.MQTT.Types
Description : Parsers and serializers for MQTT.
Copyright   : (c) Dustin Sallings, 2019
License     : BSD3
Maintainer  : dustin@spy.net
Stability   : experimental

MQTT Types.
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Network.MQTT.Types (
  LastWill(..), MQTTPkt(..), QoS(..), qosFromInt,
  ConnectRequest(..), connectRequest, SessionReuse(..), ConnACKFlags(..), ConnACKRC(..),
  PublishRequest(..), PubACK(..), PubREC(..), PubREL(..), PubCOMP(..),
  ProtocolLevel(..), Property(..), AuthRequest(..),
  SubscribeRequest(..), SubOptions(..), subOptions, SubscribeResponse(..), SubErr(..),
  RetainHandling(..), DisconnectRequest(..),
  UnsubscribeRequest(..), UnsubscribeResponse(..), UnsubStatus(..), DiscoReason(..),
  PktID,
  parsePacket, ByteMe(toByteString), parseConnect,
  -- for testing
  encodeLength, parseHdrLen, parseProperty, parseProperties, bsProps,
  parseSubOptions, ByteSize(..)
  ) where

import           Control.Applicative             (liftA2, (<|>))
import           Control.Monad                   (replicateM, when)
import           Data.Attoparsec.Binary          (anyWord16be, anyWord32be)
import qualified Data.Attoparsec.ByteString      as AS
import qualified Data.Attoparsec.ByteString.Lazy as A
import           Data.Binary.Put                 (putWord32be, runPut)
import           Data.Bits                       (Bits (..), shiftL, testBit, (.&.), (.|.))
import qualified Data.ByteString.Lazy            as BL
import           Data.Functor                    (($>))
import           Data.Maybe                      (fromMaybe, isJust)
import           Data.Word                       (Word16, Word32, Word8)

-- | QoS values for publishing and subscribing.
data QoS = QoS0 | QoS1 | QoS2 deriving (QoS
forall a. a -> a -> Bounded a
maxBound :: QoS
$cmaxBound :: QoS
minBound :: QoS
$cminBound :: QoS
Bounded, Int -> QoS
QoS -> Int
QoS -> [QoS]
QoS -> QoS
QoS -> QoS -> [QoS]
QoS -> QoS -> QoS -> [QoS]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QoS -> QoS -> QoS -> [QoS]
$cenumFromThenTo :: QoS -> QoS -> QoS -> [QoS]
enumFromTo :: QoS -> QoS -> [QoS]
$cenumFromTo :: QoS -> QoS -> [QoS]
enumFromThen :: QoS -> QoS -> [QoS]
$cenumFromThen :: QoS -> QoS -> [QoS]
enumFrom :: QoS -> [QoS]
$cenumFrom :: QoS -> [QoS]
fromEnum :: QoS -> Int
$cfromEnum :: QoS -> Int
toEnum :: Int -> QoS
$ctoEnum :: Int -> QoS
pred :: QoS -> QoS
$cpred :: QoS -> QoS
succ :: QoS -> QoS
$csucc :: QoS -> QoS
Enum, QoS -> QoS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QoS -> QoS -> Bool
$c/= :: QoS -> QoS -> Bool
== :: QoS -> QoS -> Bool
$c== :: QoS -> QoS -> Bool
Eq, Int -> QoS -> ShowS
[QoS] -> ShowS
QoS -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QoS] -> ShowS
$cshowList :: [QoS] -> ShowS
show :: QoS -> [Char]
$cshow :: QoS -> [Char]
showsPrec :: Int -> QoS -> ShowS
$cshowsPrec :: Int -> QoS -> ShowS
Show, Eq QoS
QoS -> QoS -> Bool
QoS -> QoS -> Ordering
QoS -> QoS -> QoS
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QoS -> QoS -> QoS
$cmin :: QoS -> QoS -> QoS
max :: QoS -> QoS -> QoS
$cmax :: QoS -> QoS -> QoS
>= :: QoS -> QoS -> Bool
$c>= :: QoS -> QoS -> Bool
> :: QoS -> QoS -> Bool
$c> :: QoS -> QoS -> Bool
<= :: QoS -> QoS -> Bool
$c<= :: QoS -> QoS -> Bool
< :: QoS -> QoS -> Bool
$c< :: QoS -> QoS -> Bool
compare :: QoS -> QoS -> Ordering
$ccompare :: QoS -> QoS -> Ordering
Ord)

qosW :: QoS -> Word8
qosW :: QoS -> Word8
qosW = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

wQos :: Word8 -> QoS
wQos :: Word8 -> QoS
wQos = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Parse a valid QoS value from an Int.
qosFromInt :: Int -> Maybe QoS
qosFromInt :: Int -> Maybe QoS
qosFromInt Int
0 = forall a. a -> Maybe a
Just QoS
QoS0
qosFromInt Int
1 = forall a. a -> Maybe a
Just QoS
QoS1
qosFromInt Int
2 = forall a. a -> Maybe a
Just QoS
QoS2
qosFromInt Int
_ = forall a. Maybe a
Nothing

(≫) :: Bits a => a -> Int -> a
≫ :: forall a. Bits a => a -> Int -> a
(≫) = forall a. Bits a => a -> Int -> a
shiftR

(≪) :: Bits a => a -> Int -> a
≪ :: forall a. Bits a => a -> Int -> a
(≪) = forall a. Bits a => a -> Int -> a
shiftL

class ByteMe a where
  toBytes :: ProtocolLevel -> a -> [Word8]
  toBytes ProtocolLevel
p = ByteString -> [Word8]
BL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p

  toByteString :: ProtocolLevel -> a -> BL.ByteString
  toByteString ProtocolLevel
p = [Word8] -> ByteString
BL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteMe a => ProtocolLevel -> a -> [Word8]
toBytes ProtocolLevel
p

class ByteSize a where
  toByte :: a -> Word8
  fromByte :: Word8 -> a

boolBit :: Bool -> Word8
boolBit :: Bool -> Word8
boolBit Bool
False = Word8
0
boolBit Bool
True  = Word8
1

parseHdrLen :: A.Parser Int
parseHdrLen :: Parser Int
parseHdrLen = Parser Int
decodeVarInt

decodeVarInt :: A.Parser Int
decodeVarInt :: Parser Int
decodeVarInt = Int -> Int -> Parser Int
go Int
0 Int
1
  where
    go :: Int -> Int -> A.Parser Int
    go :: Int -> Int -> Parser Int
go Int
v Int
m = do
      Word8
x <- Parser Word8
A.anyWord8
      let a :: Int
a = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
127) forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
+ Int
v
      if Word8
x forall a. Bits a => a -> a -> a
.&. Word8
128 forall a. Eq a => a -> a -> Bool
/= Word8
0
        then Int -> Int -> Parser Int
go Int
a (Int
mforall a. Num a => a -> a -> a
*Int
128)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
a

encodeLength :: Int -> [Word8]
encodeLength :: Int -> [Word8]
encodeLength = Int -> [Word8]
encodeVarInt

encodeVarInt :: Int -> [Word8]
encodeVarInt :: Int -> [Word8]
encodeVarInt Int
n = (Int, Int) -> [Word8]
go (Int
n forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
128)
  where
    go :: (Int, Int) -> [Word8]
go (Int
x,Int
e)
      | Int
x forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Word8
en (Int
e forall a. Bits a => a -> a -> a
.|. Int
128) forall a. a -> [a] -> [a]
: (Int, Int) -> [Word8]
go (Int
x forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
128)
      | Bool
otherwise = [Int -> Word8
en Int
e]

    en :: Int -> Word8
    en :: Int -> Word8
en = forall a. Enum a => Int -> a
toEnum

encodeWord8 :: Word8 -> BL.ByteString
encodeWord8 :: Word8 -> ByteString
encodeWord8 = Word8 -> ByteString
BL.singleton

encodeWord16 :: Word16 -> BL.ByteString
encodeWord16 :: Word16 -> ByteString
encodeWord16 Word16
a = let (Word16
h,Word16
l) = Word16
a forall a. Integral a => a -> a -> (a, a)
`quotRem` Word16
256 in [Word8] -> ByteString
BL.pack [Word16 -> Word8
w Word16
h, Word16 -> Word8
w Word16
l]
    where w :: Word16 -> Word8
w = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

encodeWord32 :: Word32 -> BL.ByteString
encodeWord32 :: Word32 -> ByteString
encodeWord32 = Put -> ByteString
runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Put
putWord32be

encodeBytes :: BL.ByteString -> BL.ByteString
encodeBytes :: ByteString -> ByteString
encodeBytes ByteString
x = ByteString -> ByteString
twoByteLen ByteString
x forall a. Semigroup a => a -> a -> a
<> ByteString
x

encodeUTF8 :: BL.ByteString -> BL.ByteString
encodeUTF8 :: ByteString -> ByteString
encodeUTF8 = ByteString -> ByteString
encodeBytes

encodeUTF8Pair :: BL.ByteString -> BL.ByteString -> BL.ByteString
encodeUTF8Pair :: ByteString -> ByteString -> ByteString
encodeUTF8Pair ByteString
x ByteString
y = ByteString -> ByteString
encodeUTF8 ByteString
x forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
encodeUTF8 ByteString
y

twoByteLen :: BL.ByteString -> BL.ByteString
twoByteLen :: ByteString -> ByteString
twoByteLen = Word16 -> ByteString
encodeWord16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length

blLength :: BL.ByteString -> BL.ByteString
blLength :: ByteString -> ByteString
blLength = [Word8] -> ByteString
BL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8]
encodeVarInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length

withLength :: BL.ByteString -> BL.ByteString
withLength :: ByteString -> ByteString
withLength ByteString
a = ByteString -> ByteString
blLength ByteString
a forall a. Semigroup a => a -> a -> a
<> ByteString
a

instance ByteMe BL.ByteString where
  toByteString :: ProtocolLevel -> ByteString -> ByteString
toByteString ProtocolLevel
_ ByteString
a = (Word16 -> ByteString
encodeWord16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length) ByteString
a forall a. Semigroup a => a -> a -> a
<> ByteString
a

-- | Property represents the various MQTT Properties that may sent or
-- received along with packets in MQTT 5.  For detailed use on when
-- and where to use them, consult with the MQTT 5.0 spec.
data Property = PropPayloadFormatIndicator Word8
              | PropMessageExpiryInterval Word32
              | PropContentType BL.ByteString
              | PropResponseTopic BL.ByteString
              | PropCorrelationData BL.ByteString
              | PropSubscriptionIdentifier Int
              | PropSessionExpiryInterval Word32
              | PropAssignedClientIdentifier BL.ByteString
              | PropServerKeepAlive Word16
              | PropAuthenticationMethod BL.ByteString
              | PropAuthenticationData BL.ByteString
              | PropRequestProblemInformation Word8
              | PropWillDelayInterval Word32
              | PropRequestResponseInformation Word8
              | PropResponseInformation BL.ByteString
              | PropServerReference BL.ByteString
              | PropReasonString BL.ByteString
              | PropReceiveMaximum Word16
              | PropTopicAliasMaximum Word16
              | PropTopicAlias Word16
              | PropMaximumQoS Word8
              | PropRetainAvailable Word8
              | PropUserProperty BL.ByteString BL.ByteString
              | PropMaximumPacketSize Word32
              | PropWildcardSubscriptionAvailable Word8
              | PropSubscriptionIdentifierAvailable Word8
              | PropSharedSubscriptionAvailable Word8
              deriving (Int -> Property -> ShowS
[Property] -> ShowS
Property -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> [Char]
$cshow :: Property -> [Char]
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show, Property -> Property -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq)

peW8 :: Word8 -> Word8 -> BL.ByteString
peW8 :: Word8 -> Word8 -> ByteString
peW8 Word8
i Word8
x = Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
encodeWord8 Word8
x

peW16 :: Word8 -> Word16 -> BL.ByteString
peW16 :: Word8 -> Word16 -> ByteString
peW16 Word8
i Word16
x = Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
encodeWord16 Word16
x

peW32 :: Word8 -> Word32 -> BL.ByteString
peW32 :: Word8 -> Word32 -> ByteString
peW32 Word8
i Word32
x = Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
encodeWord32 Word32
x

peUTF8 :: Word8 -> BL.ByteString -> BL.ByteString
peUTF8 :: Word8 -> ByteString -> ByteString
peUTF8 Word8
i ByteString
x = Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
encodeUTF8 ByteString
x

peBin :: Word8 -> BL.ByteString -> BL.ByteString
peBin :: Word8 -> ByteString -> ByteString
peBin Word8
i ByteString
x = Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
encodeBytes ByteString
x

peVarInt :: Word8 -> Int -> BL.ByteString
peVarInt :: Word8 -> Int -> ByteString
peVarInt Word8
i Int
x = Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> ([Word8] -> ByteString
BL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8]
encodeVarInt) Int
x

instance ByteMe Property where
  toByteString :: ProtocolLevel -> Property -> ByteString
toByteString ProtocolLevel
_ (PropPayloadFormatIndicator Word8
x)          = Word8 -> Word8 -> ByteString
peW8 Word8
0x01 Word8
x

  toByteString ProtocolLevel
_ (PropMessageExpiryInterval Word32
x)           = Word8 -> Word32 -> ByteString
peW32 Word8
0x02 Word32
x

  toByteString ProtocolLevel
_ (PropContentType ByteString
x)                     = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x03 ByteString
x

  toByteString ProtocolLevel
_ (PropResponseTopic ByteString
x)                   = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x08 ByteString
x

  toByteString ProtocolLevel
_ (PropCorrelationData ByteString
x)                 = Word8 -> ByteString -> ByteString
peBin Word8
0x09 ByteString
x

  toByteString ProtocolLevel
_ (PropSubscriptionIdentifier Int
x)          = Word8 -> Int -> ByteString
peVarInt Word8
0x0b Int
x

  toByteString ProtocolLevel
_ (PropSessionExpiryInterval Word32
x)           = Word8 -> Word32 -> ByteString
peW32 Word8
0x11 Word32
x

  toByteString ProtocolLevel
_ (PropAssignedClientIdentifier ByteString
x)        = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x12 ByteString
x

  toByteString ProtocolLevel
_ (PropServerKeepAlive Word16
x)                 = Word8 -> Word16 -> ByteString
peW16 Word8
0x13 Word16
x

  toByteString ProtocolLevel
_ (PropAuthenticationMethod ByteString
x)            = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x15 ByteString
x

  toByteString ProtocolLevel
_ (PropAuthenticationData ByteString
x)              = Word8 -> ByteString -> ByteString
peBin Word8
0x16 ByteString
x

  toByteString ProtocolLevel
_ (PropRequestProblemInformation Word8
x)       = Word8 -> Word8 -> ByteString
peW8 Word8
0x17 Word8
x

  toByteString ProtocolLevel
_ (PropWillDelayInterval Word32
x)               = Word8 -> Word32 -> ByteString
peW32 Word8
0x18 Word32
x

  toByteString ProtocolLevel
_ (PropRequestResponseInformation Word8
x)      = Word8 -> Word8 -> ByteString
peW8 Word8
0x19 Word8
x

  toByteString ProtocolLevel
_ (PropResponseInformation ByteString
x)             = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x1a ByteString
x

  toByteString ProtocolLevel
_ (PropServerReference ByteString
x)                 = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x1c ByteString
x

  toByteString ProtocolLevel
_ (PropReasonString ByteString
x)                    = Word8 -> ByteString -> ByteString
peUTF8 Word8
0x1f ByteString
x

  toByteString ProtocolLevel
_ (PropReceiveMaximum Word16
x)                  = Word8 -> Word16 -> ByteString
peW16 Word8
0x21 Word16
x

  toByteString ProtocolLevel
_ (PropTopicAliasMaximum Word16
x)               = Word8 -> Word16 -> ByteString
peW16 Word8
0x22 Word16
x

  toByteString ProtocolLevel
_ (PropTopicAlias Word16
x)                      = Word8 -> Word16 -> ByteString
peW16 Word8
0x23 Word16
x

  toByteString ProtocolLevel
_ (PropMaximumQoS Word8
x)                      = Word8 -> Word8 -> ByteString
peW8 Word8
0x24 Word8
x

  toByteString ProtocolLevel
_ (PropRetainAvailable Word8
x)                 = Word8 -> Word8 -> ByteString
peW8 Word8
0x25 Word8
x

  toByteString ProtocolLevel
_ (PropUserProperty ByteString
k ByteString
v)                  = Word8 -> ByteString
BL.singleton Word8
0x26 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> ByteString
encodeUTF8Pair ByteString
k ByteString
v

  toByteString ProtocolLevel
_ (PropMaximumPacketSize Word32
x)               = Word8 -> Word32 -> ByteString
peW32 Word8
0x27 Word32
x

  toByteString ProtocolLevel
_ (PropWildcardSubscriptionAvailable Word8
x)   = Word8 -> Word8 -> ByteString
peW8 Word8
0x28 Word8
x

  toByteString ProtocolLevel
_ (PropSubscriptionIdentifierAvailable Word8
x) = Word8 -> Word8 -> ByteString
peW8 Word8
0x29 Word8
x

  toByteString ProtocolLevel
_ (PropSharedSubscriptionAvailable Word8
x)     = Word8 -> Word8 -> ByteString
peW8 Word8
0x2a Word8
x

parseProperty :: A.Parser Property
parseProperty :: Parser Property
parseProperty = (Word8 -> Parser Word8
A.word8 Word8
0x01 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropPayloadFormatIndicator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x02 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Property
PropMessageExpiryInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
aWord32)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x03 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropContentType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x08 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropResponseTopic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x09 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropCorrelationData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x0b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Property
PropSubscriptionIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
decodeVarInt)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x11 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Property
PropSessionExpiryInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
aWord32)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x12 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropAssignedClientIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x13 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Property
PropServerKeepAlive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
aWord16)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x15 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropAuthenticationMethod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x16 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropAuthenticationData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x17 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropRequestProblemInformation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x18 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Property
PropWillDelayInterval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
aWord32)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x19 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropRequestResponseInformation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x1a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropResponseInformation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x1c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropServerReference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x1f forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Property
PropReasonString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x21 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Property
PropReceiveMaximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
aWord16)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x22 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Property
PropTopicAliasMaximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
aWord16)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x23 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Property
PropTopicAlias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
aWord16)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x24 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropMaximumQoS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x25 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropRetainAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x26 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> ByteString -> Property
PropUserProperty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
aString)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x27 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Property
PropMaximumPacketSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
aWord32)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x28 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropWildcardSubscriptionAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x29 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropSubscriptionIdentifierAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser Word8
A.word8 Word8
0x2a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Property
PropSharedSubscriptionAvailable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)

bsProps :: ProtocolLevel -> [Property] -> BL.ByteString
bsProps :: ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
Protocol311 [Property]
_ = forall a. Monoid a => a
mempty
bsProps ProtocolLevel
p [Property]
l = let b :: ByteString
b = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p) [Property]
l in
                ([Word8] -> ByteString
BL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8]
encodeLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length) ByteString
b forall a. Semigroup a => a -> a -> a
<> ByteString
b

parseProperties :: ProtocolLevel -> A.Parser [Property]
parseProperties :: ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol311 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
parseProperties ProtocolLevel
Protocol50 = do
  Int
len <- Parser Int
decodeVarInt
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
AS.parseOnly (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' Parser Property
parseProperty) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Parser ByteString
A.take Int
len

-- | MQTT Protocol Levels
data ProtocolLevel = Protocol311 -- ^ MQTT 3.1.1
                   | Protocol50  -- ^ MQTT 5.0
                   deriving(ProtocolLevel
forall a. a -> a -> Bounded a
maxBound :: ProtocolLevel
$cmaxBound :: ProtocolLevel
minBound :: ProtocolLevel
$cminBound :: ProtocolLevel
Bounded, Int -> ProtocolLevel
ProtocolLevel -> Int
ProtocolLevel -> [ProtocolLevel]
ProtocolLevel -> ProtocolLevel
ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
ProtocolLevel -> ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ProtocolLevel -> ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
$cenumFromThenTo :: ProtocolLevel -> ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
enumFromTo :: ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
$cenumFromTo :: ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
enumFromThen :: ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
$cenumFromThen :: ProtocolLevel -> ProtocolLevel -> [ProtocolLevel]
enumFrom :: ProtocolLevel -> [ProtocolLevel]
$cenumFrom :: ProtocolLevel -> [ProtocolLevel]
fromEnum :: ProtocolLevel -> Int
$cfromEnum :: ProtocolLevel -> Int
toEnum :: Int -> ProtocolLevel
$ctoEnum :: Int -> ProtocolLevel
pred :: ProtocolLevel -> ProtocolLevel
$cpred :: ProtocolLevel -> ProtocolLevel
succ :: ProtocolLevel -> ProtocolLevel
$csucc :: ProtocolLevel -> ProtocolLevel
Enum, ProtocolLevel -> ProtocolLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolLevel -> ProtocolLevel -> Bool
$c/= :: ProtocolLevel -> ProtocolLevel -> Bool
== :: ProtocolLevel -> ProtocolLevel -> Bool
$c== :: ProtocolLevel -> ProtocolLevel -> Bool
Eq, Int -> ProtocolLevel -> ShowS
[ProtocolLevel] -> ShowS
ProtocolLevel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolLevel] -> ShowS
$cshowList :: [ProtocolLevel] -> ShowS
show :: ProtocolLevel -> [Char]
$cshow :: ProtocolLevel -> [Char]
showsPrec :: Int -> ProtocolLevel -> ShowS
$cshowsPrec :: Int -> ProtocolLevel -> ShowS
Show)

instance ByteMe ProtocolLevel where
  toByteString :: ProtocolLevel -> ProtocolLevel -> ByteString
toByteString ProtocolLevel
_ ProtocolLevel
Protocol311 = Word8 -> ByteString
BL.singleton Word8
4
  toByteString ProtocolLevel
_ ProtocolLevel
Protocol50  = Word8 -> ByteString
BL.singleton Word8
5

-- | An MQTT Will message.
data LastWill = LastWill {
  LastWill -> Bool
_willRetain  :: Bool
  , LastWill -> QoS
_willQoS   :: QoS
  , LastWill -> ByteString
_willTopic :: BL.ByteString
  , LastWill -> ByteString
_willMsg   :: BL.ByteString
  , LastWill -> [Property]
_willProps :: [Property]
  } deriving(LastWill -> LastWill -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LastWill -> LastWill -> Bool
$c/= :: LastWill -> LastWill -> Bool
== :: LastWill -> LastWill -> Bool
$c== :: LastWill -> LastWill -> Bool
Eq, Int -> LastWill -> ShowS
[LastWill] -> ShowS
LastWill -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LastWill] -> ShowS
$cshowList :: [LastWill] -> ShowS
show :: LastWill -> [Char]
$cshow :: LastWill -> [Char]
showsPrec :: Int -> LastWill -> ShowS
$cshowsPrec :: Int -> LastWill -> ShowS
Show)

data ConnectRequest = ConnectRequest {
  ConnectRequest -> Maybe ByteString
_username         :: Maybe BL.ByteString
  , ConnectRequest -> Maybe ByteString
_password       :: Maybe BL.ByteString
  , ConnectRequest -> Maybe LastWill
_lastWill       :: Maybe LastWill
  , ConnectRequest -> Bool
_cleanSession   :: Bool
  , ConnectRequest -> Word16
_keepAlive      :: Word16
  , ConnectRequest -> ByteString
_connID         :: BL.ByteString
  , ConnectRequest -> [Property]
_connProperties :: [Property]
  } deriving (ConnectRequest -> ConnectRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectRequest -> ConnectRequest -> Bool
$c/= :: ConnectRequest -> ConnectRequest -> Bool
== :: ConnectRequest -> ConnectRequest -> Bool
$c== :: ConnectRequest -> ConnectRequest -> Bool
Eq, Int -> ConnectRequest -> ShowS
[ConnectRequest] -> ShowS
ConnectRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConnectRequest] -> ShowS
$cshowList :: [ConnectRequest] -> ShowS
show :: ConnectRequest -> [Char]
$cshow :: ConnectRequest -> [Char]
showsPrec :: Int -> ConnectRequest -> ShowS
$cshowsPrec :: Int -> ConnectRequest -> ShowS
Show)

connectRequest :: ConnectRequest
connectRequest :: ConnectRequest
connectRequest = ConnectRequest{_username :: Maybe ByteString
_username=forall a. Maybe a
Nothing, _password :: Maybe ByteString
_password=forall a. Maybe a
Nothing, _lastWill :: Maybe LastWill
_lastWill=forall a. Maybe a
Nothing,
                                _cleanSession :: Bool
_cleanSession=Bool
True, _keepAlive :: Word16
_keepAlive=Word16
300, _connID :: ByteString
_connID=ByteString
"",
                                _connProperties :: [Property]
_connProperties=forall a. Monoid a => a
mempty}

instance ByteMe ConnectRequest where
  toByteString :: ProtocolLevel -> ConnectRequest -> ByteString
toByteString ProtocolLevel
prot 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
..} = Word8 -> ByteString
BL.singleton Word8
0x10 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (ProtocolLevel -> ByteString
val ProtocolLevel
prot)
    where
      val :: ProtocolLevel -> BL.ByteString
      val :: ProtocolLevel -> ByteString
val ProtocolLevel
Protocol311 = ByteString
"\NUL\EOTMQTT\EOT" -- MQTT + Protocol311
                        forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
connBits
                        forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
encodeWord16 Word16
_keepAlive
                        forall a. Semigroup a => a -> a -> a
<> forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_connID
                        forall a. Semigroup a => a -> a -> a
<> Maybe LastWill -> ByteString
lwt Maybe LastWill
_lastWill
                        forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> ByteString
perhaps Maybe ByteString
_username
                        forall a. Semigroup a => a -> a -> a
<> if forall a. Maybe a -> Bool
isJust Maybe ByteString
_username then Maybe ByteString -> ByteString
perhaps Maybe ByteString
_password else ByteString
""

      val ProtocolLevel
Protocol50 = ByteString
"\NUL\EOTMQTT\ENQ" -- MQTT + Protocol50
                       forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
connBits
                       forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
encodeWord16 Word16
_keepAlive
                       forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
_connProperties
                       forall a. Semigroup a => a -> a -> a
<> forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_connID
                       forall a. Semigroup a => a -> a -> a
<> Maybe LastWill -> ByteString
lwt Maybe LastWill
_lastWill
                       forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> ByteString
perhaps Maybe ByteString
_username
                       forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> ByteString
perhaps Maybe ByteString
_password

      connBits :: Word8
connBits = Word8
hasu forall a. Bits a => a -> a -> a
.|. Word8
hasp forall a. Bits a => a -> a -> a
.|. Word8
willBits forall a. Bits a => a -> a -> a
.|. Word8
clean
        where
          hasu :: Word8
hasu = Bool -> Word8
boolBit (forall a. Maybe a -> Bool
isJust Maybe ByteString
_username) forall a. Bits a => a -> Int -> a
≪ Int
7
          hasp :: Word8
hasp = Bool -> Word8
boolBit ((ProtocolLevel
prot forall a. Eq a => a -> a -> Bool
== ProtocolLevel
Protocol50 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe ByteString
_username) Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe ByteString
_password) forall a. Bits a => a -> Int -> a
≪ Int
6
          clean :: Word8
clean = Bool -> Word8
boolBit Bool
_cleanSession forall a. Bits a => a -> Int -> a
≪ Int
1
          willBits :: Word8
willBits = case Maybe LastWill
_lastWill of
                       Maybe LastWill
Nothing           -> Word8
0
                       Just LastWill{Bool
[Property]
ByteString
QoS
_willProps :: [Property]
_willMsg :: ByteString
_willTopic :: ByteString
_willQoS :: QoS
_willRetain :: Bool
_willProps :: LastWill -> [Property]
_willMsg :: LastWill -> ByteString
_willTopic :: LastWill -> ByteString
_willQoS :: LastWill -> QoS
_willRetain :: LastWill -> Bool
..} -> Word8
4 forall a. Bits a => a -> a -> a
.|. ((QoS -> Word8
qosW QoS
_willQoS forall a. Bits a => a -> a -> a
.&. Word8
0x3) forall a. Bits a => a -> Int -> a
≪ Int
3) forall a. Bits a => a -> a -> a
.|. (Bool -> Word8
boolBit Bool
_willRetain forall a. Bits a => a -> Int -> a
≪ Int
5)

      lwt :: Maybe LastWill -> BL.ByteString
      lwt :: Maybe LastWill -> ByteString
lwt Maybe LastWill
Nothing = forall a. Monoid a => a
mempty
      lwt (Just LastWill{Bool
[Property]
ByteString
QoS
_willProps :: [Property]
_willMsg :: ByteString
_willTopic :: ByteString
_willQoS :: QoS
_willRetain :: Bool
_willProps :: LastWill -> [Property]
_willMsg :: LastWill -> ByteString
_willTopic :: LastWill -> ByteString
_willQoS :: LastWill -> QoS
_willRetain :: LastWill -> Bool
..}) = ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
_willProps
                                forall a. Semigroup a => a -> a -> a
<> forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_willTopic
                                forall a. Semigroup a => a -> a -> a
<> forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_willMsg

      perhaps :: Maybe BL.ByteString -> BL.ByteString
      perhaps :: Maybe ByteString -> ByteString
perhaps = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot)

data MQTTPkt = ConnPkt ConnectRequest ProtocolLevel
             | ConnACKPkt ConnACKFlags
             | PublishPkt PublishRequest
             | PubACKPkt PubACK
             | PubRECPkt PubREC
             | PubRELPkt PubREL
             | PubCOMPPkt PubCOMP
             | SubscribePkt SubscribeRequest
             | SubACKPkt SubscribeResponse
             | UnsubscribePkt UnsubscribeRequest
             | UnsubACKPkt UnsubscribeResponse
             | PingPkt
             | PongPkt
             | DisconnectPkt DisconnectRequest
             | AuthPkt AuthRequest
  deriving (MQTTPkt -> MQTTPkt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MQTTPkt -> MQTTPkt -> Bool
$c/= :: MQTTPkt -> MQTTPkt -> Bool
== :: MQTTPkt -> MQTTPkt -> Bool
$c== :: MQTTPkt -> MQTTPkt -> Bool
Eq, Int -> MQTTPkt -> ShowS
[MQTTPkt] -> ShowS
MQTTPkt -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MQTTPkt] -> ShowS
$cshowList :: [MQTTPkt] -> ShowS
show :: MQTTPkt -> [Char]
$cshow :: MQTTPkt -> [Char]
showsPrec :: Int -> MQTTPkt -> ShowS
$cshowsPrec :: Int -> MQTTPkt -> ShowS
Show)

instance ByteMe MQTTPkt where
  toByteString :: ProtocolLevel -> MQTTPkt -> ByteString
toByteString ProtocolLevel
p (ConnPkt ConnectRequest
x ProtocolLevel
_)      = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p ConnectRequest
x
  toByteString ProtocolLevel
p (ConnACKPkt ConnACKFlags
x)     = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p ConnACKFlags
x
  toByteString ProtocolLevel
p (PublishPkt PublishRequest
x)     = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PublishRequest
x
  toByteString ProtocolLevel
p (PubACKPkt PubACK
x)      = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubACK
x
  toByteString ProtocolLevel
p (PubRELPkt PubREL
x)      = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubREL
x
  toByteString ProtocolLevel
p (PubRECPkt PubREC
x)      = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubREC
x
  toByteString ProtocolLevel
p (PubCOMPPkt PubCOMP
x)     = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubCOMP
x
  toByteString ProtocolLevel
p (SubscribePkt SubscribeRequest
x)   = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p SubscribeRequest
x
  toByteString ProtocolLevel
p (SubACKPkt SubscribeResponse
x)      = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p SubscribeResponse
x
  toByteString ProtocolLevel
p (UnsubscribePkt UnsubscribeRequest
x) = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p UnsubscribeRequest
x
  toByteString ProtocolLevel
p (UnsubACKPkt UnsubscribeResponse
x)    = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p UnsubscribeResponse
x
  toByteString ProtocolLevel
_ MQTTPkt
PingPkt            = ByteString
"\192\NUL"
  toByteString ProtocolLevel
_ MQTTPkt
PongPkt            = ByteString
"\208\NUL"
  toByteString ProtocolLevel
p (DisconnectPkt DisconnectRequest
x)  = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p DisconnectRequest
x
  toByteString ProtocolLevel
p (AuthPkt AuthRequest
x)        = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p AuthRequest
x

parsePacket :: ProtocolLevel -> A.Parser MQTTPkt
parsePacket :: ProtocolLevel -> Parser MQTTPkt
parsePacket ProtocolLevel
p = Parser MQTTPkt
parseConnect forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MQTTPkt
parseConnectACK
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtocolLevel -> Parser MQTTPkt
parsePublish ProtocolLevel
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MQTTPkt
parsePubACK
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MQTTPkt
parsePubREC forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MQTTPkt
parsePubREL forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MQTTPkt
parsePubCOMP
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtocolLevel -> Parser MQTTPkt
parseSubscribe ProtocolLevel
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtocolLevel -> Parser MQTTPkt
parseSubACK ProtocolLevel
p
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtocolLevel -> Parser MQTTPkt
parseUnsubscribe ProtocolLevel
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtocolLevel -> Parser MQTTPkt
parseUnsubACK ProtocolLevel
p
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MQTTPkt
PingPkt forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
A.string ByteString
"\192\NUL" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MQTTPkt
PongPkt forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
A.string ByteString
"\208\NUL"
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtocolLevel -> Parser MQTTPkt
parseDisconnect ProtocolLevel
p
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MQTTPkt
parseAuth

aWord16 :: A.Parser Word16
aWord16 :: Parser Word16
aWord16 = Parser Word16
anyWord16be

aWord32 :: A.Parser Word32
aWord32 :: Parser Word32
aWord32 = Parser Word32
anyWord32be

aString :: A.Parser BL.ByteString
aString :: Parser ByteString
aString = do
  Word16
n <- Parser Word16
aWord16
  ByteString
s <- Int -> Parser ByteString
A.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
s

-- | Parse a CONNect packet.  This is useful when examining the
-- beginning of the stream as it allows you to determine the protocol
-- being used throughout the rest of the session.
parseConnect :: A.Parser MQTTPkt
parseConnect :: Parser MQTTPkt
parseConnect = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
0x10
  Int
_ <- Parser Int
parseHdrLen
  ByteString
_ <- ByteString -> Parser ByteString
A.string ByteString
"\NUL\EOTMQTT" -- "MQTT"
  ProtocolLevel
pl <- Parser ByteString ProtocolLevel
parseLevel

  Word8
connFlagBits <- Parser Word8
A.anyWord8
  Word16
keepAlive <- Parser Word16
aWord16
  [Property]
props <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
pl
  ByteString
cid <- Parser ByteString
aString
  Maybe LastWill
lwt <- ProtocolLevel -> Word8 -> Parser ByteString (Maybe LastWill)
parseLwt ProtocolLevel
pl Word8
connFlagBits
  Maybe ByteString
u <- Bool -> Parser (Maybe ByteString)
mstr (forall a. Bits a => a -> Int -> Bool
testBit Word8
connFlagBits Int
7)
  Maybe ByteString
p <- Bool -> Parser (Maybe ByteString)
mstr (forall a. Bits a => a -> Int -> Bool
testBit Word8
connFlagBits Int
6)

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ConnectRequest -> ProtocolLevel -> MQTTPkt
ConnPkt ConnectRequest{_connID :: ByteString
_connID=ByteString
cid, _username :: Maybe ByteString
_username=Maybe ByteString
u, _password :: Maybe ByteString
_password=Maybe ByteString
p,
                                _lastWill :: Maybe LastWill
_lastWill=Maybe LastWill
lwt, _keepAlive :: Word16
_keepAlive=Word16
keepAlive,
                                _cleanSession :: Bool
_cleanSession=forall a. Bits a => a -> Int -> Bool
testBit Word8
connFlagBits Int
1,
                                _connProperties :: [Property]
_connProperties=[Property]
props} ProtocolLevel
pl

  where
    mstr :: Bool -> A.Parser (Maybe BL.ByteString)
    mstr :: Bool -> Parser (Maybe ByteString)
mstr Bool
False = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    mstr Bool
True  = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
aString

    parseLevel :: Parser ByteString ProtocolLevel
parseLevel = ByteString -> Parser ByteString
A.string ByteString
"\EOT" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ProtocolLevel
Protocol311
                 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"\ENQ" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ProtocolLevel
Protocol50

    parseLwt :: ProtocolLevel -> Word8 -> Parser ByteString (Maybe LastWill)
parseLwt ProtocolLevel
pl Word8
bits
      | forall a. Bits a => a -> Int -> Bool
testBit Word8
bits Int
2 = do
          [Property]
props <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
pl
          ByteString
top <- Parser ByteString
aString
          ByteString
msg <- Parser ByteString
aString
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just LastWill{_willTopic :: ByteString
_willTopic=ByteString
top, _willMsg :: ByteString
_willMsg=ByteString
msg,
                               _willRetain :: Bool
_willRetain=forall a. Bits a => a -> Int -> Bool
testBit Word8
bits Int
5,
                               _willQoS :: QoS
_willQoS=Word8 -> QoS
wQos forall a b. (a -> b) -> a -> b
$ (Word8
bits forall a. Bits a => a -> Int -> a
≫ Int
3) forall a. Bits a => a -> a -> a
.&. Word8
0x3,
                               _willProps :: [Property]
_willProps = [Property]
props}
      | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

data ConnACKRC = ConnAccepted
  -- 3.1.1 codes
  | UnacceptableProtocol
  | IdentifierRejected
  | ServerUnavailable
  | BadCredentials
  | NotAuthorized
  -- 5.0 codes
  | ConnUnspecifiedError
  | ConnMalformedPacket
  | ConnProtocolError
  | ConnImplementationSpecificError
  | ConnUnsupportedProtocolVersion
  | ConnClientIdentifierNotValid
  | ConnBadUserNameOrPassword
  | ConnNotAuthorized
  | ConnServerUnavailable
  | ConnServerBusy
  | ConnBanned
  | ConnBadAuthenticationMethod
  | ConnTopicNameInvalid
  | ConnPacketTooLarge
  | ConnQuotaExceeded
  | ConnPayloadFormatInvalid
  | ConnRetainNotSupported
  | ConnQosNotSupported
  | ConnUseAnotherServer
  | ConnServerMoved
  | ConnConnectionRateExceeded
  deriving(ConnACKRC -> ConnACKRC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnACKRC -> ConnACKRC -> Bool
$c/= :: ConnACKRC -> ConnACKRC -> Bool
== :: ConnACKRC -> ConnACKRC -> Bool
$c== :: ConnACKRC -> ConnACKRC -> Bool
Eq, Int -> ConnACKRC -> ShowS
[ConnACKRC] -> ShowS
ConnACKRC -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConnACKRC] -> ShowS
$cshowList :: [ConnACKRC] -> ShowS
show :: ConnACKRC -> [Char]
$cshow :: ConnACKRC -> [Char]
showsPrec :: Int -> ConnACKRC -> ShowS
$cshowsPrec :: Int -> ConnACKRC -> ShowS
Show, ConnACKRC
forall a. a -> a -> Bounded a
maxBound :: ConnACKRC
$cmaxBound :: ConnACKRC
minBound :: ConnACKRC
$cminBound :: ConnACKRC
Bounded, Int -> ConnACKRC
ConnACKRC -> Int
ConnACKRC -> [ConnACKRC]
ConnACKRC -> ConnACKRC
ConnACKRC -> ConnACKRC -> [ConnACKRC]
ConnACKRC -> ConnACKRC -> ConnACKRC -> [ConnACKRC]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ConnACKRC -> ConnACKRC -> ConnACKRC -> [ConnACKRC]
$cenumFromThenTo :: ConnACKRC -> ConnACKRC -> ConnACKRC -> [ConnACKRC]
enumFromTo :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
$cenumFromTo :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
enumFromThen :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
$cenumFromThen :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
enumFrom :: ConnACKRC -> [ConnACKRC]
$cenumFrom :: ConnACKRC -> [ConnACKRC]
fromEnum :: ConnACKRC -> Int
$cfromEnum :: ConnACKRC -> Int
toEnum :: Int -> ConnACKRC
$ctoEnum :: Int -> ConnACKRC
pred :: ConnACKRC -> ConnACKRC
$cpred :: ConnACKRC -> ConnACKRC
succ :: ConnACKRC -> ConnACKRC
$csucc :: ConnACKRC -> ConnACKRC
Enum)

instance ByteSize ConnACKRC where

  toByte :: ConnACKRC -> Word8
toByte ConnACKRC
ConnAccepted                    = Word8
0
  toByte ConnACKRC
UnacceptableProtocol            = Word8
1
  toByte ConnACKRC
IdentifierRejected              = Word8
2
  toByte ConnACKRC
ServerUnavailable               = Word8
3
  toByte ConnACKRC
BadCredentials                  = Word8
4
  toByte ConnACKRC
NotAuthorized                   = Word8
5
  toByte ConnACKRC
ConnUnspecifiedError            = Word8
0x80
  toByte ConnACKRC
ConnMalformedPacket             = Word8
0x81
  toByte ConnACKRC
ConnProtocolError               = Word8
0x82
  toByte ConnACKRC
ConnImplementationSpecificError = Word8
0x83
  toByte ConnACKRC
ConnUnsupportedProtocolVersion  = Word8
0x84
  toByte ConnACKRC
ConnClientIdentifierNotValid    = Word8
0x85
  toByte ConnACKRC
ConnBadUserNameOrPassword       = Word8
0x86
  toByte ConnACKRC
ConnNotAuthorized               = Word8
0x87
  toByte ConnACKRC
ConnServerUnavailable           = Word8
0x88
  toByte ConnACKRC
ConnServerBusy                  = Word8
0x89
  toByte ConnACKRC
ConnBanned                      = Word8
0x8a
  toByte ConnACKRC
ConnBadAuthenticationMethod     = Word8
0x8c
  toByte ConnACKRC
ConnTopicNameInvalid            = Word8
0x90
  toByte ConnACKRC
ConnPacketTooLarge              = Word8
0x95
  toByte ConnACKRC
ConnQuotaExceeded               = Word8
0x97
  toByte ConnACKRC
ConnPayloadFormatInvalid        = Word8
0x99
  toByte ConnACKRC
ConnRetainNotSupported          = Word8
0x9a
  toByte ConnACKRC
ConnQosNotSupported             = Word8
0x9b
  toByte ConnACKRC
ConnUseAnotherServer            = Word8
0x9c
  toByte ConnACKRC
ConnServerMoved                 = Word8
0x9d
  toByte ConnACKRC
ConnConnectionRateExceeded      = Word8
0x9f

  fromByte :: Word8 -> ConnACKRC
fromByte Word8
b = forall a. a -> Maybe a -> a
fromMaybe ConnACKRC
ConnUnspecifiedError forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
b [(Word8, ConnACKRC)]
connACKRev

connACKRev :: [(Word8, ConnACKRC)]
connACKRev :: [(Word8, ConnACKRC)]
connACKRev = forall a b. (a -> b) -> [a] -> [b]
map (\ConnACKRC
w -> (forall a. ByteSize a => a -> Word8
toByte ConnACKRC
w, ConnACKRC
w)) [forall a. Bounded a => a
minBound..]

data SessionReuse = NewSession | ExistingSession deriving (Int -> SessionReuse -> ShowS
[SessionReuse] -> ShowS
SessionReuse -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SessionReuse] -> ShowS
$cshowList :: [SessionReuse] -> ShowS
show :: SessionReuse -> [Char]
$cshow :: SessionReuse -> [Char]
showsPrec :: Int -> SessionReuse -> ShowS
$cshowsPrec :: Int -> SessionReuse -> ShowS
Show, SessionReuse -> SessionReuse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionReuse -> SessionReuse -> Bool
$c/= :: SessionReuse -> SessionReuse -> Bool
== :: SessionReuse -> SessionReuse -> Bool
$c== :: SessionReuse -> SessionReuse -> Bool
Eq, SessionReuse
forall a. a -> a -> Bounded a
maxBound :: SessionReuse
$cmaxBound :: SessionReuse
minBound :: SessionReuse
$cminBound :: SessionReuse
Bounded, Int -> SessionReuse
SessionReuse -> Int
SessionReuse -> [SessionReuse]
SessionReuse -> SessionReuse
SessionReuse -> SessionReuse -> [SessionReuse]
SessionReuse -> SessionReuse -> SessionReuse -> [SessionReuse]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SessionReuse -> SessionReuse -> SessionReuse -> [SessionReuse]
$cenumFromThenTo :: SessionReuse -> SessionReuse -> SessionReuse -> [SessionReuse]
enumFromTo :: SessionReuse -> SessionReuse -> [SessionReuse]
$cenumFromTo :: SessionReuse -> SessionReuse -> [SessionReuse]
enumFromThen :: SessionReuse -> SessionReuse -> [SessionReuse]
$cenumFromThen :: SessionReuse -> SessionReuse -> [SessionReuse]
enumFrom :: SessionReuse -> [SessionReuse]
$cenumFrom :: SessionReuse -> [SessionReuse]
fromEnum :: SessionReuse -> Int
$cfromEnum :: SessionReuse -> Int
toEnum :: Int -> SessionReuse
$ctoEnum :: Int -> SessionReuse
pred :: SessionReuse -> SessionReuse
$cpred :: SessionReuse -> SessionReuse
succ :: SessionReuse -> SessionReuse
$csucc :: SessionReuse -> SessionReuse
Enum)

-- | Connection acknowledgment details.
data ConnACKFlags = ConnACKFlags SessionReuse ConnACKRC [Property] deriving (ConnACKFlags -> ConnACKFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnACKFlags -> ConnACKFlags -> Bool
$c/= :: ConnACKFlags -> ConnACKFlags -> Bool
== :: ConnACKFlags -> ConnACKFlags -> Bool
$c== :: ConnACKFlags -> ConnACKFlags -> Bool
Eq, Int -> ConnACKFlags -> ShowS
[ConnACKFlags] -> ShowS
ConnACKFlags -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConnACKFlags] -> ShowS
$cshowList :: [ConnACKFlags] -> ShowS
show :: ConnACKFlags -> [Char]
$cshow :: ConnACKFlags -> [Char]
showsPrec :: Int -> ConnACKFlags -> ShowS
$cshowsPrec :: Int -> ConnACKFlags -> ShowS
Show)

instance ByteMe ConnACKFlags where
  toBytes :: ProtocolLevel -> ConnACKFlags -> [Word8]
toBytes ProtocolLevel
prot (ConnACKFlags SessionReuse
sp ConnACKRC
rc [Property]
props) =
    let pbytes :: [Word8]
pbytes = ByteString -> [Word8]
BL.unpack forall a b. (a -> b) -> a -> b
$ ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props in
      [Word8
0x20]
      forall a. Semigroup a => a -> a -> a
<> Int -> [Word8]
encodeVarInt (Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
pbytes)
      forall a. Semigroup a => a -> a -> a
<>[ Bool -> Word8
boolBit (SessionReuse
sp forall a. Eq a => a -> a -> Bool
/= SessionReuse
NewSession), forall a. ByteSize a => a -> Word8
toByte ConnACKRC
rc] forall a. Semigroup a => a -> a -> a
<> [Word8]
pbytes

parseConnectACK :: A.Parser MQTTPkt
parseConnectACK :: Parser MQTTPkt
parseConnectACK = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
0x20
  Int
rl <- Parser Int
decodeVarInt -- remaining length
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rl forall a. Ord a => a -> a -> Bool
< Int
2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"conn ack packet too short"
  Word8
ackFlags <- Parser Word8
A.anyWord8
  Word8
rc <- Parser Word8
A.anyWord8
  [Property]
p <- ProtocolLevel -> Parser [Property]
parseProperties (if Int
rl forall a. Eq a => a -> a -> Bool
== Int
2 then ProtocolLevel
Protocol311 else ProtocolLevel
Protocol50)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ConnACKFlags -> MQTTPkt
ConnACKPkt forall a b. (a -> b) -> a -> b
$ SessionReuse -> ConnACKRC -> [Property] -> ConnACKFlags
ConnACKFlags (Bool -> SessionReuse
sf forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> Bool
testBit Word8
ackFlags Int
0) (forall a. ByteSize a => Word8 -> a
fromByte Word8
rc) [Property]
p

    where sf :: Bool -> SessionReuse
sf Bool
False = SessionReuse
NewSession
          sf Bool
True  = SessionReuse
ExistingSession

type PktID = Word16

data PublishRequest = PublishRequest{
  PublishRequest -> Bool
_pubDup      :: Bool
  , PublishRequest -> QoS
_pubQoS    :: QoS
  , PublishRequest -> Bool
_pubRetain :: Bool
  , PublishRequest -> ByteString
_pubTopic  :: BL.ByteString
  , PublishRequest -> Word16
_pubPktID  :: PktID
  , PublishRequest -> ByteString
_pubBody   :: BL.ByteString
  , PublishRequest -> [Property]
_pubProps  :: [Property]
  } deriving(PublishRequest -> PublishRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishRequest -> PublishRequest -> Bool
$c/= :: PublishRequest -> PublishRequest -> Bool
== :: PublishRequest -> PublishRequest -> Bool
$c== :: PublishRequest -> PublishRequest -> Bool
Eq, Int -> PublishRequest -> ShowS
[PublishRequest] -> ShowS
PublishRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PublishRequest] -> ShowS
$cshowList :: [PublishRequest] -> ShowS
show :: PublishRequest -> [Char]
$cshow :: PublishRequest -> [Char]
showsPrec :: Int -> PublishRequest -> ShowS
$cshowsPrec :: Int -> PublishRequest -> ShowS
Show)

instance ByteMe PublishRequest where
  toByteString :: ProtocolLevel -> PublishRequest -> ByteString
toByteString ProtocolLevel
prot PublishRequest{Bool
[Property]
Word16
ByteString
QoS
_pubProps :: [Property]
_pubBody :: ByteString
_pubPktID :: Word16
_pubTopic :: ByteString
_pubRetain :: Bool
_pubQoS :: QoS
_pubDup :: Bool
_pubProps :: PublishRequest -> [Property]
_pubBody :: PublishRequest -> ByteString
_pubPktID :: PublishRequest -> Word16
_pubTopic :: PublishRequest -> ByteString
_pubRetain :: PublishRequest -> Bool
_pubQoS :: PublishRequest -> QoS
_pubDup :: PublishRequest -> Bool
..} =
    Word8 -> ByteString
BL.singleton (Word8
0x30 forall a. Bits a => a -> a -> a
.|. Word8
f) forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength ByteString
val

    where f :: Word8
f = (Word8
db forall a. Bits a => a -> Int -> a
≪ Int
3) forall a. Bits a => a -> a -> a
.|. (Word8
qb forall a. Bits a => a -> Int -> a
≪ Int
1) forall a. Bits a => a -> a -> a
.|. Word8
rb
          db :: Word8
db = Bool -> Word8
boolBit Bool
_pubDup
          qb :: Word8
qb = QoS -> Word8
qosW QoS
_pubQoS forall a. Bits a => a -> a -> a
.&. Word8
0x3
          rb :: Word8
rb = Bool -> Word8
boolBit Bool
_pubRetain
          pktid :: ByteString
pktid
            | QoS
_pubQoS forall a. Eq a => a -> a -> Bool
== QoS
QoS0 = forall a. Monoid a => a
mempty
            | Bool
otherwise = Word16 -> ByteString
encodeWord16 Word16
_pubPktID
          val :: ByteString
val = forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_pubTopic forall a. Semigroup a => a -> a -> a
<> ByteString
pktid forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
_pubProps forall a. Semigroup a => a -> a -> a
<> ByteString
_pubBody

parsePublish :: ProtocolLevel -> A.Parser MQTTPkt
parsePublish :: ProtocolLevel -> Parser MQTTPkt
parsePublish ProtocolLevel
prot = do
  Word8
w <- (Word8 -> Bool) -> Parser Word8
A.satisfy (\Word8
x -> Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0xf0 forall a. Eq a => a -> a -> Bool
== Word8
0x30)
  Int
plen <- Parser Int
parseHdrLen
  let _pubDup :: Bool
_pubDup = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0x8 forall a. Eq a => a -> a -> Bool
== Word8
0x8
      _pubQoS :: QoS
_pubQoS = Word8 -> QoS
wQos forall a b. (a -> b) -> a -> b
$ (Word8
w forall a. Bits a => a -> Int -> a
≫ Int
1) forall a. Bits a => a -> a -> a
.&. Word8
3
      _pubRetain :: Bool
_pubRetain = Word8
w forall a. Bits a => a -> a -> a
.&. Word8
1 forall a. Eq a => a -> a -> Bool
== Word8
1
  ByteString
_pubTopic <- Parser ByteString
aString
  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 Parser Word16
aWord16
  [Property]
_pubProps <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
prot
  ByteString
_pubBody <- ByteString -> ByteString
BL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString
A.take (Int
plen forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
_pubTopic) forall a. Num a => a -> a -> a
- Int
2
                                        forall a. Num a => a -> a -> a
- forall {a}. Num a => QoS -> a
qlen QoS
_pubQoS forall a. Num a => a -> a -> a
- ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
prot [Property]
_pubProps )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PublishRequest -> MQTTPkt
PublishPkt PublishRequest{Bool
[Property]
Word16
ByteString
QoS
_pubBody :: ByteString
_pubProps :: [Property]
_pubPktID :: Word16
_pubTopic :: ByteString
_pubRetain :: Bool
_pubQoS :: QoS
_pubDup :: Bool
_pubProps :: [Property]
_pubBody :: ByteString
_pubPktID :: Word16
_pubTopic :: ByteString
_pubRetain :: Bool
_pubQoS :: QoS
_pubDup :: Bool
..}

  where qlen :: QoS -> a
qlen QoS
QoS0 = a
0
        qlen QoS
_    = a
2

-- | How to process retained messages on subscriptions.
data RetainHandling = SendOnSubscribe       -- ^ Send existing retained messages to a new client.
                    | SendOnSubscribeNew    -- ^ Send existing retained messages that have not yet been sent.
                    | DoNotSendOnSubscribe  -- ^ Don't send existing retained messages.
  deriving (RetainHandling -> RetainHandling -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetainHandling -> RetainHandling -> Bool
$c/= :: RetainHandling -> RetainHandling -> Bool
== :: RetainHandling -> RetainHandling -> Bool
$c== :: RetainHandling -> RetainHandling -> Bool
Eq, Int -> RetainHandling -> ShowS
[RetainHandling] -> ShowS
RetainHandling -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RetainHandling] -> ShowS
$cshowList :: [RetainHandling] -> ShowS
show :: RetainHandling -> [Char]
$cshow :: RetainHandling -> [Char]
showsPrec :: Int -> RetainHandling -> ShowS
$cshowsPrec :: Int -> RetainHandling -> ShowS
Show, RetainHandling
forall a. a -> a -> Bounded a
maxBound :: RetainHandling
$cmaxBound :: RetainHandling
minBound :: RetainHandling
$cminBound :: RetainHandling
Bounded, Int -> RetainHandling
RetainHandling -> Int
RetainHandling -> [RetainHandling]
RetainHandling -> RetainHandling
RetainHandling -> RetainHandling -> [RetainHandling]
RetainHandling
-> RetainHandling -> RetainHandling -> [RetainHandling]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RetainHandling
-> RetainHandling -> RetainHandling -> [RetainHandling]
$cenumFromThenTo :: RetainHandling
-> RetainHandling -> RetainHandling -> [RetainHandling]
enumFromTo :: RetainHandling -> RetainHandling -> [RetainHandling]
$cenumFromTo :: RetainHandling -> RetainHandling -> [RetainHandling]
enumFromThen :: RetainHandling -> RetainHandling -> [RetainHandling]
$cenumFromThen :: RetainHandling -> RetainHandling -> [RetainHandling]
enumFrom :: RetainHandling -> [RetainHandling]
$cenumFrom :: RetainHandling -> [RetainHandling]
fromEnum :: RetainHandling -> Int
$cfromEnum :: RetainHandling -> Int
toEnum :: Int -> RetainHandling
$ctoEnum :: Int -> RetainHandling
pred :: RetainHandling -> RetainHandling
$cpred :: RetainHandling -> RetainHandling
succ :: RetainHandling -> RetainHandling
$csucc :: RetainHandling -> RetainHandling
Enum)

-- | Options used at subscribe time to define how to handle incoming messages.
data SubOptions = SubOptions{
  SubOptions -> RetainHandling
_retainHandling      :: RetainHandling  -- ^ How to handle existing retained messages.
  , SubOptions -> Bool
_retainAsPublished :: Bool            -- ^ If true, retain is propagated on subscribe.
  , SubOptions -> Bool
_noLocal           :: Bool            -- ^ If true, do not send messages initiated from this client back.
  , SubOptions -> QoS
_subQoS            :: QoS             -- ^ Maximum QoS to use for this subscription.
  } deriving(SubOptions -> SubOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubOptions -> SubOptions -> Bool
$c/= :: SubOptions -> SubOptions -> Bool
== :: SubOptions -> SubOptions -> Bool
$c== :: SubOptions -> SubOptions -> Bool
Eq, Int -> SubOptions -> ShowS
[SubOptions] -> ShowS
SubOptions -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubOptions] -> ShowS
$cshowList :: [SubOptions] -> ShowS
show :: SubOptions -> [Char]
$cshow :: SubOptions -> [Char]
showsPrec :: Int -> SubOptions -> ShowS
$cshowsPrec :: Int -> SubOptions -> ShowS
Show)

-- | Reasonable subscription option defaults at 'QoS0'.
subOptions :: SubOptions
subOptions :: SubOptions
subOptions = SubOptions{_retainHandling :: RetainHandling
_retainHandling=RetainHandling
SendOnSubscribe,
                         _retainAsPublished :: Bool
_retainAsPublished=Bool
False,
                         _noLocal :: Bool
_noLocal=Bool
False,
                         _subQoS :: QoS
_subQoS=QoS
QoS0}

instance ByteMe SubOptions where
  toByteString :: ProtocolLevel -> SubOptions -> ByteString
toByteString ProtocolLevel
_ SubOptions{Bool
RetainHandling
QoS
_subQoS :: QoS
_noLocal :: Bool
_retainAsPublished :: Bool
_retainHandling :: RetainHandling
_subQoS :: SubOptions -> QoS
_noLocal :: SubOptions -> Bool
_retainAsPublished :: SubOptions -> Bool
_retainHandling :: SubOptions -> RetainHandling
..} = Word8 -> ByteString
BL.singleton (Word8
rh forall a. Bits a => a -> a -> a
.|. Word8
rap forall a. Bits a => a -> a -> a
.|. Word8
nl forall a. Bits a => a -> a -> a
.|. Word8
q)

    where
      rh :: Word8
rh = case RetainHandling
_retainHandling of
             RetainHandling
SendOnSubscribeNew   -> Word8
0x10
             RetainHandling
DoNotSendOnSubscribe -> Word8
0x20
             RetainHandling
_                    -> Word8
0
      rap :: Word8
rap
        | Bool
_retainAsPublished = Word8
0x08
        | Bool
otherwise = Word8
0
      nl :: Word8
nl
        | Bool
_noLocal = Word8
0x04
        | Bool
otherwise = Word8
0
      q :: Word8
q = QoS -> Word8
qosW QoS
_subQoS

parseSubOptions :: A.Parser SubOptions
parseSubOptions :: Parser SubOptions
parseSubOptions = do
  Word8
w <- Parser Word8
A.anyWord8
  let rh :: RetainHandling
rh = case Word8
w forall a. Bits a => a -> Int -> a
≫ Int
4 of
             Word8
1 -> RetainHandling
SendOnSubscribeNew
             Word8
2 -> RetainHandling
DoNotSendOnSubscribe
             Word8
_ -> RetainHandling
SendOnSubscribe

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SubOptions{
    _retainHandling :: RetainHandling
_retainHandling=RetainHandling
rh,
    _retainAsPublished :: Bool
_retainAsPublished=forall a. Bits a => a -> Int -> Bool
testBit Word8
w Int
3,
    _noLocal :: Bool
_noLocal=forall a. Bits a => a -> Int -> Bool
testBit Word8
w Int
2,
    _subQoS :: QoS
_subQoS=Word8 -> QoS
wQos (Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0x3)}

subOptionsBytes :: ProtocolLevel -> [(BL.ByteString, SubOptions)] -> BL.ByteString
subOptionsBytes :: ProtocolLevel -> [(ByteString, SubOptions)] -> ByteString
subOptionsBytes ProtocolLevel
prot = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ByteString
bs,SubOptions
so) -> forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
bs forall a. Semigroup a => a -> a -> a
<> forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot SubOptions
so)

data SubscribeRequest = SubscribeRequest PktID [(BL.ByteString, SubOptions)] [Property]
                      deriving(SubscribeRequest -> SubscribeRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscribeRequest -> SubscribeRequest -> Bool
$c/= :: SubscribeRequest -> SubscribeRequest -> Bool
== :: SubscribeRequest -> SubscribeRequest -> Bool
$c== :: SubscribeRequest -> SubscribeRequest -> Bool
Eq, Int -> SubscribeRequest -> ShowS
[SubscribeRequest] -> ShowS
SubscribeRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubscribeRequest] -> ShowS
$cshowList :: [SubscribeRequest] -> ShowS
show :: SubscribeRequest -> [Char]
$cshow :: SubscribeRequest -> [Char]
showsPrec :: Int -> SubscribeRequest -> ShowS
$cshowsPrec :: Int -> SubscribeRequest -> ShowS
Show)

instance ByteMe SubscribeRequest where
  toByteString :: ProtocolLevel -> SubscribeRequest -> ByteString
toByteString ProtocolLevel
prot (SubscribeRequest Word16
pid [(ByteString, SubOptions)]
sreq [Property]
props) =
    Word8 -> ByteString
BL.singleton Word8
0x82 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [(ByteString, SubOptions)] -> ByteString
subOptionsBytes ProtocolLevel
prot [(ByteString, SubOptions)]
sreq)

data PubACK = PubACK PktID Word8 [Property] deriving(PubACK -> PubACK -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubACK -> PubACK -> Bool
$c/= :: PubACK -> PubACK -> Bool
== :: PubACK -> PubACK -> Bool
$c== :: PubACK -> PubACK -> Bool
Eq, Int -> PubACK -> ShowS
[PubACK] -> ShowS
PubACK -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PubACK] -> ShowS
$cshowList :: [PubACK] -> ShowS
show :: PubACK -> [Char]
$cshow :: PubACK -> [Char]
showsPrec :: Int -> PubACK -> ShowS
$cshowsPrec :: Int -> PubACK -> ShowS
Show)

bsPubSeg :: ProtocolLevel -> Word8 -> Word16 -> Word8 -> [Property] -> BL.ByteString
bsPubSeg :: ProtocolLevel
-> Word8 -> Word16 -> Word8 -> [Property] -> ByteString
bsPubSeg ProtocolLevel
Protocol311 Word8
h Word16
pid Word8
_ [Property]
_ = Word8 -> ByteString
BL.singleton Word8
h forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid)
bsPubSeg ProtocolLevel
Protocol50 Word8
h Word16
pid Word8
st [Property]
props = Word8 -> ByteString
BL.singleton Word8
h
                                     forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid
                                                    forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
st
                                                    forall a. Semigroup a => a -> a -> a
<> [Property] -> ByteString
mprop [Property]
props)
    where
      mprop :: [Property] -> ByteString
mprop [] = forall a. Monoid a => a
mempty
      mprop [Property]
p  = ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
Protocol50 [Property]
p

instance ByteMe PubACK where
  toByteString :: ProtocolLevel -> PubACK -> ByteString
toByteString ProtocolLevel
prot (PubACK Word16
pid Word8
st [Property]
props) = ProtocolLevel
-> Word8 -> Word16 -> Word8 -> [Property] -> ByteString
bsPubSeg ProtocolLevel
prot Word8
0x40 Word16
pid Word8
st [Property]
props

-- Common parser for all of the pub parts for q>0 handling:  (PubACK, PubREC, PubREL, PubCOMP)
parsePubSeg :: Word8 -> (a -> MQTTPkt) -> (PktID -> Word8 -> [Property] -> a) -> A.Parser MQTTPkt
parsePubSeg :: forall a.
Word8
-> (a -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> a)
-> Parser MQTTPkt
parsePubSeg Word8
i a -> MQTTPkt
cona Word16 -> Word8 -> [Property] -> a
conb = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
i
  Int
rl <- Parser Int
parseHdrLen
  Word16
mid <- Parser Word16
aWord16
  Word8
st <- if Int
rl forall a. Ord a => a -> a -> Bool
> Int
2 then Parser Word8
A.anyWord8 else forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
0
  [Property]
props <- if Int
rl forall a. Ord a => a -> a -> Bool
> Int
3 then ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50 else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a -> MQTTPkt
cona (Word16 -> Word8 -> [Property] -> a
conb Word16
mid Word8
st [Property]
props)

parsePubACK :: A.Parser MQTTPkt
parsePubACK :: Parser MQTTPkt
parsePubACK = forall a.
Word8
-> (a -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> a)
-> Parser MQTTPkt
parsePubSeg Word8
0x40 PubACK -> MQTTPkt
PubACKPkt Word16 -> Word8 -> [Property] -> PubACK
PubACK

data PubREC = PubREC PktID Word8 [Property] deriving(PubREC -> PubREC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubREC -> PubREC -> Bool
$c/= :: PubREC -> PubREC -> Bool
== :: PubREC -> PubREC -> Bool
$c== :: PubREC -> PubREC -> Bool
Eq, Int -> PubREC -> ShowS
[PubREC] -> ShowS
PubREC -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PubREC] -> ShowS
$cshowList :: [PubREC] -> ShowS
show :: PubREC -> [Char]
$cshow :: PubREC -> [Char]
showsPrec :: Int -> PubREC -> ShowS
$cshowsPrec :: Int -> PubREC -> ShowS
Show)

instance ByteMe PubREC where
  toByteString :: ProtocolLevel -> PubREC -> ByteString
toByteString ProtocolLevel
prot (PubREC Word16
pid Word8
st [Property]
props) = ProtocolLevel
-> Word8 -> Word16 -> Word8 -> [Property] -> ByteString
bsPubSeg ProtocolLevel
prot Word8
0x50 Word16
pid Word8
st [Property]
props

parsePubREC :: A.Parser MQTTPkt
parsePubREC :: Parser MQTTPkt
parsePubREC = forall a.
Word8
-> (a -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> a)
-> Parser MQTTPkt
parsePubSeg Word8
0x50 PubREC -> MQTTPkt
PubRECPkt Word16 -> Word8 -> [Property] -> PubREC
PubREC

data PubREL = PubREL PktID Word8 [Property] deriving(PubREL -> PubREL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubREL -> PubREL -> Bool
$c/= :: PubREL -> PubREL -> Bool
== :: PubREL -> PubREL -> Bool
$c== :: PubREL -> PubREL -> Bool
Eq, Int -> PubREL -> ShowS
[PubREL] -> ShowS
PubREL -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PubREL] -> ShowS
$cshowList :: [PubREL] -> ShowS
show :: PubREL -> [Char]
$cshow :: PubREL -> [Char]
showsPrec :: Int -> PubREL -> ShowS
$cshowsPrec :: Int -> PubREL -> ShowS
Show)

instance ByteMe PubREL where
  toByteString :: ProtocolLevel -> PubREL -> ByteString
toByteString ProtocolLevel
prot (PubREL Word16
pid Word8
st [Property]
props) = ProtocolLevel
-> Word8 -> Word16 -> Word8 -> [Property] -> ByteString
bsPubSeg ProtocolLevel
prot Word8
0x62 Word16
pid Word8
st [Property]
props

parsePubREL :: A.Parser MQTTPkt
parsePubREL :: Parser MQTTPkt
parsePubREL = forall a.
Word8
-> (a -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> a)
-> Parser MQTTPkt
parsePubSeg Word8
0x62 PubREL -> MQTTPkt
PubRELPkt Word16 -> Word8 -> [Property] -> PubREL
PubREL

data PubCOMP = PubCOMP PktID Word8 [Property] deriving(PubCOMP -> PubCOMP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubCOMP -> PubCOMP -> Bool
$c/= :: PubCOMP -> PubCOMP -> Bool
== :: PubCOMP -> PubCOMP -> Bool
$c== :: PubCOMP -> PubCOMP -> Bool
Eq, Int -> PubCOMP -> ShowS
[PubCOMP] -> ShowS
PubCOMP -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PubCOMP] -> ShowS
$cshowList :: [PubCOMP] -> ShowS
show :: PubCOMP -> [Char]
$cshow :: PubCOMP -> [Char]
showsPrec :: Int -> PubCOMP -> ShowS
$cshowsPrec :: Int -> PubCOMP -> ShowS
Show)

instance ByteMe PubCOMP where
  toByteString :: ProtocolLevel -> PubCOMP -> ByteString
toByteString ProtocolLevel
prot (PubCOMP Word16
pid Word8
st [Property]
props) = ProtocolLevel
-> Word8 -> Word16 -> Word8 -> [Property] -> ByteString
bsPubSeg ProtocolLevel
prot Word8
0x70 Word16
pid Word8
st [Property]
props

parsePubCOMP :: A.Parser MQTTPkt
parsePubCOMP :: Parser MQTTPkt
parsePubCOMP = forall a.
Word8
-> (a -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> a)
-> Parser MQTTPkt
parsePubSeg Word8
0x70 PubCOMP -> MQTTPkt
PubCOMPPkt Word16 -> Word8 -> [Property] -> PubCOMP
PubCOMP

-- Common header bits for subscribe, unsubscribe, and the sub acks.
parseSubHdr :: Word8 -> ProtocolLevel -> A.Parser a -> A.Parser (PktID, [Property], a)
parseSubHdr :: forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
b ProtocolLevel
prot Parser a
p = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
b
  Int
hl <- Parser Int
parseHdrLen
  Word16
pid <- Parser Word16
aWord16
  [Property]
props <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
prot
  ByteString
content <- Int -> Parser ByteString
A.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hl forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
prot [Property]
props)
  a
a <- ByteString -> Parser a
subp ByteString
content
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
pid, [Property]
props, a
a)

    where subp :: ByteString -> Parser a
subp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
AS.parseOnly Parser a
p

parseSubscribe :: ProtocolLevel -> A.Parser MQTTPkt
parseSubscribe :: ProtocolLevel -> Parser MQTTPkt
parseSubscribe ProtocolLevel
prot = do
  (Word16
pid, [Property]
props, [(ByteString, SubOptions)]
subs) <- forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
0x82 ProtocolLevel
prot forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Parser ByteString
aString Parser SubOptions
parseSubOptions)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SubscribeRequest -> MQTTPkt
SubscribePkt (Word16
-> [(ByteString, SubOptions)] -> [Property] -> SubscribeRequest
SubscribeRequest Word16
pid [(ByteString, SubOptions)]
subs [Property]
props)

data SubscribeResponse = SubscribeResponse PktID [Either SubErr QoS] [Property] deriving (SubscribeResponse -> SubscribeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscribeResponse -> SubscribeResponse -> Bool
$c/= :: SubscribeResponse -> SubscribeResponse -> Bool
== :: SubscribeResponse -> SubscribeResponse -> Bool
$c== :: SubscribeResponse -> SubscribeResponse -> Bool
Eq, Int -> SubscribeResponse -> ShowS
[SubscribeResponse] -> ShowS
SubscribeResponse -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubscribeResponse] -> ShowS
$cshowList :: [SubscribeResponse] -> ShowS
show :: SubscribeResponse -> [Char]
$cshow :: SubscribeResponse -> [Char]
showsPrec :: Int -> SubscribeResponse -> ShowS
$cshowsPrec :: Int -> SubscribeResponse -> ShowS
Show)

instance ByteMe SubscribeResponse where
  toByteString :: ProtocolLevel -> SubscribeResponse -> ByteString
toByteString ProtocolLevel
prot (SubscribeResponse Word16
pid [Either SubErr QoS]
sres [Property]
props) =
    Word8 -> ByteString
BL.singleton Word8
0x90 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BL.pack (Either SubErr QoS -> Word8
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either SubErr QoS]
sres))

    where
      b :: Either SubErr QoS -> Word8
b (Left SubErr
SubErrUnspecifiedError)                    =  Word8
0x80
      b (Left SubErr
SubErrImplementationSpecificError)         =  Word8
0x83
      b (Left SubErr
SubErrNotAuthorized)                       =  Word8
0x87
      b (Left SubErr
SubErrTopicFilterInvalid)                  =  Word8
0x8F
      b (Left SubErr
SubErrPacketIdentifierInUse)               =  Word8
0x91
      b (Left SubErr
SubErrQuotaExceeded)                       =  Word8
0x97
      b (Left SubErr
SubErrSharedSubscriptionsNotSupported)     =  Word8
0x9E
      b (Left SubErr
SubErrSubscriptionIdentifiersNotSupported) =  Word8
0xA1
      b (Left SubErr
SubErrWildcardSubscriptionsNotSupported)   =  Word8
0xA2
      b (Right QoS
q)                                        = QoS -> Word8
qosW QoS
q

propLen :: ProtocolLevel -> [Property] -> Int
propLen :: ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
Protocol311 [Property]
_ = Int
0
propLen ProtocolLevel
prot [Property]
props    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length (ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props)

data SubErr = SubErrUnspecifiedError
  | SubErrImplementationSpecificError
  | SubErrNotAuthorized
  | SubErrTopicFilterInvalid
  | SubErrPacketIdentifierInUse
  | SubErrQuotaExceeded
  | SubErrSharedSubscriptionsNotSupported
  | SubErrSubscriptionIdentifiersNotSupported
  | SubErrWildcardSubscriptionsNotSupported
  deriving (SubErr -> SubErr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubErr -> SubErr -> Bool
$c/= :: SubErr -> SubErr -> Bool
== :: SubErr -> SubErr -> Bool
$c== :: SubErr -> SubErr -> Bool
Eq, Int -> SubErr -> ShowS
[SubErr] -> ShowS
SubErr -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubErr] -> ShowS
$cshowList :: [SubErr] -> ShowS
show :: SubErr -> [Char]
$cshow :: SubErr -> [Char]
showsPrec :: Int -> SubErr -> ShowS
$cshowsPrec :: Int -> SubErr -> ShowS
Show, SubErr
forall a. a -> a -> Bounded a
maxBound :: SubErr
$cmaxBound :: SubErr
minBound :: SubErr
$cminBound :: SubErr
Bounded, Int -> SubErr
SubErr -> Int
SubErr -> [SubErr]
SubErr -> SubErr
SubErr -> SubErr -> [SubErr]
SubErr -> SubErr -> SubErr -> [SubErr]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SubErr -> SubErr -> SubErr -> [SubErr]
$cenumFromThenTo :: SubErr -> SubErr -> SubErr -> [SubErr]
enumFromTo :: SubErr -> SubErr -> [SubErr]
$cenumFromTo :: SubErr -> SubErr -> [SubErr]
enumFromThen :: SubErr -> SubErr -> [SubErr]
$cenumFromThen :: SubErr -> SubErr -> [SubErr]
enumFrom :: SubErr -> [SubErr]
$cenumFrom :: SubErr -> [SubErr]
fromEnum :: SubErr -> Int
$cfromEnum :: SubErr -> Int
toEnum :: Int -> SubErr
$ctoEnum :: Int -> SubErr
pred :: SubErr -> SubErr
$cpred :: SubErr -> SubErr
succ :: SubErr -> SubErr
$csucc :: SubErr -> SubErr
Enum)

parseSubACK :: ProtocolLevel -> A.Parser MQTTPkt
parseSubACK :: ProtocolLevel -> Parser MQTTPkt
parseSubACK ProtocolLevel
prot = do
  (Word16
pid, [Property]
props, [Either SubErr QoS]
res) <- forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
0x90 ProtocolLevel
prot forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Word8 -> Either SubErr QoS
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SubscribeResponse -> MQTTPkt
SubACKPkt (Word16 -> [Either SubErr QoS] -> [Property] -> SubscribeResponse
SubscribeResponse Word16
pid [Either SubErr QoS]
res [Property]
props)

  where
    p :: Word8 -> Either SubErr QoS
p Word8
0x80 = forall a b. a -> Either a b
Left SubErr
SubErrUnspecifiedError
    p Word8
0x83 = forall a b. a -> Either a b
Left SubErr
SubErrImplementationSpecificError
    p Word8
0x87 = forall a b. a -> Either a b
Left SubErr
SubErrNotAuthorized
    p Word8
0x8F = forall a b. a -> Either a b
Left SubErr
SubErrTopicFilterInvalid
    p Word8
0x91 = forall a b. a -> Either a b
Left SubErr
SubErrPacketIdentifierInUse
    p Word8
0x97 = forall a b. a -> Either a b
Left SubErr
SubErrQuotaExceeded
    p Word8
0x9E = forall a b. a -> Either a b
Left SubErr
SubErrSharedSubscriptionsNotSupported
    p Word8
0xA1 = forall a b. a -> Either a b
Left SubErr
SubErrSubscriptionIdentifiersNotSupported
    p Word8
0xA2 = forall a b. a -> Either a b
Left SubErr
SubErrWildcardSubscriptionsNotSupported
    p Word8
x    = forall a b. b -> Either a b
Right (Word8 -> QoS
wQos Word8
x)

data UnsubscribeRequest = UnsubscribeRequest PktID [BL.ByteString] [Property]
                        deriving(UnsubscribeRequest -> UnsubscribeRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
$c/= :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
== :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
$c== :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
Eq, Int -> UnsubscribeRequest -> ShowS
[UnsubscribeRequest] -> ShowS
UnsubscribeRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UnsubscribeRequest] -> ShowS
$cshowList :: [UnsubscribeRequest] -> ShowS
show :: UnsubscribeRequest -> [Char]
$cshow :: UnsubscribeRequest -> [Char]
showsPrec :: Int -> UnsubscribeRequest -> ShowS
$cshowsPrec :: Int -> UnsubscribeRequest -> ShowS
Show)

instance ByteMe UnsubscribeRequest where
  toByteString :: ProtocolLevel -> UnsubscribeRequest -> ByteString
toByteString ProtocolLevel
prot (UnsubscribeRequest Word16
pid [ByteString]
sreq [Property]
props) =
    Word8 -> ByteString
BL.singleton Word8
0xa2
    forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
sreq))

parseUnsubscribe :: ProtocolLevel -> A.Parser MQTTPkt
parseUnsubscribe :: ProtocolLevel -> Parser MQTTPkt
parseUnsubscribe ProtocolLevel
prot = do
  (Word16
pid, [Property]
props, [ByteString]
subs) <- forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
0xa2 ProtocolLevel
prot forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser ByteString
aString
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UnsubscribeRequest -> MQTTPkt
UnsubscribePkt (Word16 -> [ByteString] -> [Property] -> UnsubscribeRequest
UnsubscribeRequest Word16
pid [ByteString]
subs [Property]
props)

data UnsubStatus = UnsubSuccess
                 | UnsubNoSubscriptionExisted
                 | UnsubUnspecifiedError
                 | UnsubImplementationSpecificError
                 | UnsubNotAuthorized
                 | UnsubTopicFilterInvalid
                 | UnsubPacketIdentifierInUse
                 deriving(Int -> UnsubStatus -> ShowS
[UnsubStatus] -> ShowS
UnsubStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UnsubStatus] -> ShowS
$cshowList :: [UnsubStatus] -> ShowS
show :: UnsubStatus -> [Char]
$cshow :: UnsubStatus -> [Char]
showsPrec :: Int -> UnsubStatus -> ShowS
$cshowsPrec :: Int -> UnsubStatus -> ShowS
Show, UnsubStatus -> UnsubStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsubStatus -> UnsubStatus -> Bool
$c/= :: UnsubStatus -> UnsubStatus -> Bool
== :: UnsubStatus -> UnsubStatus -> Bool
$c== :: UnsubStatus -> UnsubStatus -> Bool
Eq, UnsubStatus
forall a. a -> a -> Bounded a
maxBound :: UnsubStatus
$cmaxBound :: UnsubStatus
minBound :: UnsubStatus
$cminBound :: UnsubStatus
Bounded, Int -> UnsubStatus
UnsubStatus -> Int
UnsubStatus -> [UnsubStatus]
UnsubStatus -> UnsubStatus
UnsubStatus -> UnsubStatus -> [UnsubStatus]
UnsubStatus -> UnsubStatus -> UnsubStatus -> [UnsubStatus]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UnsubStatus -> UnsubStatus -> UnsubStatus -> [UnsubStatus]
$cenumFromThenTo :: UnsubStatus -> UnsubStatus -> UnsubStatus -> [UnsubStatus]
enumFromTo :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
$cenumFromTo :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
enumFromThen :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
$cenumFromThen :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
enumFrom :: UnsubStatus -> [UnsubStatus]
$cenumFrom :: UnsubStatus -> [UnsubStatus]
fromEnum :: UnsubStatus -> Int
$cfromEnum :: UnsubStatus -> Int
toEnum :: Int -> UnsubStatus
$ctoEnum :: Int -> UnsubStatus
pred :: UnsubStatus -> UnsubStatus
$cpred :: UnsubStatus -> UnsubStatus
succ :: UnsubStatus -> UnsubStatus
$csucc :: UnsubStatus -> UnsubStatus
Enum)

instance ByteMe UnsubStatus where
  toByteString :: ProtocolLevel -> UnsubStatus -> ByteString
toByteString ProtocolLevel
_ UnsubStatus
UnsubSuccess                     = Word8 -> ByteString
BL.singleton Word8
0x00
  toByteString ProtocolLevel
_ UnsubStatus
UnsubNoSubscriptionExisted       = Word8 -> ByteString
BL.singleton Word8
0x11
  toByteString ProtocolLevel
_ UnsubStatus
UnsubUnspecifiedError            = Word8 -> ByteString
BL.singleton Word8
0x80
  toByteString ProtocolLevel
_ UnsubStatus
UnsubImplementationSpecificError = Word8 -> ByteString
BL.singleton Word8
0x83
  toByteString ProtocolLevel
_ UnsubStatus
UnsubNotAuthorized               = Word8 -> ByteString
BL.singleton Word8
0x87
  toByteString ProtocolLevel
_ UnsubStatus
UnsubTopicFilterInvalid          = Word8 -> ByteString
BL.singleton Word8
0x8F
  toByteString ProtocolLevel
_ UnsubStatus
UnsubPacketIdentifierInUse       = Word8 -> ByteString
BL.singleton Word8
0x91

data UnsubscribeResponse = UnsubscribeResponse PktID [Property] [UnsubStatus] deriving(UnsubscribeResponse -> UnsubscribeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
$c/= :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
== :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
$c== :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
Eq, Int -> UnsubscribeResponse -> ShowS
[UnsubscribeResponse] -> ShowS
UnsubscribeResponse -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UnsubscribeResponse] -> ShowS
$cshowList :: [UnsubscribeResponse] -> ShowS
show :: UnsubscribeResponse -> [Char]
$cshow :: UnsubscribeResponse -> [Char]
showsPrec :: Int -> UnsubscribeResponse -> ShowS
$cshowsPrec :: Int -> UnsubscribeResponse -> ShowS
Show)

instance ByteMe UnsubscribeResponse where
  toByteString :: ProtocolLevel -> UnsubscribeResponse -> ByteString
toByteString ProtocolLevel
Protocol311 (UnsubscribeResponse Word16
pid [Property]
_ [UnsubStatus]
_) =
    Word8 -> ByteString
BL.singleton Word8
0xb0 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid)

  toByteString ProtocolLevel
Protocol50 (UnsubscribeResponse Word16
pid [Property]
props [UnsubStatus]
res) =
    Word8 -> ByteString
BL.singleton Word8
0xb0 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid
                                      forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
Protocol50 [Property]
props
                                      forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
Protocol50) [UnsubStatus]
res))

parseUnsubACK :: ProtocolLevel -> A.Parser MQTTPkt
parseUnsubACK :: ProtocolLevel -> Parser MQTTPkt
parseUnsubACK ProtocolLevel
Protocol311 = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
0xb0
  Int
_ <- Parser Int
parseHdrLen
  Word16
pid <- Parser Word16
aWord16
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UnsubscribeResponse -> MQTTPkt
UnsubACKPkt (Word16 -> [Property] -> [UnsubStatus] -> UnsubscribeResponse
UnsubscribeResponse Word16
pid forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)

parseUnsubACK ProtocolLevel
Protocol50 = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
0xb0
  Int
rl <- Parser Int
parseHdrLen
  Word16
pid <- Parser Word16
aWord16
  [Property]
props <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50
  [UnsubStatus]
res <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
rl forall a. Num a => a -> a -> a
- ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
Protocol50 [Property]
props forall a. Num a => a -> a -> a
- Int
2) Parser UnsubStatus
unsubACK
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UnsubscribeResponse -> MQTTPkt
UnsubACKPkt (Word16 -> [Property] -> [UnsubStatus] -> UnsubscribeResponse
UnsubscribeResponse Word16
pid [Property]
props [UnsubStatus]
res)

  where
    unsubACK :: A.Parser UnsubStatus
    unsubACK :: Parser UnsubStatus
unsubACK = (UnsubStatus
UnsubSuccess forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x00)
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubStatus
UnsubNoSubscriptionExisted forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x11)
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubStatus
UnsubUnspecifiedError forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x80)
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubStatus
UnsubImplementationSpecificError forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x83)
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubStatus
UnsubNotAuthorized forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x87)
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubStatus
UnsubTopicFilterInvalid forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x8F)
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnsubStatus
UnsubPacketIdentifierInUse forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
A.word8 Word8
0x91)

data AuthRequest = AuthRequest Word8 [Property] deriving (AuthRequest -> AuthRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthRequest -> AuthRequest -> Bool
$c/= :: AuthRequest -> AuthRequest -> Bool
== :: AuthRequest -> AuthRequest -> Bool
$c== :: AuthRequest -> AuthRequest -> Bool
Eq, Int -> AuthRequest -> ShowS
[AuthRequest] -> ShowS
AuthRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AuthRequest] -> ShowS
$cshowList :: [AuthRequest] -> ShowS
show :: AuthRequest -> [Char]
$cshow :: AuthRequest -> [Char]
showsPrec :: Int -> AuthRequest -> ShowS
$cshowsPrec :: Int -> AuthRequest -> ShowS
Show)

instance ByteMe AuthRequest where
  toByteString :: ProtocolLevel -> AuthRequest -> ByteString
toByteString ProtocolLevel
prot (AuthRequest Word8
i [Property]
props) =
    Word8 -> ByteString
BL.singleton Word8
0xf0 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word8 -> ByteString
BL.singleton Word8
i forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props)

parseAuth :: A.Parser MQTTPkt
parseAuth :: Parser MQTTPkt
parseAuth = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
0xf0
  Int
_ <- Parser Int
parseHdrLen
  AuthRequest
r <- Word8 -> [Property] -> AuthRequest
AuthRequest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AuthRequest -> MQTTPkt
AuthPkt AuthRequest
r

data DiscoReason = DiscoNormalDisconnection
  | DiscoDisconnectWithWill
  | DiscoUnspecifiedError
  | DiscoMalformedPacket
  | DiscoProtocolError
  | DiscoImplementationSpecificError
  | DiscoNotAuthorized
  | DiscoServerBusy
  | DiscoServershuttingDown
  | DiscoKeepAliveTimeout
  | DiscoSessiontakenOver
  | DiscoTopicFilterInvalid
  | DiscoTopicNameInvalid
  | DiscoReceiveMaximumExceeded
  | DiscoTopicAliasInvalid
  | DiscoPacketTooLarge
  | DiscoMessageRateTooHigh
  | DiscoQuotaExceeded
  | DiscoAdministrativeAction
  | DiscoPayloadFormatInvalid
  | DiscoRetainNotSupported
  | DiscoQoSNotSupported
  | DiscoUseAnotherServer
  | DiscoServerMoved
  | DiscoSharedSubscriptionsNotSupported
  | DiscoConnectionRateExceeded
  | DiscoMaximumConnectTime
  | DiscoSubscriptionIdentifiersNotSupported
  | DiscoWildcardSubscriptionsNotSupported
  deriving (Int -> DiscoReason -> ShowS
[DiscoReason] -> ShowS
DiscoReason -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DiscoReason] -> ShowS
$cshowList :: [DiscoReason] -> ShowS
show :: DiscoReason -> [Char]
$cshow :: DiscoReason -> [Char]
showsPrec :: Int -> DiscoReason -> ShowS
$cshowsPrec :: Int -> DiscoReason -> ShowS
Show, DiscoReason -> DiscoReason -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiscoReason -> DiscoReason -> Bool
$c/= :: DiscoReason -> DiscoReason -> Bool
== :: DiscoReason -> DiscoReason -> Bool
$c== :: DiscoReason -> DiscoReason -> Bool
Eq, DiscoReason
forall a. a -> a -> Bounded a
maxBound :: DiscoReason
$cmaxBound :: DiscoReason
minBound :: DiscoReason
$cminBound :: DiscoReason
Bounded, Int -> DiscoReason
DiscoReason -> Int
DiscoReason -> [DiscoReason]
DiscoReason -> DiscoReason
DiscoReason -> DiscoReason -> [DiscoReason]
DiscoReason -> DiscoReason -> DiscoReason -> [DiscoReason]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DiscoReason -> DiscoReason -> DiscoReason -> [DiscoReason]
$cenumFromThenTo :: DiscoReason -> DiscoReason -> DiscoReason -> [DiscoReason]
enumFromTo :: DiscoReason -> DiscoReason -> [DiscoReason]
$cenumFromTo :: DiscoReason -> DiscoReason -> [DiscoReason]
enumFromThen :: DiscoReason -> DiscoReason -> [DiscoReason]
$cenumFromThen :: DiscoReason -> DiscoReason -> [DiscoReason]
enumFrom :: DiscoReason -> [DiscoReason]
$cenumFrom :: DiscoReason -> [DiscoReason]
fromEnum :: DiscoReason -> Int
$cfromEnum :: DiscoReason -> Int
toEnum :: Int -> DiscoReason
$ctoEnum :: Int -> DiscoReason
pred :: DiscoReason -> DiscoReason
$cpred :: DiscoReason -> DiscoReason
succ :: DiscoReason -> DiscoReason
$csucc :: DiscoReason -> DiscoReason
Enum)

instance ByteSize DiscoReason where

  toByte :: DiscoReason -> Word8
toByte DiscoReason
DiscoNormalDisconnection                 = Word8
0x00
  toByte DiscoReason
DiscoDisconnectWithWill                  = Word8
0x04
  toByte DiscoReason
DiscoUnspecifiedError                    = Word8
0x80
  toByte DiscoReason
DiscoMalformedPacket                     = Word8
0x81
  toByte DiscoReason
DiscoProtocolError                       = Word8
0x82
  toByte DiscoReason
DiscoImplementationSpecificError         = Word8
0x83
  toByte DiscoReason
DiscoNotAuthorized                       = Word8
0x87
  toByte DiscoReason
DiscoServerBusy                          = Word8
0x89
  toByte DiscoReason
DiscoServershuttingDown                  = Word8
0x8B
  toByte DiscoReason
DiscoKeepAliveTimeout                    = Word8
0x8D
  toByte DiscoReason
DiscoSessiontakenOver                    = Word8
0x8e
  toByte DiscoReason
DiscoTopicFilterInvalid                  = Word8
0x8f
  toByte DiscoReason
DiscoTopicNameInvalid                    = Word8
0x90
  toByte DiscoReason
DiscoReceiveMaximumExceeded              = Word8
0x93
  toByte DiscoReason
DiscoTopicAliasInvalid                   = Word8
0x94
  toByte DiscoReason
DiscoPacketTooLarge                      = Word8
0x95
  toByte DiscoReason
DiscoMessageRateTooHigh                  = Word8
0x96
  toByte DiscoReason
DiscoQuotaExceeded                       = Word8
0x97
  toByte DiscoReason
DiscoAdministrativeAction                = Word8
0x98
  toByte DiscoReason
DiscoPayloadFormatInvalid                = Word8
0x99
  toByte DiscoReason
DiscoRetainNotSupported                  = Word8
0x9a
  toByte DiscoReason
DiscoQoSNotSupported                     = Word8
0x9b
  toByte DiscoReason
DiscoUseAnotherServer                    = Word8
0x9c
  toByte DiscoReason
DiscoServerMoved                         = Word8
0x9d
  toByte DiscoReason
DiscoSharedSubscriptionsNotSupported     = Word8
0x9e
  toByte DiscoReason
DiscoConnectionRateExceeded              = Word8
0x9f
  toByte DiscoReason
DiscoMaximumConnectTime                  = Word8
0xa0
  toByte DiscoReason
DiscoSubscriptionIdentifiersNotSupported = Word8
0xa1
  toByte DiscoReason
DiscoWildcardSubscriptionsNotSupported   = Word8
0xa2

  fromByte :: Word8 -> DiscoReason
fromByte Word8
w = forall a. a -> Maybe a -> a
fromMaybe DiscoReason
DiscoMalformedPacket forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
w [(Word8, DiscoReason)]
discoReasonRev

discoReasonRev :: [(Word8, DiscoReason)]
discoReasonRev :: [(Word8, DiscoReason)]
discoReasonRev = forall a b. (a -> b) -> [a] -> [b]
map (\DiscoReason
w -> (forall a. ByteSize a => a -> Word8
toByte DiscoReason
w, DiscoReason
w)) [forall a. Bounded a => a
minBound..]

data DisconnectRequest = DisconnectRequest DiscoReason [Property] deriving (DisconnectRequest -> DisconnectRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisconnectRequest -> DisconnectRequest -> Bool
$c/= :: DisconnectRequest -> DisconnectRequest -> Bool
== :: DisconnectRequest -> DisconnectRequest -> Bool
$c== :: DisconnectRequest -> DisconnectRequest -> Bool
Eq, Int -> DisconnectRequest -> ShowS
[DisconnectRequest] -> ShowS
DisconnectRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DisconnectRequest] -> ShowS
$cshowList :: [DisconnectRequest] -> ShowS
show :: DisconnectRequest -> [Char]
$cshow :: DisconnectRequest -> [Char]
showsPrec :: Int -> DisconnectRequest -> ShowS
$cshowsPrec :: Int -> DisconnectRequest -> ShowS
Show)

instance ByteMe DisconnectRequest where
  toByteString :: ProtocolLevel -> DisconnectRequest -> ByteString
toByteString ProtocolLevel
Protocol311 DisconnectRequest
_ = ByteString
"\224\NUL"

  toByteString ProtocolLevel
Protocol50 (DisconnectRequest DiscoReason
r [Property]
props) =
    Word8 -> ByteString
BL.singleton Word8
0xe0 forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word8 -> ByteString
BL.singleton (forall a. ByteSize a => a -> Word8
toByte DiscoReason
r) forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
Protocol50 [Property]
props)

parseDisconnect :: ProtocolLevel -> A.Parser MQTTPkt
parseDisconnect :: ProtocolLevel -> Parser MQTTPkt
parseDisconnect ProtocolLevel
Protocol311 = do
  DisconnectRequest
req <- DiscoReason -> [Property] -> DisconnectRequest
DisconnectRequest DiscoReason
DiscoNormalDisconnection forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
A.string ByteString
"\224\NUL"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DisconnectRequest -> MQTTPkt
DisconnectPkt DisconnectRequest
req

parseDisconnect ProtocolLevel
Protocol50 = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
0xe0
  Int
rl <- Parser Int
parseHdrLen
  Word8
r <- Parser Word8
A.anyWord8
  [Property]
props <- if Int
rl forall a. Ord a => a -> a -> Bool
> Int
1 then ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50 else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DisconnectRequest -> MQTTPkt
DisconnectPkt (DiscoReason -> [Property] -> DisconnectRequest
DisconnectRequest (forall a. ByteSize a => Word8 -> a
fromByte Word8
r) [Property]
props)