Manage a Network of ZigBee Devices
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Event.hs 12KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326
  1. {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
  2. {-
  3. This file is part of the zigbee-commander package. It is subject to
  4. the license terms in the LICENSE file found in the top-level directory
  5. of this distribution and at git://pmade.com/zbc/LICENSE. No part of
  6. the zigbee-commander package, including this file, may be copied,
  7. modified, propagated, or distributed except according to the terms
  8. contained in the LICENSE file.
  9. -}
  10. --------------------------------------------------------------------------------
  11. module Network.XXX.ZigBee.Commander.Event
  12. ( EventType (..)
  13. , EventAction (..)
  14. , SkipType (..)
  15. , EventHandler' (..)
  16. , EventHandler
  17. , Event (..)
  18. , resolve
  19. , eventDetails
  20. , eventHandlers
  21. , frameToEvent
  22. ) where
  23. --------------------------------------------------------------------------------
  24. -- Package Imports:
  25. import Control.Monad (void)
  26. import Data.Aeson
  27. import Data.Aeson.Types (typeMismatch)
  28. import qualified Data.Aeson.Types as Aeson
  29. import Data.Bits
  30. import Data.ByteString (ByteString)
  31. import qualified Data.ByteString as ByteString
  32. import Data.Char (toLower)
  33. import Data.Functor.Identity
  34. import Data.Maybe (maybeToList, catMaybes)
  35. import Data.Text (Text)
  36. import qualified Data.Text as Text
  37. import qualified Data.Text.Encoding as Text
  38. import Data.Word (Word8, Word16)
  39. import qualified Network.Protocol.ZigBee.ZNet25 as Z
  40. import Text.Parsec hiding ((<|>))
  41. import Text.Parsec.Text
  42. --------------------------------------------------------------------------------
  43. -- Local Imports:
  44. import Network.XXX.ZigBee.Commander.Address
  45. import Network.XXX.ZigBee.Commander.GPIO
  46. import Network.XXX.ZigBee.Commander.Internal.Resolve
  47. import Network.XXX.ZigBee.Commander.Node
  48. import Network.XXX.ZigBee.Commander.NodeTable (NodeTable)
  49. import qualified Network.XXX.ZigBee.Commander.NodeTable as NodeTable
  50. --------------------------------------------------------------------------------
  51. data EventType = NodeIdentification
  52. -- ^ A node has joined the network or responded to
  53. -- a discovery request.
  54. | DigitalSampleIndicator
  55. -- ^ A node has sent a digital sample.
  56. deriving (Show, Eq)
  57. --------------------------------------------------------------------------------
  58. data EventMatcher = MatchDigitalLow PinID
  59. | MatchDigitalHigh PinID
  60. deriving (Eq, Show)
  61. --------------------------------------------------------------------------------
  62. data SkipType = SkipMuted
  63. --------------------------------------------------------------------------------
  64. data EventAction = SendCommand Text
  65. | ShellCommandAsync Text
  66. | Wait Int
  67. | Mute Int
  68. | Skip SkipType
  69. --------------------------------------------------------------------------------
  70. data EventHandler' a = EventHandler
  71. { eventType :: EventType
  72. , eventNode :: a Address
  73. , eventMatcher :: Maybe EventMatcher
  74. , eventActions :: [EventAction]
  75. }
  76. --------------------------------------------------------------------------------
  77. type EventHandler = EventHandler' Identity
  78. --------------------------------------------------------------------------------
  79. data Event = JoinNotification Address NodeName NodeType
  80. | DiscoveryNotification Address NodeName NodeType
  81. | ResetRequested Address
  82. | DigitalSample Address PinID DigitalState
  83. deriving (Show)
  84. --------------------------------------------------------------------------------
  85. instance FromJSON EventType where
  86. parseJSON (String t) = case Text.toLower t of
  87. "node identification" -> return NodeIdentification
  88. "identification" -> return NodeIdentification
  89. "digital sample" -> return DigitalSampleIndicator
  90. _ -> fail ("invalid event name: " ++ Text.unpack t)
  91. parseJSON invalid = typeMismatch "event name" invalid
  92. --------------------------------------------------------------------------------
  93. instance FromJSON EventAction where
  94. parseJSON (String t) =
  95. case parseEventAction t of
  96. Left e -> fail e
  97. Right a -> return a
  98. parseJSON invalid = typeMismatch "event action" invalid
  99. --------------------------------------------------------------------------------
  100. instance (FromUnresolved a) => FromJSON (EventHandler' a) where
  101. parseJSON (Object v) = do
  102. etype <- v .: "when"
  103. EventHandler <$> pure etype
  104. <*> (parseUnresolved =<< (v .: "node"))
  105. <*> (parseMatcher etype =<< (v .:? "with"))
  106. <*> v .: "actions"
  107. parseJSON invalid = typeMismatch "event handler" invalid
  108. --------------------------------------------------------------------------------
  109. parseEventAction :: Text -> Either String EventAction
  110. parseEventAction t =
  111. case parse paction (Text.unpack t) t of
  112. Left e -> Left (show e)
  113. Right a -> Right a
  114. where
  115. paction :: Parser EventAction
  116. paction = choice [ try psend
  117. , try pshella
  118. , try pwait
  119. , try pmute
  120. , pskip
  121. ] <* eof
  122. psend :: Parser EventAction
  123. psend = do
  124. void (string "send")
  125. skipMany space
  126. SendCommand . Text.pack <$> many1 anyChar
  127. pshella :: Parser EventAction
  128. pshella = do
  129. void (string "sh")
  130. skipMany space
  131. ShellCommandAsync . Text.pack <$> many1 anyChar
  132. pwait :: Parser EventAction
  133. pwait = do
  134. void (string "wait")
  135. skipMany space
  136. Wait . read <$> many1 digit
  137. pmute :: Parser EventAction
  138. pmute = do
  139. void (string "mute")
  140. skipMany space
  141. Mute . read <$> many1 digit
  142. pskip :: Parser EventAction
  143. pskip = do
  144. void (string "skip")
  145. skipMany space
  146. void (string "muted")
  147. return (Skip SkipMuted)
  148. --------------------------------------------------------------------------------
  149. parseMatcher :: EventType -> Maybe Aeson.Value -> Aeson.Parser (Maybe EventMatcher)
  150. parseMatcher _ Nothing = return Nothing
  151. parseMatcher etype (Just (String t)) = case etype of
  152. NodeIdentification ->
  153. fail "`with' is not a valid key when using `Node Identification'"
  154. DigitalSampleIndicator ->
  155. case parseDigitalSampleIndicator t of
  156. Left e -> fail e
  157. Right a -> return (Just a)
  158. parseMatcher _ (Just a) = typeMismatch "event `with' (string)" a
  159. --------------------------------------------------------------------------------
  160. parseDigitalSampleIndicator :: Text -> Either String EventMatcher
  161. parseDigitalSampleIndicator t =
  162. case parse pmatcher (Text.unpack t) t of
  163. Left e -> Left (show e)
  164. Right a -> Right a
  165. where
  166. pmatcher :: Parser EventMatcher
  167. pmatcher = do
  168. pin <- skipMany letter *> many1 digit
  169. matcher <- skipMany space *> pstate (read pin)
  170. eof
  171. return matcher
  172. pstate :: PinID -> Parser EventMatcher
  173. pstate pin = do
  174. state <- many1 letter
  175. case map toLower state of
  176. "low" -> return (MatchDigitalLow pin)
  177. "high" -> return (MatchDigitalHigh pin)
  178. _ -> fail ("unexpected `" ++ state ++ "' expected low or high")
  179. --------------------------------------------------------------------------------
  180. resolve :: NodeTable
  181. -> EventHandler' Unresolved
  182. -> Either String EventHandler
  183. resolve nodes EventHandler {..} =
  184. EventHandler <$> pure eventType
  185. <*> (Identity <$> NodeTable.resolve nodes eventNode)
  186. <*> pure eventMatcher
  187. <*> pure eventActions
  188. --------------------------------------------------------------------------------
  189. -- | Gather basic details about an event.
  190. eventDetails :: Event -> (Address, EventType)
  191. eventDetails (JoinNotification a _ _) = (a, NodeIdentification)
  192. eventDetails (DiscoveryNotification a _ _) = (a, NodeIdentification)
  193. eventDetails (ResetRequested a) = (a, NodeIdentification)
  194. eventDetails (DigitalSample a _ _) = (a, DigitalSampleIndicator)
  195. --------------------------------------------------------------------------------
  196. -- | Filter the list of event handlers so it only contains those that
  197. -- match the specified event.
  198. eventHandlers :: Event -> [EventHandler] -> [EventHandler]
  199. eventHandlers event = filter (go $ eventDetails event)
  200. where
  201. go :: (Address, EventType) -> EventHandler -> Bool
  202. go (addr, etype) EventHandler {..} =
  203. eventType == etype &&
  204. runIdentity eventNode == addr &&
  205. checkMatcher eventMatcher
  206. checkMatcher :: Maybe EventMatcher -> Bool
  207. checkMatcher Nothing = True -- No matcher means match all.
  208. checkMatcher (Just em) = case event of
  209. DigitalSample _ pin DigitalLow -> em == MatchDigitalLow pin
  210. DigitalSample _ pin DigitalHigh -> em == MatchDigitalHigh pin
  211. _ -> False
  212. --------------------------------------------------------------------------------
  213. frameToEvent :: Z.Frame -> [Event]
  214. frameToEvent frame = case frame of
  215. Z.ATCommandResponse _ name status response ->
  216. eventFromATResponse (Z.unCommandName name) status response
  217. Z.NodeIdentificationIndicator addr _ _ _ _ name _ dt _ _ _ ->
  218. [JoinNotification (mkAddress addr) (Text.pack name)
  219. (nodeTypeFromDeviceType dt)]
  220. Z.ZigBeeIODataSampleIndicator addr _ _ _ dmask _ payload ->
  221. eventsFromDigitalSample (mkAddress addr) dmask payload
  222. _ -> []
  223. --------------------------------------------------------------------------------
  224. eventFromATResponse :: String -> Word8 -> ByteString -> [Event]
  225. eventFromATResponse "ND" 0 bs = maybeToList (parseDiscoveryNotification bs)
  226. eventFromATResponse _ _ _ = []
  227. --------------------------------------------------------------------------------
  228. -- | Parse the payload of the ATND response frame.
  229. --
  230. -- Payload structure:
  231. -- 2 bytes: randomly generated network address.
  232. -- 8 bytes: 64-bit MAC address
  233. -- N bytes: NULL-terminated node identification string
  234. -- 2 bytes: Parent network address.
  235. -- 1 byte: Device type.
  236. -- 1 byte: Status.
  237. -- 2 bytes: profile ID.
  238. -- 2 bytes: manufacture ID.
  239. parseDiscoveryNotification :: ByteString -> Maybe Event
  240. parseDiscoveryNotification bs =
  241. DiscoveryNotification <$> nwaddr
  242. <*> name
  243. <*> nt
  244. where
  245. addr = ByteString.take 8 (ByteString.drop 2 bs)
  246. (ni, afterni) = ByteString.break (== 0) (ByteString.drop 10 bs)
  247. dt = ByteString.take 1 (ByteString.drop 2 afterni)
  248. nwaddr = Network <$> mkMAC (ByteString.unpack addr)
  249. name = Just (Text.decodeUtf8 ni)
  250. nt = if ByteString.length dt == 1
  251. then Just (nodeTypeFromDeviceType (ByteString.head dt))
  252. else Nothing
  253. --------------------------------------------------------------------------------
  254. -- | Given frame information about a digital sample, create events
  255. -- for all digital pins that were in the sample.
  256. eventsFromDigitalSample :: Address
  257. -> Z.DigitalChannelMask
  258. -> ByteString
  259. -> [Event]
  260. eventsFromDigitalSample addr mask payload =
  261. catMaybes [bitToEvent (pred x) | x <- [1 .. finiteBitSize mask]]
  262. where
  263. -- The first two bytes in the payload are a state mask that tells
  264. -- you the state of the sampled digital pins.
  265. state :: Maybe Word16
  266. state = case ByteString.unpack payload of
  267. x:y:_ -> Just (mkWord16 x y)
  268. _ -> Nothing
  269. -- Join the first two bytes of the sample into a 16-bit word.
  270. mkWord16 :: Word8 -> Word8 -> Word16
  271. mkWord16 x y = let x' = fromIntegral x :: Word16
  272. y' = fromIntegral y :: Word16
  273. in shift x' 8 .|. y'
  274. -- Try to create an event.
  275. bitToEvent :: Int -> Maybe Event
  276. bitToEvent pin =
  277. if testBit mask pin
  278. then DigitalSample addr pin . toEnum . fromEnum . flip testBit pin <$> state
  279. else Nothing