{-|
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.Foldable                   (asum)
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
QoS -> QoS -> Bounded QoS
forall a. a -> a -> Bounded a
$cminBound :: QoS
minBound :: QoS
$cmaxBound :: QoS
maxBound :: QoS
Bounded, Int -> QoS
QoS -> Int
QoS -> [QoS]
QoS -> QoS
QoS -> QoS -> [QoS]
QoS -> QoS -> QoS -> [QoS]
(QoS -> QoS)
-> (QoS -> QoS)
-> (Int -> QoS)
-> (QoS -> Int)
-> (QoS -> [QoS])
-> (QoS -> QoS -> [QoS])
-> (QoS -> QoS -> [QoS])
-> (QoS -> QoS -> QoS -> [QoS])
-> Enum 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
$csucc :: QoS -> QoS
succ :: QoS -> QoS
$cpred :: QoS -> QoS
pred :: QoS -> QoS
$ctoEnum :: Int -> QoS
toEnum :: Int -> QoS
$cfromEnum :: QoS -> Int
fromEnum :: QoS -> Int
$cenumFrom :: QoS -> [QoS]
enumFrom :: QoS -> [QoS]
$cenumFromThen :: QoS -> QoS -> [QoS]
enumFromThen :: QoS -> QoS -> [QoS]
$cenumFromTo :: QoS -> QoS -> [QoS]
enumFromTo :: QoS -> QoS -> [QoS]
$cenumFromThenTo :: QoS -> QoS -> QoS -> [QoS]
enumFromThenTo :: QoS -> QoS -> QoS -> [QoS]
Enum, QoS -> QoS -> Bool
(QoS -> QoS -> Bool) -> (QoS -> QoS -> Bool) -> Eq QoS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QoS -> QoS -> Bool
== :: QoS -> QoS -> Bool
$c/= :: QoS -> QoS -> Bool
/= :: QoS -> QoS -> Bool
Eq, Int -> QoS -> ShowS
[QoS] -> ShowS
QoS -> [Char]
(Int -> QoS -> ShowS)
-> (QoS -> [Char]) -> ([QoS] -> ShowS) -> Show QoS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QoS -> ShowS
showsPrec :: Int -> QoS -> ShowS
$cshow :: QoS -> [Char]
show :: QoS -> [Char]
$cshowList :: [QoS] -> ShowS
showList :: [QoS] -> ShowS
Show, Eq QoS
Eq QoS =>
(QoS -> QoS -> Ordering)
-> (QoS -> QoS -> Bool)
-> (QoS -> QoS -> Bool)
-> (QoS -> QoS -> Bool)
-> (QoS -> QoS -> Bool)
-> (QoS -> QoS -> QoS)
-> (QoS -> QoS -> QoS)
-> Ord 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
$ccompare :: QoS -> QoS -> Ordering
compare :: QoS -> QoS -> Ordering
$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
>= :: QoS -> QoS -> Bool
$cmax :: QoS -> QoS -> QoS
max :: QoS -> QoS -> QoS
$cmin :: QoS -> QoS -> QoS
min :: QoS -> QoS -> QoS
Ord)

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

wQos :: Word8 -> QoS
wQos :: Word8 -> QoS
wQos = Int -> QoS
forall a. Enum a => Int -> a
toEnum (Int -> QoS) -> (Word8 -> Int) -> Word8 -> QoS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
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 = QoS -> Maybe QoS
forall a. a -> Maybe a
Just QoS
QoS0
qosFromInt Int
1 = QoS -> Maybe QoS
forall a. a -> Maybe a
Just QoS
QoS1
qosFromInt Int
2 = QoS -> Maybe QoS
forall a. a -> Maybe a
Just QoS
QoS2
qosFromInt Int
_ = Maybe QoS
forall a. Maybe a
Nothing

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

(≪) :: Bits a => a -> Int -> a
≪ :: forall a. Bits a => a -> Int -> 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 (ByteString -> [Word8]) -> (a -> ByteString) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolLevel -> a -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p

  toByteString :: ProtocolLevel -> a -> BL.ByteString
  toByteString ProtocolLevel
p = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> (a -> [Word8]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolLevel -> a -> [Word8]
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 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
127) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v
      if Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
128 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
        then Int -> Int -> Parser Int
go Int
a (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
128)
        else Int -> Parser Int
forall a. a -> Parser ByteString a
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 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
128)
  where
    go :: (Int, Int) -> [Word8]
go (Int
x,Int
e)
      | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Word8
en (Int
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
128) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (Int, Int) -> [Word8]
go (Int
x Int -> Int -> (Int, Int)
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 = Int -> Word8
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 Word16 -> Word16 -> (Word16, Word16)
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 = Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Word16 -> Int) -> Word16 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

encodeWord32 :: Word32 -> BL.ByteString
encodeWord32 :: Word32 -> ByteString
encodeWord32 = Put -> ByteString
runPut (Put -> ByteString) -> (Word32 -> Put) -> Word32 -> ByteString
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 ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
encodeUTF8 ByteString
y

twoByteLen :: BL.ByteString -> BL.ByteString
twoByteLen :: ByteString -> ByteString
twoByteLen = Word16 -> ByteString
encodeWord16 (Word16 -> ByteString)
-> (ByteString -> Word16) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> (ByteString -> Int64) -> ByteString -> Word16
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 ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8]
encodeVarInt (Int -> [Word8]) -> (ByteString -> Int) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (ByteString -> Int64) -> ByteString -> Int
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 ByteString -> ByteString -> ByteString
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 (Word16 -> ByteString)
-> (ByteString -> Word16) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> (ByteString -> Int64) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length) ByteString
a ByteString -> ByteString -> ByteString
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]
(Int -> Property -> ShowS)
-> (Property -> [Char]) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> [Char]
show :: Property -> [Char]
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq)

peW8 :: Word8 -> Word8 -> BL.ByteString
peW8 :: Word8 -> Word8 -> ByteString
peW8 Word8
i Word8
x = Word8 -> ByteString
BL.singleton Word8
i ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ([Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> (Int -> [Word8]) -> Int -> ByteString
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 ByteString -> ByteString -> ByteString
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

oneOf :: [(Word8, p)] -> A.Parser p
oneOf :: forall p. [(Word8, p)] -> Parser p
oneOf = [Parser ByteString p] -> Parser ByteString p
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ByteString p] -> Parser ByteString p)
-> ([(Word8, p)] -> [Parser ByteString p])
-> [(Word8, p)]
-> Parser ByteString p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8, p) -> Parser ByteString p)
-> [(Word8, p)] -> [Parser ByteString p]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Word8
w, p
p) -> Word8 -> Parser Word8
A.word8 Word8
w Parser Word8 -> p -> Parser ByteString p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
p)

oneOfp :: [(Word8, A.Parser p)] -> A.Parser p
oneOfp :: forall p. [(Word8, Parser p)] -> Parser p
oneOfp = [Parser ByteString p] -> Parser ByteString p
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser ByteString p] -> Parser ByteString p)
-> ([(Word8, Parser ByteString p)] -> [Parser ByteString p])
-> [(Word8, Parser ByteString p)]
-> Parser ByteString p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8, Parser ByteString p) -> Parser ByteString p)
-> [(Word8, Parser ByteString p)] -> [Parser ByteString p]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Word8
b,Parser ByteString p
p) -> Word8 -> Parser Word8
A.word8 Word8
b Parser Word8 -> Parser ByteString p -> Parser ByteString p
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString p
p)

