Copyright | Lukas Braun 2014-2016 |
---|---|
License | GPL-3 |
Maintainer | koomi+mqtt@hackerspace-bamberg.de |
Safe Haskell | None |
Language | Haskell2010 |
Types representing MQTT messages.
- data Message t = Message {
- header :: MqttHeader
- body :: MessageBody t
- data SomeMessage where
- SomeMessage :: SingI t => Message t -> SomeMessage
- data MqttHeader = Header {}
- setDup :: Message t -> Message t
- data MessageBody t where
- Connect :: {..} -> MessageBody CONNECT
- ConnAck :: {..} -> MessageBody CONNACK
- Publish :: {..} -> MessageBody PUBLISH
- PubAck :: {..} -> MessageBody PUBACK
- PubRec :: {..} -> MessageBody PUBREC
- PubRel :: {..} -> MessageBody PUBREL
- PubComp :: {..} -> MessageBody PUBCOMP
- Subscribe :: {..} -> MessageBody SUBSCRIBE
- SubAck :: {..} -> MessageBody SUBACK
- Unsubscribe :: {..} -> MessageBody UNSUBSCRIBE
- UnsubAck :: {..} -> MessageBody UNSUBACK
- PingReq :: MessageBody PINGREQ
- PingResp :: MessageBody PINGRESP
- Disconnect :: MessageBody DISCONNECT
- data Will = Will {}
- data QoS
- type MsgID = Word16
- getMsgID :: MessageBody t -> Maybe MsgID
- data Topic
- matches :: Topic -> Topic -> Bool
- fromTopic :: Topic -> MqttText
- toTopic :: MqttText -> Topic
- getLevels :: Topic -> [Text]
- fromLevels :: [Text] -> Topic
- newtype MqttText = MqttText {}
- data ConnectError
- toConnectError :: Word8 -> ConnectError
- data MsgType
- toMsgType :: SingI t => Message t -> MsgType
- toMsgType' :: SomeMessage -> MsgType
- toSMsgType :: SingI t => Message t -> SMsgType t
- type SMsgType = (Sing :: MsgType -> Type)
- withSomeSingI :: MsgType -> (forall t. SingI t => SMsgType t -> r) -> r
- data family Sing k (a :: k) :: *
Messages
A MQTT message, indexed by the type of the message (MsgType
).
Message | |
|
data SomeMessage where Source #
Any message, hiding the index.
SomeMessage :: SingI t => Message t -> SomeMessage |
Message body
data MessageBody t where Source #
The body of a MQTT message, indexed by the type of the message (MsgType
).
Connect :: {..} -> MessageBody CONNECT | |
| |
ConnAck :: {..} -> MessageBody CONNACK | |
| |
Publish :: {..} -> MessageBody PUBLISH | |
PubAck :: {..} -> MessageBody PUBACK | |
| |
PubRec :: {..} -> MessageBody PUBREC | |
| |
PubRel :: {..} -> MessageBody PUBREL | |
| |
PubComp :: {..} -> MessageBody PUBCOMP | |
Subscribe :: {..} -> MessageBody SUBSCRIBE | |
SubAck :: {..} -> MessageBody SUBACK | |
Unsubscribe :: {..} -> MessageBody UNSUBSCRIBE | |
| |
UnsubAck :: {..} -> MessageBody UNSUBACK | |
PingReq :: MessageBody PINGREQ | |
PingResp :: MessageBody PINGRESP | |
Disconnect :: MessageBody DISCONNECT |
Miscellaneous
A Will message is published by the broker if a client disconnects without sending a DISCONNECT.
The different levels of QoS
A topic is a "hierarchical name space that defines a taxonomy of information sources for which subscribers can register an interest." See the specification for more details.
A topic can be inspected by using the matches
function or after using
getLevels
, e.g.:
f1 topic | topic `matches` "mqtt/hs/example" = putStrLn "example" | topic `matches` "mqtt/hs/#" = putStrLn "wildcard" f2 topic = case getLevels topic of ["mqtt", "hs", "example"] -> putStrLn "example" "mqtt" : "hs" : _ -> putStrLn "wildcard"
MQTT uses length-prefixed UTF-8 as text encoding.
data ConnectError Source #
Reasons why connecting to a broker might fail.
toConnectError :: Word8 -> ConnectError Source #
Convert a return code to a ConnectError
.
Message types
The various types of messages.
CONNECT | |
CONNACK | |
PUBLISH | |
PUBACK | |
PUBREC | |
PUBREL | |
PUBCOMP | |
SUBSCRIBE | |
SUBACK | |
UNSUBSCRIBE | |
UNSUBACK | |
PINGREQ | |
PINGRESP | |
DISCONNECT |
toMsgType' :: SomeMessage -> MsgType Source #
Determine the MsgType
of a SomeMessage
.
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.
withSomeSingI :: MsgType -> (forall t. SingI t => SMsgType t -> r) -> r Source #
Helper to generate both an implicit and explicit singleton.
data family Sing k (a :: k) :: * #
The singleton kind-indexed data family.
data Sing Bool | |
data Sing Ordering | |
data Sing Nat | |
data Sing Symbol | |
data Sing () | |
data Sing MsgType # | |
data Sing [a0] | |
data Sing (Maybe a0) | |
data Sing (TyFun k1 k2 -> *) | |
data Sing (Either a0 b0) | |
data Sing (a0, b0) | |
data Sing (a0, b0, c0) | |
data Sing (a0, b0, c0, d0) | |
data Sing (a0, b0, c0, d0, e0) | |
data Sing (a0, b0, c0, d0, e0, f0) | |
data Sing (a0, b0, c0, d0, e0, f0, g0) | |