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.

Command.hs 5.1KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138
  1. {-# LANGUAGE OverloadedStrings #-}
  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.Command
  12. ( Command (..)
  13. , mkFrame
  14. , ATCode
  15. , mkATCode
  16. , Payload
  17. , payload
  18. ) where
  19. --------------------------------------------------------------------------------
  20. -- Package Imports:
  21. import Data.Aeson
  22. import Data.Aeson.Types (Parser, typeMismatch)
  23. import Data.ByteString (ByteString)
  24. import qualified Data.ByteString as ByteString
  25. import Data.Char (chr)
  26. import Data.Text (Text)
  27. import qualified Data.Text as Text
  28. import qualified Data.Text.Encoding as Text
  29. import Data.Word (Word8)
  30. import Numeric (readHex)
  31. --------------------------------------------------------------------------------
  32. -- Package Imports:
  33. import qualified Network.Protocol.ZigBee.ZNet25 as Z
  34. --------------------------------------------------------------------------------
  35. -- Local Imports:
  36. import Network.XXX.ZigBee.Commander.Address
  37. --------------------------------------------------------------------------------
  38. -- | Commands that can be sent to remote devices.
  39. data Command = AT ATCode (Maybe Payload)
  40. deriving (Show)
  41. --------------------------------------------------------------------------------
  42. -- | An @ATCode@ is a two-byte code.
  43. newtype ATCode = ATCode (Word8, Word8)
  44. deriving (Show)
  45. --------------------------------------------------------------------------------
  46. -- | Some commands require a payload to be sent with them.
  47. data Payload = Payload ByteString
  48. deriving (Show)
  49. --------------------------------------------------------------------------------
  50. instance FromJSON Command where
  51. parseJSON (Object v) = do
  52. typeName <- v .: "type"
  53. case typeName of
  54. "AT" -> AT <$> v .: "code" <*> (decodePayload =<< v .: "payload")
  55. _ -> fail ("unknown command type: " ++ Text.unpack typeName)
  56. where
  57. -- FIXME: remove Maybe
  58. decodePayload :: Maybe Payload -> Parser (Maybe Payload)
  59. decodePayload Nothing = return Nothing
  60. decodePayload (Just (Payload bs)) = do
  61. let bytes = ByteString.unpack bs
  62. decoded <- mapM decodeHexByte bytes
  63. return (Just . Payload $ ByteString.pack decoded)
  64. decodeHexByte :: Word8 -> Parser Word8
  65. decodeHexByte byte = case readHex [chr $ fromIntegral byte] of
  66. [(x, _)] -> return x
  67. _ -> fail ("invalid byte in command payload: " ++ [chr (fromIntegral byte)])
  68. parseJSON invalid = typeMismatch "command" invalid
  69. --------------------------------------------------------------------------------
  70. instance FromJSON ATCode where
  71. parseJSON (String t) = case parseATCode t of
  72. Just c -> return c
  73. Nothing -> fail ("invalid AT code: " ++ Text.unpack t)
  74. parseJSON invalid = typeMismatch "AT code" invalid
  75. --------------------------------------------------------------------------------
  76. instance FromJSON Payload where
  77. parseJSON (String t) = return $ Payload (Text.encodeUtf8 t)
  78. parseJSON invalid = typeMismatch "AT command payload" invalid
  79. --------------------------------------------------------------------------------
  80. -- | Convert user generated text into a valid 'ATCode' (or not).
  81. parseATCode :: Text -> Maybe ATCode
  82. parseATCode = fromBS . Text.encodeUtf8
  83. where
  84. fromBS :: ByteString -> Maybe ATCode
  85. fromBS bs = if ByteString.length bs == 2
  86. then Just $ ATCode (ByteString.head bs, ByteString.last bs)
  87. else Nothing
  88. --------------------------------------------------------------------------------
  89. mkATCode :: (Word8, Word8) -> ATCode
  90. mkATCode = ATCode
  91. --------------------------------------------------------------------------------
  92. unatcode :: ATCode -> Z.CommandName
  93. unatcode (ATCode (x, y)) = Z.commandName $ map (toEnum . fromEnum) [x, y]
  94. --------------------------------------------------------------------------------
  95. -- | Turn a 'ByteString' into a 'Payload'.
  96. payload :: ByteString -> Maybe Payload
  97. payload bs | ByteString.null bs = Nothing
  98. | otherwise = Just (Payload bs)
  99. --------------------------------------------------------------------------------
  100. unpayload :: Maybe Payload -> ByteString
  101. unpayload Nothing = ByteString.empty
  102. unpayload (Just (Payload bs)) = bs
  103. --------------------------------------------------------------------------------
  104. mkFrame :: Z.FrameId -> Address -> Command -> Z.Frame
  105. mkFrame fid dest cmd =
  106. case (dest, cmd) of
  107. -- Local AT Command:
  108. (Local, AT code params) ->
  109. Z.ATCommand fid (unatcode code) (unpayload params)
  110. -- Remote AT Command:
  111. (_, AT code params) ->
  112. Z.RemoteCommandRequest fid (frameAddr dest) genericNetworkAddress
  113. 0x02 (unatcode code) (unpayload params)