{-# Language GeneralizedNewtypeDeriving, PatternSynonyms, OverloadedStrings, DataKinds, KindSignatures, GADTs, TypeFamilies, ScopedTypeVariables, TemplateHaskell #-} {-| Module: MQTT.Types Copyright: Lukas Braun 2014 License: GPL-3 Maintainer: koomi+mqtt@hackerspace-bamberg.de Types representing MQTT messages. -} module Network.MQTT.Types ( -- * Messages Message(..) , SomeMessage(..) , MqttHeader(..) -- * Message bodies , MessageBody(..) , Connect(..) , ConnAck(..) , Publish(..) , Subscribe(..) , SubAck(..) , Unsubscribe(..) , SimpleMsg(..) -- * Miscellaneous , Will(..) , QoS(..) , MsgID , getMsgID , Topic , fromTopic , toTopic , matches , MqttText(..) -- * Message types , MsgType(..) , toMsgType , toMsgType' -- ** Singletons -- | Singletons are used to build a bridge between the type and value level. -- See the @singletons@ package for more information. -- -- You do not have to use or understand these in order to use this -- library, they are mostly used internally to get better guarantees -- about the flow of 'Message's. , toSMsgType , SMsgType , Sing( SCONNECT , SCONNACK , SPUBLISH , SPUBACK , SPUBREC , SPUBREL , SPUBCOMP , SSUBSCRIBE , SSUBACK , SUNSUBSCRIBE , SUNSUBACK , SPINGREQ , SPINGRESP , SDISCONNECT) ) where import Data.ByteString (ByteString) import Data.Singletons.TH import Data.String (IsString(..)) import Data.Text (Text) import qualified Data.Text as T import Data.Word -- | A MQTT message, indexed by the type of the message ('MsgType'). data Message (t :: MsgType) = Message { header :: MqttHeader , body :: MessageBody t } -- | Any message, hiding the index. data SomeMessage where SomeMessage :: Message t -> SomeMessage -- | Fixed header required in every message. data MqttHeader = Header { -- msgType :: MsgType -- ^ Type of the message dup :: Bool -- ^ Has this message been sent before? , qos :: QoS -- ^ Quality of Service-level , retain :: Bool -- ^ Should the broker retain the message for -- future subscribers? } deriving (Eq, Ord, Show) -- | The body of a MQTT message, indexed by the type of the message ('MsgType'). data MessageBody (t :: MsgType) where MConnect :: Connect -> MessageBody CONNECT MConnAck :: ConnAck -> MessageBody CONNACK MPublish :: Publish -> MessageBody PUBLISH MPubAck :: SimpleMsg -> MessageBody PUBACK MPubRec :: SimpleMsg -> MessageBody PUBREC MPubRel :: SimpleMsg -> MessageBody PUBREL MPubComp :: SimpleMsg -> MessageBody PUBCOMP MSubscribe :: Subscribe -> MessageBody SUBSCRIBE MSubAck :: SubAck -> MessageBody SUBACK MUnsubscribe :: Unsubscribe -> MessageBody UNSUBSCRIBE MUnsubAck :: SimpleMsg -> MessageBody UNSUBACK MPingReq :: MessageBody PINGREQ MPingResp :: MessageBody PINGRESP MDisconnect :: MessageBody DISCONNECT -- | The fields of a CONNECT message. data Connect = Connect { cleanSession :: Bool -- ^ Should the server forget subscriptions and other state on -- disconnects? , will :: Maybe Will -- ^ Optional 'Will' message. , clientID :: MqttText -- ^ Client ID used by the server to identify clients. , username :: Maybe MqttText -- ^ Optional username used for authentication. , password :: Maybe MqttText -- ^ Optional password used for authentication. , keepAlive :: Word16 -- ^ Maximum interval (in seconds) in which a message must be sent. -- 0 means no limit. } deriving (Show, Eq) -- | The response to a CONNECT. Anything other than 0 means the broker -- refused the connection -- (). newtype ConnAck = ConnAck { returnCode :: Word8 } deriving (Show, Eq) -- | The fields of a PUBLISH message. data Publish = Publish { topic :: Topic -- ^ The 'Topic' to which the message should be published. , pubMsgID :: Maybe MsgID -- ^ 'MsgID' of the message if 'QoS' > 'NoConfirm'. , payload :: ByteString -- ^ The content that will be published. } deriving (Show, Eq) -- | The fields of a SUBSCRIBE message. data Subscribe = Subscribe { subscribeMsgID :: MsgID , subTopics :: [(Topic, QoS)] -- ^ The 'Topic's and corresponding requested 'QoS'. } deriving (Show, Eq) -- | The fields of a SUBACK message. data SubAck = SubAck { subAckMsgID :: MsgID , granted :: [QoS] -- ^ The 'QoS' granted for each 'Topic' in the order they were sent -- in the SUBSCRIBE. } deriving (Show, Eq) -- | The fields of a UNSUBSCRIBE message. data Unsubscribe = Unsubscribe { unsubMsgID :: MsgID , unsubTopics :: [Topic] -- ^ The 'Topic's from which the client should be unsubscribed. } deriving (Show, Eq) -- | Any message body that consists only of a 'MsgID'. newtype SimpleMsg = SimpleMsg { msgID :: MsgID } deriving (Show, Eq) -- | The different levels of QoS data QoS = NoConfirm -- ^ Fire and forget | Confirm -- ^ Acknowledged delivery (repeat until ack) | Handshake -- ^ Assured delivery (four-step handshake) deriving (Eq, Ord, Enum, Show) -- | A Will message is published by the broker if a client disconnects -- without sending a DISCONNECT. data Will = Will { wRetain :: Bool , wQoS :: QoS , wTopic :: Topic , wMsg :: MqttText } deriving (Eq, Show) -- | MQTT uses length-prefixed UTF-8 as text encoding. newtype MqttText = MqttText { text :: Text } deriving (Eq, Show, IsString) -- | A topic is a "hierarchical name space that defines a taxonomy of -- information sources for which subscribers can register an interest." -- -- See -- -- for more information on topics. data Topic = Topic { levels :: [Text], orig :: Text } -- levels and orig should always refer to the same topic, this way no text -- has to be copied when converting from/to text type MsgID = Word16 -- | Get the message ID of any message, if it exists. getMsgID :: MessageBody t -> Maybe MsgID getMsgID (MConnect _) = Nothing getMsgID (MConnAck _) = Nothing getMsgID (MPublish pub) = pubMsgID pub getMsgID (MPubAck simple) = Just (msgID simple) getMsgID (MPubRec simple) = Just (msgID simple) getMsgID (MPubRel simple) = Just (msgID simple) getMsgID (MPubComp simple) = Just (msgID simple) getMsgID (MSubscribe sub) = Just (subscribeMsgID sub) getMsgID (MSubAck subA) = Just (subAckMsgID subA) getMsgID (MUnsubscribe unsub) = Just (unsubMsgID unsub) getMsgID (MUnsubAck simple) = Just (msgID simple) getMsgID MPingReq = Nothing getMsgID MPingResp = Nothing getMsgID MDisconnect = Nothing instance Show Topic where show (Topic _ t) = show t instance Eq Topic where Topic _ t1 == Topic _ t2 = t1 == t2 -- | Check if one of the 'Topic's matches the other. matches :: Topic -> Topic -> Bool matches (Topic t1 _) (Topic t2 _) = go t1 t2 where go [] [] = True go [] (l:_) = l == "#" go (l:_) [] = l == "#" go (l1:ls1) (l2:ls2) = l1 == "#" || l2 == "#" || ((l1 == "+" || l2 == "+" || l1 == l2) && go ls1 ls2) toTopic :: MqttText -> Topic toTopic (MqttText txt) = Topic (T.split (== '/') txt) txt fromTopic :: Topic -> MqttText fromTopic = MqttText . orig instance IsString Topic where fromString str = let txt = T.pack str in Topic (T.split (== '/') txt) txt -- | The various types of messages. data MsgType = CONNECT | CONNACK | PUBLISH | PUBACK | PUBREC | PUBREL | PUBCOMP | SUBSCRIBE | SUBACK | UNSUBSCRIBE | UNSUBACK | PINGREQ | PINGRESP | DISCONNECT deriving (Eq, Enum, Ord, Show) genSingletons [''MsgType] singDecideInstance ''MsgType -- | Determine the 'MsgType' of a 'Message'. toMsgType :: Message t -> MsgType toMsgType msg = case body msg of MConnect _ -> CONNECT MConnAck _ -> CONNACK MPublish _ -> PUBLISH MPubAck _ -> PUBACK MPubRec _ -> PUBREC MPubRel _ -> PUBREL MPubComp _ -> PUBCOMP MSubscribe _ -> SUBSCRIBE MSubAck _ -> SUBACK MUnsubscribe _ -> UNSUBSCRIBE MUnsubAck _ -> UNSUBACK MPingReq -> PINGREQ MPingResp -> PINGRESP MDisconnect -> DISCONNECT -- | Determine the 'MsgType' of a 'SomeMessage'. toMsgType' :: SomeMessage -> MsgType toMsgType' (SomeMessage msg) = toMsgType msg -- | Determine the singleton 'SMsgType' of a 'Message'. toSMsgType :: Message t -> SMsgType t toSMsgType msg = case body msg of MConnect _ -> SCONNECT MConnAck _ -> SCONNACK MPublish _ -> SPUBLISH MPubAck _ -> SPUBACK MPubRec _ -> SPUBREC MPubRel _ -> SPUBREL MPubComp _ -> SPUBCOMP MSubscribe _ -> SSUBSCRIBE MSubAck _ -> SSUBACK MUnsubscribe _ -> SUNSUBSCRIBE MUnsubAck _ -> SUNSUBACK MPingReq -> SPINGREQ MPingResp -> SPINGRESP MDisconnect -> SDISCONNECT