parseProperty :: A.Parser Property
parseProperty :: Parser Property
parseProperty = [(Word8, Parser Property)] -> Parser Property
forall p. [(Word8, Parser p)] -> Parser p
oneOfp [ (Word8
0x01, Word8 -> Property
PropPayloadFormatIndicator (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x02, Word32 -> Property
PropMessageExpiryInterval (Word32 -> Property) -> Parser ByteString Word32 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word32
aWord32),
                         (Word8
0x03, ByteString -> Property
PropContentType (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x08, ByteString -> Property
PropResponseTopic (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x09, ByteString -> Property
PropCorrelationData (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x0b, Int -> Property
PropSubscriptionIdentifier (Int -> Property) -> Parser Int -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
decodeVarInt),
                         (Word8
0x11, Word32 -> Property
PropSessionExpiryInterval (Word32 -> Property) -> Parser ByteString Word32 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word32
aWord32),
                         (Word8
0x12, ByteString -> Property
PropAssignedClientIdentifier (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x13, Word16 -> Property
PropServerKeepAlive (Word16 -> Property) -> Parser ByteString Word16 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
aWord16),
                         (Word8
0x15, ByteString -> Property
PropAuthenticationMethod (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x16, ByteString -> Property
PropAuthenticationData (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x17, Word8 -> Property
PropRequestProblemInformation (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x18, Word32 -> Property
PropWillDelayInterval (Word32 -> Property) -> Parser ByteString Word32 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word32
aWord32),
                         (Word8
0x19, Word8 -> Property
PropRequestResponseInformation (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x1a, ByteString -> Property
PropResponseInformation (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x1c, ByteString -> Property
PropServerReference (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x1f, ByteString -> Property
PropReasonString (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString),
                         (Word8
0x21, Word16 -> Property
PropReceiveMaximum (Word16 -> Property) -> Parser ByteString Word16 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
aWord16),
                         (Word8
0x22, Word16 -> Property
PropTopicAliasMaximum (Word16 -> Property) -> Parser ByteString Word16 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
aWord16),
                         (Word8
0x23, Word16 -> Property
PropTopicAlias (Word16 -> Property) -> Parser ByteString Word16 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
aWord16),
                         (Word8
0x24, Word8 -> Property
PropMaximumQoS (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x25, Word8 -> Property
PropRetainAvailable (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x26, ByteString -> ByteString -> Property
PropUserProperty (ByteString -> ByteString -> Property)
-> Parser ByteString ByteString
-> Parser ByteString (ByteString -> Property)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString Parser ByteString (ByteString -> Property)
-> Parser ByteString ByteString -> Parser Property
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
aString),
                         (Word8
0x27, Word32 -> Property
PropMaximumPacketSize (Word32 -> Property) -> Parser ByteString Word32 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word32
aWord32),
                         (Word8
0x28, Word8 -> Property
PropWildcardSubscriptionAvailable (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x29, Word8 -> Property
PropSubscriptionIdentifierAvailable (Word8 -> Property) -> Parser Word8 -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8),
                         (Word8
0x2a, Word8 -> Property
PropSharedSubscriptionAvailable (Word8 -> Property) -> Parser Word8 -> Parser Property
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 = ByteString -> [Property] -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty
bsProps ProtocolLevel
p = ByteString -> ByteString
withLength (ByteString -> ByteString)
-> ([Property] -> ByteString) -> [Property] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> ByteString) -> [Property] -> ByteString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ProtocolLevel -> Property -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p)


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

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

connectRequest :: ConnectRequest
connectRequest :: ConnectRequest
connectRequest = ConnectRequest{_username :: Maybe ByteString
_username=Maybe ByteString
forall a. Maybe a
Nothing, _password :: Maybe ByteString
_password=Maybe ByteString
forall a. Maybe a
Nothing, _lastWill :: Maybe LastWill
_lastWill=Maybe LastWill
forall a. Maybe a
Nothing,
                                _cleanSession :: Bool
_cleanSession=Bool
True, _keepAlive :: Word16
_keepAlive=Word16
300, _connID :: ByteString
_connID=ByteString
"",
                                _connProperties :: [Property]
_connProperties=[Property]
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
_username :: ConnectRequest -> Maybe ByteString
_password :: ConnectRequest -> Maybe ByteString
_lastWill :: ConnectRequest -> Maybe LastWill
_cleanSession :: ConnectRequest -> Bool
_keepAlive :: ConnectRequest -> Word16
_connID :: ConnectRequest -> ByteString
_connProperties :: ConnectRequest -> [Property]
_username :: Maybe ByteString
_password :: Maybe ByteString
_lastWill :: Maybe LastWill
_cleanSession :: Bool
_keepAlive :: Word16
_connID :: ByteString
_connProperties :: [Property]
..} = Word8 -> ByteString
BL.singleton Word8
0x10 ByteString -> ByteString -> ByteString
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
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
connBits
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
encodeWord16 Word16
_keepAlive
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> ByteString -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_connID
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe LastWill -> ByteString
lwt Maybe LastWill
_lastWill
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> ByteString
perhaps Maybe ByteString
_username
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> if Maybe ByteString -> Bool
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
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
connBits
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
encodeWord16 Word16
_keepAlive
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
_connProperties
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> ByteString -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_connID
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe LastWill -> ByteString
lwt Maybe LastWill
_lastWill
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> ByteString
perhaps Maybe ByteString
_username
                       ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe ByteString -> ByteString
perhaps Maybe ByteString
_password

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

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

      perhaps :: Maybe BL.ByteString -> BL.ByteString
      perhaps :: Maybe ByteString -> ByteString
perhaps = ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (ProtocolLevel -> ByteString -> 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
(MQTTPkt -> MQTTPkt -> Bool)
-> (MQTTPkt -> MQTTPkt -> Bool) -> Eq MQTTPkt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MQTTPkt -> MQTTPkt -> Bool
== :: MQTTPkt -> MQTTPkt -> Bool
$c/= :: MQTTPkt -> MQTTPkt -> Bool
/= :: MQTTPkt -> MQTTPkt -> Bool
Eq, Int -> MQTTPkt -> ShowS
[MQTTPkt] -> ShowS
MQTTPkt -> [Char]
(Int -> MQTTPkt -> ShowS)
-> (MQTTPkt -> [Char]) -> ([MQTTPkt] -> ShowS) -> Show MQTTPkt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MQTTPkt -> ShowS
showsPrec :: Int -> MQTTPkt -> ShowS
$cshow :: MQTTPkt -> [Char]
show :: MQTTPkt -> [Char]
$cshowList :: [MQTTPkt] -> ShowS
showList :: [MQTTPkt] -> ShowS
Show)

instance ByteMe MQTTPkt where
  toByteString :: ProtocolLevel -> MQTTPkt -> ByteString
toByteString ProtocolLevel
p (ConnPkt ConnectRequest
x ProtocolLevel
_)      = ProtocolLevel -> ConnectRequest -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p ConnectRequest
x
  toByteString ProtocolLevel
p (ConnACKPkt ConnACKFlags
x)     = ProtocolLevel -> ConnACKFlags -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p ConnACKFlags
x
  toByteString ProtocolLevel
p (PublishPkt PublishRequest
x)     = ProtocolLevel -> PublishRequest -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PublishRequest
x
  toByteString ProtocolLevel
p (PubACKPkt PubACK
x)      = ProtocolLevel -> PubACK -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubACK
x
  toByteString ProtocolLevel
p (PubRELPkt PubREL
x)      = ProtocolLevel -> PubREL -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubREL
x
  toByteString ProtocolLevel
p (PubRECPkt PubREC
x)      = ProtocolLevel -> PubREC -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubREC
x
  toByteString ProtocolLevel
p (PubCOMPPkt PubCOMP
x)     = ProtocolLevel -> PubCOMP -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p PubCOMP
x
  toByteString ProtocolLevel
p (SubscribePkt SubscribeRequest
x)   = ProtocolLevel -> SubscribeRequest -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p SubscribeRequest
x
  toByteString ProtocolLevel
p (SubACKPkt SubscribeResponse
x)      = ProtocolLevel -> SubscribeResponse -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p SubscribeResponse
x
  toByteString ProtocolLevel
p (UnsubscribePkt UnsubscribeRequest
x) = ProtocolLevel -> UnsubscribeRequest -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p UnsubscribeRequest
x
  toByteString ProtocolLevel
p (UnsubACKPkt UnsubscribeResponse
x)    = ProtocolLevel -> UnsubscribeResponse -> ByteString
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)  = ProtocolLevel -> DisconnectRequest -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
p DisconnectRequest
x
  toByteString ProtocolLevel
p (AuthPkt AuthRequest
x)        = ProtocolLevel -> AuthRequest -> ByteString
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] -> Parser MQTTPkt
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Parser MQTTPkt
parseConnect, Parser MQTTPkt
parseConnectACK,
                      ProtocolLevel -> Parser MQTTPkt
parsePublish ProtocolLevel
p, Parser MQTTPkt
parsePubACK,
                      Parser MQTTPkt
parsePubREC, Parser MQTTPkt
parsePubREL, Parser MQTTPkt
parsePubCOMP,
                      ProtocolLevel -> Parser MQTTPkt
parseSubscribe ProtocolLevel
p, ProtocolLevel -> Parser MQTTPkt
parseSubACK ProtocolLevel
p,
                      ProtocolLevel -> Parser MQTTPkt
parseUnsubscribe ProtocolLevel
p, ProtocolLevel -> Parser MQTTPkt
parseUnsubACK ProtocolLevel
p,
                      MQTTPkt
PingPkt MQTTPkt -> Parser ByteString ByteString -> Parser MQTTPkt
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
A.string ByteString
"\192\NUL", MQTTPkt
PongPkt MQTTPkt -> Parser ByteString ByteString -> Parser MQTTPkt
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
A.string ByteString
"\208\NUL",
                      ProtocolLevel -> Parser MQTTPkt
parseDisconnect ProtocolLevel
p,
                      Parser MQTTPkt
parseAuth]

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

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

aString :: A.Parser BL.ByteString
aString :: Parser ByteString ByteString
aString = (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.fromStrict (Parser ByteString ByteString -> Parser ByteString ByteString)
-> (Word16 -> Parser ByteString ByteString)
-> Word16
-> Parser ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser ByteString ByteString
A.take (Int -> Parser ByteString ByteString)
-> (Word16 -> Int) -> Word16 -> Parser ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Parser ByteString ByteString)
-> Parser ByteString Word16 -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString Word16
aWord16

-- | 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 ByteString
A.string ByteString
"\NUL\EOTMQTT" -- "MQTT"
  ProtocolLevel
pl <- Parser ByteString ProtocolLevel
parseLevel

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

  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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=Word8 -> Int -> Bool
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 = Maybe ByteString -> Parser (Maybe ByteString)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
    mstr Bool
True  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString ByteString -> Parser (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
aString

    parseLevel :: Parser ByteString ProtocolLevel
parseLevel = ByteString -> Parser ByteString ByteString
A.string ByteString
"\EOT" Parser ByteString ByteString
-> ProtocolLevel -> Parser ByteString ProtocolLevel
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ProtocolLevel
Protocol311
                 Parser ByteString ProtocolLevel
-> Parser ByteString ProtocolLevel
-> Parser ByteString ProtocolLevel
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
A.string ByteString
"\ENQ" Parser ByteString ByteString
-> ProtocolLevel -> Parser ByteString ProtocolLevel
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
      | Word8 -> Int -> Bool
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 ByteString
aString
          ByteString
msg <- Parser ByteString ByteString
aString
          Maybe LastWill -> Parser ByteString (Maybe LastWill)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LastWill -> Parser ByteString (Maybe LastWill))
-> Maybe LastWill -> Parser ByteString (Maybe LastWill)
forall a b. (a -> b) -> a -> b
$ LastWill -> Maybe LastWill
forall a. a -> Maybe a
Just LastWill{_willTopic :: ByteString
_willTopic=ByteString
top, _willMsg :: ByteString
_willMsg=ByteString
msg,
                               _willRetain :: Bool
_willRetain=Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
bits Int
5,
                               _willQoS :: QoS
_willQoS=Word8 -> QoS
wQos (Word8 -> QoS) -> Word8 -> QoS
forall a b. (a -> b) -> a -> b
$ (Word8
bits Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
≫ Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3,
                               _willProps :: [Property]
_willProps = [Property]
props}
      | Bool
otherwise = Maybe LastWill -> Parser ByteString (Maybe LastWill)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LastWill
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
(ConnACKRC -> ConnACKRC -> Bool)
-> (ConnACKRC -> ConnACKRC -> Bool) -> Eq ConnACKRC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnACKRC -> ConnACKRC -> Bool
== :: ConnACKRC -> ConnACKRC -> Bool
$c/= :: ConnACKRC -> ConnACKRC -> Bool
/= :: ConnACKRC -> ConnACKRC -> Bool
Eq, Int -> ConnACKRC -> ShowS
[ConnACKRC] -> ShowS
ConnACKRC -> [Char]
(Int -> ConnACKRC -> ShowS)
-> (ConnACKRC -> [Char])
-> ([ConnACKRC] -> ShowS)
-> Show ConnACKRC
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnACKRC -> ShowS
showsPrec :: Int -> ConnACKRC -> ShowS
$cshow :: ConnACKRC -> [Char]
show :: ConnACKRC -> [Char]
$cshowList :: [ConnACKRC] -> ShowS
showList :: [ConnACKRC] -> ShowS
Show, ConnACKRC
ConnACKRC -> ConnACKRC -> Bounded ConnACKRC
forall a. a -> a -> Bounded a
$cminBound :: ConnACKRC
minBound :: ConnACKRC
$cmaxBound :: ConnACKRC
maxBound :: ConnACKRC
Bounded, Int -> ConnACKRC
ConnACKRC -> Int
ConnACKRC -> [ConnACKRC]
ConnACKRC -> ConnACKRC
ConnACKRC -> ConnACKRC -> [ConnACKRC]
ConnACKRC -> ConnACKRC -> ConnACKRC -> [ConnACKRC]
(ConnACKRC -> ConnACKRC)
-> (ConnACKRC -> ConnACKRC)
-> (Int -> ConnACKRC)
-> (ConnACKRC -> Int)
-> (ConnACKRC -> [ConnACKRC])
-> (ConnACKRC -> ConnACKRC -> [ConnACKRC])
-> (ConnACKRC -> ConnACKRC -> [ConnACKRC])
-> (ConnACKRC -> ConnACKRC -> ConnACKRC -> [ConnACKRC])
-> Enum 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
$csucc :: ConnACKRC -> ConnACKRC
succ :: ConnACKRC -> ConnACKRC
$cpred :: ConnACKRC -> ConnACKRC
pred :: ConnACKRC -> ConnACKRC
$ctoEnum :: Int -> ConnACKRC
toEnum :: Int -> ConnACKRC
$cfromEnum :: ConnACKRC -> Int
fromEnum :: ConnACKRC -> Int
$cenumFrom :: ConnACKRC -> [ConnACKRC]
enumFrom :: ConnACKRC -> [ConnACKRC]
$cenumFromThen :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
enumFromThen :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
$cenumFromTo :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
enumFromTo :: ConnACKRC -> ConnACKRC -> [ConnACKRC]
$cenumFromThenTo :: ConnACKRC -> ConnACKRC -> ConnACKRC -> [ConnACKRC]
enumFromThenTo :: ConnACKRC -> ConnACKRC -> 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 = ConnACKRC -> Maybe ConnACKRC -> ConnACKRC
forall a. a -> Maybe a -> a
fromMaybe ConnACKRC
ConnUnspecifiedError (Maybe ConnACKRC -> ConnACKRC) -> Maybe ConnACKRC -> ConnACKRC
forall a b. (a -> b) -> a -> b
$ Word8 -> [(Word8, ConnACKRC)] -> Maybe ConnACKRC
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
b [(Word8, ConnACKRC)]
connACKRev

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

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

-- | Connection acknowledgment details.
data ConnACKFlags = ConnACKFlags SessionReuse ConnACKRC [Property] deriving (ConnACKFlags -> ConnACKFlags -> Bool
(ConnACKFlags -> ConnACKFlags -> Bool)
-> (ConnACKFlags -> ConnACKFlags -> Bool) -> Eq ConnACKFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnACKFlags -> ConnACKFlags -> Bool
== :: ConnACKFlags -> ConnACKFlags -> Bool
$c/= :: ConnACKFlags -> ConnACKFlags -> Bool
/= :: ConnACKFlags -> ConnACKFlags -> Bool
Eq, Int -> ConnACKFlags -> ShowS
[ConnACKFlags] -> ShowS
ConnACKFlags -> [Char]
(Int -> ConnACKFlags -> ShowS)
-> (ConnACKFlags -> [Char])
-> ([ConnACKFlags] -> ShowS)
-> Show ConnACKFlags
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnACKFlags -> ShowS
showsPrec :: Int -> ConnACKFlags -> ShowS
$cshow :: ConnACKFlags -> [Char]
show :: ConnACKFlags -> [Char]
$cshowList :: [ConnACKFlags] -> ShowS
showList :: [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 (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props in
      [Word8
0x20]
      [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> Int -> [Word8]
encodeVarInt (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
pbytes)
      [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> [Bool -> Word8
boolBit (SessionReuse
sp SessionReuse -> SessionReuse -> Bool
forall a. Eq a => a -> a -> Bool
/= SessionReuse
NewSession), ConnACKRC -> Word8
forall a. ByteSize a => a -> Word8
toByte ConnACKRC
rc] [Word8] -> [Word8] -> [Word8]
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
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser ByteString ()
forall a. [Char] -> Parser ByteString a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then ProtocolLevel
Protocol311 else ProtocolLevel
Protocol50)
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
forall a b. (a -> b) -> a -> b
$ ConnACKFlags -> MQTTPkt
ConnACKPkt (ConnACKFlags -> MQTTPkt) -> ConnACKFlags -> MQTTPkt
forall a b. (a -> b) -> a -> b
$ SessionReuse -> ConnACKRC -> [Property] -> ConnACKFlags
ConnACKFlags (Bool -> SessionReuse
sf (Bool -> SessionReuse) -> Bool -> SessionReuse
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
ackFlags Int
0) (Word8 -> ConnACKRC
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
(PublishRequest -> PublishRequest -> Bool)
-> (PublishRequest -> PublishRequest -> Bool) -> Eq PublishRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublishRequest -> PublishRequest -> Bool
== :: PublishRequest -> PublishRequest -> Bool
$c/= :: PublishRequest -> PublishRequest -> Bool
/= :: PublishRequest -> PublishRequest -> Bool
Eq, Int -> PublishRequest -> ShowS
[PublishRequest] -> ShowS
PublishRequest -> [Char]
(Int -> PublishRequest -> ShowS)
-> (PublishRequest -> [Char])
-> ([PublishRequest] -> ShowS)
-> Show PublishRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublishRequest -> ShowS
showsPrec :: Int -> PublishRequest -> ShowS
$cshow :: PublishRequest -> [Char]
show :: PublishRequest -> [Char]
$cshowList :: [PublishRequest] -> ShowS
showList :: [PublishRequest] -> ShowS
Show)

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

    where f :: Word8
f = (Word8
db Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
≪ Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
qb Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
≪ Int
1) Word8 -> Word8 -> Word8
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3
          rb :: Word8
rb = Bool -> Word8
boolBit Bool
_pubRetain
          pktid :: ByteString
pktid
            | QoS
_pubQoS QoS -> QoS -> Bool
forall a. Eq a => a -> a -> Bool
== QoS
QoS0 = ByteString
forall a. Monoid a => a
mempty
            | Bool
otherwise = Word16 -> ByteString
encodeWord16 Word16
_pubPktID
          val :: ByteString
val = ProtocolLevel -> ByteString -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot ByteString
_pubTopic ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pktid ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
_pubProps ByteString -> ByteString -> ByteString
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x30)
  Int
plen <- Parser Int
parseHdrLen
  let _pubDup :: Bool
_pubDup = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x8 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8
      _pubQoS :: QoS
_pubQoS = Word8 -> QoS
wQos (Word8 -> QoS) -> Word8 -> QoS
forall a b. (a -> b) -> a -> b
$ (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
≫ Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
3
      _pubRetain :: Bool
_pubRetain = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1
  ByteString
_pubTopic <- Parser ByteString ByteString
aString
  Word16
_pubPktID <- if QoS
_pubQoS QoS -> QoS -> Bool
forall a. Eq a => a -> a -> Bool
== QoS
QoS0 then Word16 -> Parser ByteString Word16
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
0 else Parser ByteString Word16
aWord16
  [Property]
_pubProps <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
prot
  ByteString
_pubBody <- ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take (Int
plen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
_pubTopic) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
- QoS -> Int
forall {a}. Num a => QoS -> a
qlen QoS
_pubQoS Int -> Int -> Int
forall a. Num a => a -> a -> a
- ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
prot [Property]
_pubProps )
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
forall a b. (a -> b) -> a -> b
$ PublishRequest -> MQTTPkt
PublishPkt PublishRequest{Bool
[Property]
Word16
ByteString
QoS
_pubDup :: Bool
_pubQoS :: QoS
_pubRetain :: Bool
_pubTopic :: ByteString
_pubPktID :: Word16
_pubBody :: ByteString
_pubProps :: [Property]
_pubDup :: Bool
_pubQoS :: QoS
_pubRetain :: Bool
_pubTopic :: ByteString
_pubPktID :: Word16
_pubProps :: [Property]
_pubBody :: ByteString
..}

  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
(RetainHandling -> RetainHandling -> Bool)
-> (RetainHandling -> RetainHandling -> Bool) -> Eq RetainHandling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RetainHandling -> RetainHandling -> Bool
== :: RetainHandling -> RetainHandling -> Bool
$c/= :: RetainHandling -> RetainHandling -> Bool
/= :: RetainHandling -> RetainHandling -> Bool
Eq, Int -> RetainHandling -> ShowS
[RetainHandling] -> ShowS
RetainHandling -> [Char]
(Int -> RetainHandling -> ShowS)
-> (RetainHandling -> [Char])
-> ([RetainHandling] -> ShowS)
-> Show RetainHandling
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RetainHandling -> ShowS
showsPrec :: Int -> RetainHandling -> ShowS
$cshow :: RetainHandling -> [Char]
show :: RetainHandling -> [Char]
$cshowList :: [RetainHandling] -> ShowS
showList :: [RetainHandling] -> ShowS
Show, RetainHandling
RetainHandling -> RetainHandling -> Bounded RetainHandling
forall a. a -> a -> Bounded a
$cminBound :: RetainHandling
minBound :: RetainHandling
$cmaxBound :: RetainHandling
maxBound :: RetainHandling
Bounded, Int -> RetainHandling
RetainHandling -> Int
RetainHandling -> [RetainHandling]
RetainHandling -> RetainHandling
RetainHandling -> RetainHandling -> [RetainHandling]
RetainHandling
-> RetainHandling -> RetainHandling -> [RetainHandling]
(RetainHandling -> RetainHandling)
-> (RetainHandling -> RetainHandling)
-> (Int -> RetainHandling)
-> (RetainHandling -> Int)
-> (RetainHandling -> [RetainHandling])
-> (RetainHandling -> RetainHandling -> [RetainHandling])
-> (RetainHandling -> RetainHandling -> [RetainHandling])
-> (RetainHandling
    -> RetainHandling -> RetainHandling -> [RetainHandling])
-> Enum 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
$csucc :: RetainHandling -> RetainHandling
succ :: RetainHandling -> RetainHandling
$cpred :: RetainHandling -> RetainHandling
pred :: RetainHandling -> RetainHandling
$ctoEnum :: Int -> RetainHandling
toEnum :: Int -> RetainHandling
$cfromEnum :: RetainHandling -> Int
fromEnum :: RetainHandling -> Int
$cenumFrom :: RetainHandling -> [RetainHandling]
enumFrom :: RetainHandling -> [RetainHandling]
$cenumFromThen :: RetainHandling -> RetainHandling -> [RetainHandling]
enumFromThen :: RetainHandling -> RetainHandling -> [RetainHandling]
$cenumFromTo :: RetainHandling -> RetainHandling -> [RetainHandling]
enumFromTo :: RetainHandling -> RetainHandling -> [RetainHandling]
$cenumFromThenTo :: RetainHandling
-> RetainHandling -> RetainHandling -> [RetainHandling]
enumFromThenTo :: RetainHandling
-> RetainHandling -> 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
(SubOptions -> SubOptions -> Bool)
-> (SubOptions -> SubOptions -> Bool) -> Eq SubOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubOptions -> SubOptions -> Bool
== :: SubOptions -> SubOptions -> Bool
$c/= :: SubOptions -> SubOptions -> Bool
/= :: SubOptions -> SubOptions -> Bool
Eq, Int -> SubOptions -> ShowS
[SubOptions] -> ShowS
SubOptions -> [Char]
(Int -> SubOptions -> ShowS)
-> (SubOptions -> [Char])
-> ([SubOptions] -> ShowS)
-> Show SubOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubOptions -> ShowS
showsPrec :: Int -> SubOptions -> ShowS
$cshow :: SubOptions -> [Char]
show :: SubOptions -> [Char]
$cshowList :: [SubOptions] -> ShowS
showList :: [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
_retainHandling :: SubOptions -> RetainHandling
_retainAsPublished :: SubOptions -> Bool
_noLocal :: SubOptions -> Bool
_subQoS :: SubOptions -> QoS
_retainHandling :: RetainHandling
_retainAsPublished :: Bool
_noLocal :: Bool
_subQoS :: QoS
..} = Word8 -> ByteString
BL.singleton (Word8
rh Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
rap Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
nl Word8 -> Word8 -> Word8
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 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
≫ Int
4 of
             Word8
1 -> RetainHandling
SendOnSubscribeNew
             Word8
2 -> RetainHandling
DoNotSendOnSubscribe
             Word8
_ -> RetainHandling
SendOnSubscribe

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

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

data SubscribeRequest = SubscribeRequest PktID [(BL.ByteString, SubOptions)] [Property]
                      deriving(SubscribeRequest -> SubscribeRequest -> Bool
(SubscribeRequest -> SubscribeRequest -> Bool)
-> (SubscribeRequest -> SubscribeRequest -> Bool)
-> Eq SubscribeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscribeRequest -> SubscribeRequest -> Bool
== :: SubscribeRequest -> SubscribeRequest -> Bool
$c/= :: SubscribeRequest -> SubscribeRequest -> Bool
/= :: SubscribeRequest -> SubscribeRequest -> Bool
Eq, Int -> SubscribeRequest -> ShowS
[SubscribeRequest] -> ShowS
SubscribeRequest -> [Char]
(Int -> SubscribeRequest -> ShowS)
-> (SubscribeRequest -> [Char])
-> ([SubscribeRequest] -> ShowS)
-> Show SubscribeRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscribeRequest -> ShowS
showsPrec :: Int -> SubscribeRequest -> ShowS
$cshow :: SubscribeRequest -> [Char]
show :: SubscribeRequest -> [Char]
$cshowList :: [SubscribeRequest] -> ShowS
showList :: [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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props ByteString -> ByteString -> ByteString
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
(PubACK -> PubACK -> Bool)
-> (PubACK -> PubACK -> Bool) -> Eq PubACK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PubACK -> PubACK -> Bool
== :: PubACK -> PubACK -> Bool
$c/= :: PubACK -> PubACK -> Bool
/= :: PubACK -> PubACK -> Bool
Eq, Int -> PubACK -> ShowS
[PubACK] -> ShowS
PubACK -> [Char]
(Int -> PubACK -> ShowS)
-> (PubACK -> [Char]) -> ([PubACK] -> ShowS) -> Show PubACK
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubACK -> ShowS
showsPrec :: Int -> PubACK -> ShowS
$cshow :: PubACK -> [Char]
show :: PubACK -> [Char]
$cshowList :: [PubACK] -> ShowS
showList :: [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 ByteString -> ByteString -> ByteString
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
                                     ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid
                                                    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
st
                                                    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Property] -> ByteString
mprop [Property]
props)
    where
      mprop :: [Property] -> ByteString
mprop [] = ByteString
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 ByteString Word16
aWord16
  Word8
st <- if Int
rl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then Parser Word8
A.anyWord8 else Word8 -> Parser Word8
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
0
  [Property]
props <- if Int
rl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3 then ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50 else [Property] -> Parser [Property]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Property]
forall a. Monoid a => a
mempty
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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 = Word8
-> (PubACK -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> PubACK)
-> Parser MQTTPkt
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
(PubREC -> PubREC -> Bool)
-> (PubREC -> PubREC -> Bool) -> Eq PubREC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PubREC -> PubREC -> Bool
== :: PubREC -> PubREC -> Bool
$c/= :: PubREC -> PubREC -> Bool
/= :: PubREC -> PubREC -> Bool
Eq, Int -> PubREC -> ShowS
[PubREC] -> ShowS
PubREC -> [Char]
(Int -> PubREC -> ShowS)
-> (PubREC -> [Char]) -> ([PubREC] -> ShowS) -> Show PubREC
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubREC -> ShowS
showsPrec :: Int -> PubREC -> ShowS
$cshow :: PubREC -> [Char]
show :: PubREC -> [Char]
$cshowList :: [PubREC] -> ShowS
showList :: [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 = Word8
-> (PubREC -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> PubREC)
-> Parser MQTTPkt
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
(PubREL -> PubREL -> Bool)
-> (PubREL -> PubREL -> Bool) -> Eq PubREL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PubREL -> PubREL -> Bool
== :: PubREL -> PubREL -> Bool
$c/= :: PubREL -> PubREL -> Bool
/= :: PubREL -> PubREL -> Bool
Eq, Int -> PubREL -> ShowS
[PubREL] -> ShowS
PubREL -> [Char]
(Int -> PubREL -> ShowS)
-> (PubREL -> [Char]) -> ([PubREL] -> ShowS) -> Show PubREL
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubREL -> ShowS
showsPrec :: Int -> PubREL -> ShowS
$cshow :: PubREL -> [Char]
show :: PubREL -> [Char]
$cshowList :: [PubREL] -> ShowS
showList :: [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 = Word8
-> (PubREL -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> PubREL)
-> Parser MQTTPkt
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
(PubCOMP -> PubCOMP -> Bool)
-> (PubCOMP -> PubCOMP -> Bool) -> Eq PubCOMP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PubCOMP -> PubCOMP -> Bool
== :: PubCOMP -> PubCOMP -> Bool
$c/= :: PubCOMP -> PubCOMP -> Bool
/= :: PubCOMP -> PubCOMP -> Bool
Eq, Int -> PubCOMP -> ShowS
[PubCOMP] -> ShowS
PubCOMP -> [Char]
(Int -> PubCOMP -> ShowS)
-> (PubCOMP -> [Char]) -> ([PubCOMP] -> ShowS) -> Show PubCOMP
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubCOMP -> ShowS
showsPrec :: Int -> PubCOMP -> ShowS
$cshow :: PubCOMP -> [Char]
show :: PubCOMP -> [Char]
$cshowList :: [PubCOMP] -> ShowS
showList :: [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 = Word8
-> (PubCOMP -> MQTTPkt)
-> (Word16 -> Word8 -> [Property] -> PubCOMP)
-> Parser MQTTPkt
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 ByteString Word16
aWord16
  [Property]
props <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
prot
  ByteString
content <- Int -> Parser ByteString ByteString
A.take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
prot [Property]
props)
  a
a <- ByteString -> Parser a
subp ByteString
content
  (Word16, [Property], a) -> Parser (Word16, [Property], a)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
pid, [Property]
props, a
a)

    where subp :: ByteString -> Parser a
subp = ([Char] -> Parser a)
-> (a -> Parser a) -> Either [Char] a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser a
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail a -> Parser a
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] a -> Parser a)
-> (ByteString -> Either [Char] a) -> ByteString -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Either [Char] a
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) <- Word8
-> ProtocolLevel
-> Parser [(ByteString, SubOptions)]
-> Parser (Word16, [Property], [(ByteString, SubOptions)])
forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
0x82 ProtocolLevel
prot (Parser [(ByteString, SubOptions)]
 -> Parser (Word16, [Property], [(ByteString, SubOptions)]))
-> Parser [(ByteString, SubOptions)]
-> Parser (Word16, [Property], [(ByteString, SubOptions)])
forall a b. (a -> b) -> a -> b
$ Parser ByteString (ByteString, SubOptions)
-> Parser [(ByteString, SubOptions)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 ((ByteString -> SubOptions -> (ByteString, SubOptions))
-> Parser ByteString ByteString
-> Parser SubOptions
-> Parser ByteString (ByteString, SubOptions)
forall a b c.
(a -> b -> c)
-> Parser ByteString a
-> Parser ByteString b
-> Parser ByteString c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Parser ByteString ByteString
aString Parser SubOptions
parseSubOptions)
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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
(SubscribeResponse -> SubscribeResponse -> Bool)
-> (SubscribeResponse -> SubscribeResponse -> Bool)
-> Eq SubscribeResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscribeResponse -> SubscribeResponse -> Bool
== :: SubscribeResponse -> SubscribeResponse -> Bool
$c/= :: SubscribeResponse -> SubscribeResponse -> Bool
/= :: SubscribeResponse -> SubscribeResponse -> Bool
Eq, Int -> SubscribeResponse -> ShowS
[SubscribeResponse] -> ShowS
SubscribeResponse -> [Char]
(Int -> SubscribeResponse -> ShowS)
-> (SubscribeResponse -> [Char])
-> ([SubscribeResponse] -> ShowS)
-> Show SubscribeResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscribeResponse -> ShowS
showsPrec :: Int -> SubscribeResponse -> ShowS
$cshow :: SubscribeResponse -> [Char]
show :: SubscribeResponse -> [Char]
$cshowList :: [SubscribeResponse] -> ShowS
showList :: [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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BL.pack (Either SubErr QoS -> Word8
b (Either SubErr QoS -> Word8) -> [Either SubErr QoS] -> [Word8]
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    = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
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
(SubErr -> SubErr -> Bool)
-> (SubErr -> SubErr -> Bool) -> Eq SubErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubErr -> SubErr -> Bool
== :: SubErr -> SubErr -> Bool
$c/= :: SubErr -> SubErr -> Bool
/= :: SubErr -> SubErr -> Bool
Eq, Int -> SubErr -> ShowS
[SubErr] -> ShowS
SubErr -> [Char]
(Int -> SubErr -> ShowS)
-> (SubErr -> [Char]) -> ([SubErr] -> ShowS) -> Show SubErr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubErr -> ShowS
showsPrec :: Int -> SubErr -> ShowS
$cshow :: SubErr -> [Char]
show :: SubErr -> [Char]
$cshowList :: [SubErr] -> ShowS
showList :: [SubErr] -> ShowS
Show, SubErr
SubErr -> SubErr -> Bounded SubErr
forall a. a -> a -> Bounded a
$cminBound :: SubErr
minBound :: SubErr
$cmaxBound :: SubErr
maxBound :: SubErr
Bounded, Int -> SubErr
SubErr -> Int
SubErr -> [SubErr]
SubErr -> SubErr
SubErr -> SubErr -> [SubErr]
SubErr -> SubErr -> SubErr -> [SubErr]
(SubErr -> SubErr)
-> (SubErr -> SubErr)
-> (Int -> SubErr)
-> (SubErr -> Int)
-> (SubErr -> [SubErr])
-> (SubErr -> SubErr -> [SubErr])
-> (SubErr -> SubErr -> [SubErr])
-> (SubErr -> SubErr -> SubErr -> [SubErr])
-> Enum 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
$csucc :: SubErr -> SubErr
succ :: SubErr -> SubErr
$cpred :: SubErr -> SubErr
pred :: SubErr -> SubErr
$ctoEnum :: Int -> SubErr
toEnum :: Int -> SubErr
$cfromEnum :: SubErr -> Int
fromEnum :: SubErr -> Int
$cenumFrom :: SubErr -> [SubErr]
enumFrom :: SubErr -> [SubErr]
$cenumFromThen :: SubErr -> SubErr -> [SubErr]
enumFromThen :: SubErr -> SubErr -> [SubErr]
$cenumFromTo :: SubErr -> SubErr -> [SubErr]
enumFromTo :: SubErr -> SubErr -> [SubErr]
$cenumFromThenTo :: SubErr -> SubErr -> SubErr -> [SubErr]
enumFromThenTo :: SubErr -> SubErr -> SubErr -> [SubErr]
Enum)

parseSubACK :: ProtocolLevel -> A.Parser MQTTPkt
parseSubACK :: ProtocolLevel -> Parser MQTTPkt
parseSubACK ProtocolLevel
prot = do
  (Word16
pid, [Property]
props, [Either SubErr QoS]
res) <- Word8
-> ProtocolLevel
-> Parser [Either SubErr QoS]
-> Parser (Word16, [Property], [Either SubErr QoS])
forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
0x90 ProtocolLevel
prot (Parser [Either SubErr QoS]
 -> Parser (Word16, [Property], [Either SubErr QoS]))
-> Parser [Either SubErr QoS]
-> Parser (Word16, [Property], [Either SubErr QoS])
forall a b. (a -> b) -> a -> b
$ Parser ByteString (Either SubErr QoS) -> Parser [Either SubErr QoS]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Word8 -> Either SubErr QoS
p (Word8 -> Either SubErr QoS)
-> Parser Word8 -> Parser ByteString (Either SubErr QoS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8)
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrUnspecifiedError
    p Word8
0x83 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrImplementationSpecificError
    p Word8
0x87 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrNotAuthorized
    p Word8
0x8F = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrTopicFilterInvalid
    p Word8
0x91 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrPacketIdentifierInUse
    p Word8
0x97 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrQuotaExceeded
    p Word8
0x9E = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrSharedSubscriptionsNotSupported
    p Word8
0xA1 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrSubscriptionIdentifiersNotSupported
    p Word8
0xA2 = SubErr -> Either SubErr QoS
forall a b. a -> Either a b
Left SubErr
SubErrWildcardSubscriptionsNotSupported
    p Word8
x    = QoS -> Either SubErr QoS
forall a b. b -> Either a b
Right (Word8 -> QoS
wQos Word8
x)

data UnsubscribeRequest = UnsubscribeRequest PktID [BL.ByteString] [Property]
                        deriving(UnsubscribeRequest -> UnsubscribeRequest -> Bool
(UnsubscribeRequest -> UnsubscribeRequest -> Bool)
-> (UnsubscribeRequest -> UnsubscribeRequest -> Bool)
-> Eq UnsubscribeRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
== :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
$c/= :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
/= :: UnsubscribeRequest -> UnsubscribeRequest -> Bool
Eq, Int -> UnsubscribeRequest -> ShowS
[UnsubscribeRequest] -> ShowS
UnsubscribeRequest -> [Char]
(Int -> UnsubscribeRequest -> ShowS)
-> (UnsubscribeRequest -> [Char])
-> ([UnsubscribeRequest] -> ShowS)
-> Show UnsubscribeRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnsubscribeRequest -> ShowS
showsPrec :: Int -> UnsubscribeRequest -> ShowS
$cshow :: UnsubscribeRequest -> [Char]
show :: UnsubscribeRequest -> [Char]
$cshowList :: [UnsubscribeRequest] -> ShowS
showList :: [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
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
prot [Property]
props ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (ProtocolLevel -> ByteString -> ByteString
forall a. ByteMe a => ProtocolLevel -> a -> ByteString
toByteString ProtocolLevel
prot (ByteString -> ByteString) -> [ByteString] -> [ByteString]
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) <- Word8
-> ProtocolLevel
-> Parser [ByteString]
-> Parser (Word16, [Property], [ByteString])
forall a.
Word8
-> ProtocolLevel -> Parser a -> Parser (Word16, [Property], a)
parseSubHdr Word8
0xa2 ProtocolLevel
prot (Parser [ByteString] -> Parser (Word16, [Property], [ByteString]))
-> Parser [ByteString] -> Parser (Word16, [Property], [ByteString])
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString -> Parser [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser ByteString ByteString
aString
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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]
(Int -> UnsubStatus -> ShowS)
-> (UnsubStatus -> [Char])
-> ([UnsubStatus] -> ShowS)
-> Show UnsubStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnsubStatus -> ShowS
showsPrec :: Int -> UnsubStatus -> ShowS
$cshow :: UnsubStatus -> [Char]
show :: UnsubStatus -> [Char]
$cshowList :: [UnsubStatus] -> ShowS
showList :: [UnsubStatus] -> ShowS
Show, UnsubStatus -> UnsubStatus -> Bool
(UnsubStatus -> UnsubStatus -> Bool)
-> (UnsubStatus -> UnsubStatus -> Bool) -> Eq UnsubStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnsubStatus -> UnsubStatus -> Bool
== :: UnsubStatus -> UnsubStatus -> Bool
$c/= :: UnsubStatus -> UnsubStatus -> Bool
/= :: UnsubStatus -> UnsubStatus -> Bool
Eq, UnsubStatus
UnsubStatus -> UnsubStatus -> Bounded UnsubStatus
forall a. a -> a -> Bounded a
$cminBound :: UnsubStatus
minBound :: UnsubStatus
$cmaxBound :: UnsubStatus
maxBound :: UnsubStatus
Bounded, Int -> UnsubStatus
UnsubStatus -> Int
UnsubStatus -> [UnsubStatus]
UnsubStatus -> UnsubStatus
UnsubStatus -> UnsubStatus -> [UnsubStatus]
UnsubStatus -> UnsubStatus -> UnsubStatus -> [UnsubStatus]
(UnsubStatus -> UnsubStatus)
-> (UnsubStatus -> UnsubStatus)
-> (Int -> UnsubStatus)
-> (UnsubStatus -> Int)
-> (UnsubStatus -> [UnsubStatus])
-> (UnsubStatus -> UnsubStatus -> [UnsubStatus])
-> (UnsubStatus -> UnsubStatus -> [UnsubStatus])
-> (UnsubStatus -> UnsubStatus -> UnsubStatus -> [UnsubStatus])
-> Enum 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
$csucc :: UnsubStatus -> UnsubStatus
succ :: UnsubStatus -> UnsubStatus
$cpred :: UnsubStatus -> UnsubStatus
pred :: UnsubStatus -> UnsubStatus
$ctoEnum :: Int -> UnsubStatus
toEnum :: Int -> UnsubStatus
$cfromEnum :: UnsubStatus -> Int
fromEnum :: UnsubStatus -> Int
$cenumFrom :: UnsubStatus -> [UnsubStatus]
enumFrom :: UnsubStatus -> [UnsubStatus]
$cenumFromThen :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
enumFromThen :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
$cenumFromTo :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
enumFromTo :: UnsubStatus -> UnsubStatus -> [UnsubStatus]
$cenumFromThenTo :: UnsubStatus -> UnsubStatus -> UnsubStatus -> [UnsubStatus]
enumFromThenTo :: UnsubStatus -> UnsubStatus -> 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
(UnsubscribeResponse -> UnsubscribeResponse -> Bool)
-> (UnsubscribeResponse -> UnsubscribeResponse -> Bool)
-> Eq UnsubscribeResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
== :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
$c/= :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
/= :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
Eq, Int -> UnsubscribeResponse -> ShowS
[UnsubscribeResponse] -> ShowS
UnsubscribeResponse -> [Char]
(Int -> UnsubscribeResponse -> ShowS)
-> (UnsubscribeResponse -> [Char])
-> ([UnsubscribeResponse] -> ShowS)
-> Show UnsubscribeResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnsubscribeResponse -> ShowS
showsPrec :: Int -> UnsubscribeResponse -> ShowS
$cshow :: UnsubscribeResponse -> [Char]
show :: UnsubscribeResponse -> [Char]
$cshowList :: [UnsubscribeResponse] -> ShowS
showList :: [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 ByteString -> ByteString -> ByteString
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word16 -> ByteString
encodeWord16 Word16
pid
                                      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ProtocolLevel -> [Property] -> ByteString
bsProps ProtocolLevel
Protocol50 [Property]
props
                                      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ((UnsubStatus -> ByteString) -> [UnsubStatus] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtocolLevel -> UnsubStatus -> ByteString
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 ByteString Word16
aWord16
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
forall a b. (a -> b) -> a -> b
$ UnsubscribeResponse -> MQTTPkt
UnsubACKPkt (Word16 -> [Property] -> [UnsubStatus] -> UnsubscribeResponse
UnsubscribeResponse Word16
pid [Property]
forall a. Monoid a => a
mempty [UnsubStatus]
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 ByteString Word16
aWord16
  [Property]
props <- ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50
  [UnsubStatus]
res <- Int
-> Parser ByteString UnsubStatus -> Parser ByteString [UnsubStatus]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
rl Int -> Int -> Int
forall a. Num a => a -> a -> a
- ProtocolLevel -> [Property] -> Int
propLen ProtocolLevel
Protocol50 [Property]
props Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Parser ByteString UnsubStatus
unsubACK
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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 ByteString UnsubStatus
unsubACK = [(Word8, UnsubStatus)] -> Parser ByteString UnsubStatus
forall p. [(Word8, p)] -> Parser p
oneOf [(Word8
0x00, UnsubStatus
UnsubSuccess),
                      (Word8
0x11, UnsubStatus
UnsubNoSubscriptionExisted),
                      (Word8
0x80, UnsubStatus
UnsubUnspecifiedError),
                      (Word8
0x83, UnsubStatus
UnsubImplementationSpecificError),
                      (Word8
0x87, UnsubStatus
UnsubNotAuthorized),
                      (Word8
0x8F, UnsubStatus
UnsubTopicFilterInvalid),
                      (Word8
0x91, UnsubStatus
UnsubPacketIdentifierInUse)
                     ]

data AuthRequest = AuthRequest Word8 [Property] deriving (AuthRequest -> AuthRequest -> Bool
(AuthRequest -> AuthRequest -> Bool)
-> (AuthRequest -> AuthRequest -> Bool) -> Eq AuthRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthRequest -> AuthRequest -> Bool
== :: AuthRequest -> AuthRequest -> Bool
$c/= :: AuthRequest -> AuthRequest -> Bool
/= :: AuthRequest -> AuthRequest -> Bool
Eq, Int -> AuthRequest -> ShowS
[AuthRequest] -> ShowS
AuthRequest -> [Char]
(Int -> AuthRequest -> ShowS)
-> (AuthRequest -> [Char])
-> ([AuthRequest] -> ShowS)
-> Show AuthRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthRequest -> ShowS
showsPrec :: Int -> AuthRequest -> ShowS
$cshow :: AuthRequest -> [Char]
show :: AuthRequest -> [Char]
$cshowList :: [AuthRequest] -> ShowS
showList :: [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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word8 -> ByteString
BL.singleton Word8
i ByteString -> ByteString -> ByteString
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 (Word8 -> [Property] -> AuthRequest)
-> Parser Word8 -> Parser ByteString ([Property] -> AuthRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
A.anyWord8 Parser ByteString ([Property] -> AuthRequest)
-> Parser [Property] -> Parser ByteString AuthRequest
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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]
(Int -> DiscoReason -> ShowS)
-> (DiscoReason -> [Char])
-> ([DiscoReason] -> ShowS)
-> Show DiscoReason
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiscoReason -> ShowS
showsPrec :: Int -> DiscoReason -> ShowS
$cshow :: DiscoReason -> [Char]
show :: DiscoReason -> [Char]
$cshowList :: [DiscoReason] -> ShowS
showList :: [DiscoReason] -> ShowS
Show, DiscoReason -> DiscoReason -> Bool
(DiscoReason -> DiscoReason -> Bool)
-> (DiscoReason -> DiscoReason -> Bool) -> Eq DiscoReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiscoReason -> DiscoReason -> Bool
== :: DiscoReason -> DiscoReason -> Bool
$c/= :: DiscoReason -> DiscoReason -> Bool
/= :: DiscoReason -> DiscoReason -> Bool
Eq, DiscoReason
DiscoReason -> DiscoReason -> Bounded DiscoReason
forall a. a -> a -> Bounded a
$cminBound :: DiscoReason
minBound :: DiscoReason
$cmaxBound :: DiscoReason
maxBound :: DiscoReason
Bounded, Int -> DiscoReason
DiscoReason -> Int
DiscoReason -> [DiscoReason]
DiscoReason -> DiscoReason
DiscoReason -> DiscoReason -> [DiscoReason]
DiscoReason -> DiscoReason -> DiscoReason -> [DiscoReason]
(DiscoReason -> DiscoReason)
-> (DiscoReason -> DiscoReason)
-> (Int -> DiscoReason)
-> (DiscoReason -> Int)
-> (DiscoReason -> [DiscoReason])
-> (DiscoReason -> DiscoReason -> [DiscoReason])
-> (DiscoReason -> DiscoReason -> [DiscoReason])
-> (DiscoReason -> DiscoReason -> DiscoReason -> [DiscoReason])
-> Enum 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
$csucc :: DiscoReason -> DiscoReason
succ :: DiscoReason -> DiscoReason
$cpred :: DiscoReason -> DiscoReason
pred :: DiscoReason -> DiscoReason
$ctoEnum :: Int -> DiscoReason
toEnum :: Int -> DiscoReason
$cfromEnum :: DiscoReason -> Int
fromEnum :: DiscoReason -> Int
$cenumFrom :: DiscoReason -> [DiscoReason]
enumFrom :: DiscoReason -> [DiscoReason]
$cenumFromThen :: DiscoReason -> DiscoReason -> [DiscoReason]
enumFromThen :: DiscoReason -> DiscoReason -> [DiscoReason]
$cenumFromTo :: DiscoReason -> DiscoReason -> [DiscoReason]
enumFromTo :: DiscoReason -> DiscoReason -> [DiscoReason]
$cenumFromThenTo :: DiscoReason -> DiscoReason -> DiscoReason -> [DiscoReason]
enumFromThenTo :: DiscoReason -> DiscoReason -> 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 = DiscoReason -> Maybe DiscoReason -> DiscoReason
forall a. a -> Maybe a -> a
fromMaybe DiscoReason
DiscoMalformedPacket (Maybe DiscoReason -> DiscoReason)
-> Maybe DiscoReason -> DiscoReason
forall a b. (a -> b) -> a -> b
$ Word8 -> [(Word8, DiscoReason)] -> Maybe DiscoReason
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
w [(Word8, DiscoReason)]
discoReasonRev

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

data DisconnectRequest = DisconnectRequest DiscoReason [Property] deriving (DisconnectRequest -> DisconnectRequest -> Bool
(DisconnectRequest -> DisconnectRequest -> Bool)
-> (DisconnectRequest -> DisconnectRequest -> Bool)
-> Eq DisconnectRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisconnectRequest -> DisconnectRequest -> Bool
== :: DisconnectRequest -> DisconnectRequest -> Bool
$c/= :: DisconnectRequest -> DisconnectRequest -> Bool
/= :: DisconnectRequest -> DisconnectRequest -> Bool
Eq, Int -> DisconnectRequest -> ShowS
[DisconnectRequest] -> ShowS
DisconnectRequest -> [Char]
(Int -> DisconnectRequest -> ShowS)
-> (DisconnectRequest -> [Char])
-> ([DisconnectRequest] -> ShowS)
-> Show DisconnectRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisconnectRequest -> ShowS
showsPrec :: Int -> DisconnectRequest -> ShowS
$cshow :: DisconnectRequest -> [Char]
show :: DisconnectRequest -> [Char]
$cshowList :: [DisconnectRequest] -> ShowS
showList :: [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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
withLength (Word8 -> ByteString
BL.singleton (DiscoReason -> Word8
forall a. ByteSize a => a -> Word8
toByte DiscoReason
r) ByteString -> ByteString -> ByteString
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 [Property]
forall a. Monoid a => a
mempty DisconnectRequest
-> Parser ByteString ByteString
-> Parser ByteString DisconnectRequest
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
A.string ByteString
"\224\NUL"
  MQTTPkt -> Parser MQTTPkt
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MQTTPkt -> Parser MQTTPkt) -> MQTTPkt -> Parser MQTTPkt
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then ProtocolLevel -> Parser [Property]
parseProperties ProtocolLevel
Protocol50 else [Property] -> Parser [Property]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Property]
forall a. Monoid a => a
mempty

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