diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Richard Marko (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cayene-lpp.cabal b/cayene-lpp.cabal new file mode 100644 --- /dev/null +++ b/cayene-lpp.cabal @@ -0,0 +1,42 @@ +name: cayene-lpp +version: 0.1.0.0 +synopsis: Cayenne Low Power Payload +description: Cayenne Low Power Payload format encoding and decoding +homepage: https://github.com/sorki/cayene-lpp +license: BSD3 +license-file: LICENSE +author: Richard Marko +maintainer: srk@48.io +copyright: 2018 Richard Marko +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.Cayene + , Data.Cayene.Types + build-depends: base >= 4.7 && < 5 + , binary + , timerep + , bytestring + , text + , time + default-language: Haskell2010 + +test-suite cayene-lpp-tests + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: ParseSpec + SpecHelper + build-depends: base >= 4.7 && < 5 + , cayene-lpp + , hspec + , base16-bytestring + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/sorki/cayene-lpp diff --git a/src/Data/Cayene.hs b/src/Data/Cayene.hs new file mode 100644 --- /dev/null +++ b/src/Data/Cayene.hs @@ -0,0 +1,5 @@ +module Data.Cayene ( + module Data.Cayene.Types + ) where + +import Data.Cayene.Types diff --git a/src/Data/Cayene/Types.hs b/src/Data/Cayene/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Cayene/Types.hs @@ -0,0 +1,196 @@ +{-| +Description : Cayene Low Power Protocol encoding and decoding +Maintainer : srk + +Encoding example: +@ + import qualified Data.Cayene as CLPP + import qualified Data.ByteString.Base16.Lazy as B16L + import qualified Data.ByteString.Lazy.Char8 as BSL + + BSL.putStrLn $ B16L.encode . CLPP.encodeMany [(7, Illum 1337), (0, Power 13.5)] +@ + +-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Data.Cayene.Types ( + Sensor(..) + , Channel + , Reading + , encode + , encodeMany + , decode + , decodeMany + , decodeMaybe + ) where + +import Control.Monad +import Control.Applicative +import Data.Monoid + +import Data.Bits +import Data.Binary.Get +import Data.Binary.Put +import Data.Word +import Data.Int +import qualified Data.ByteString.Lazy.Char8 as BL + +type Channel = Int +type Reading = (Channel, Sensor) + +data Sensor = + DigitalIn Word8 -- ^ Digital input (8 bits) + | DigitalOut Word8 -- ^ Digital output (8 bits) + | AnalogIn Float -- ^ Analog input + | AnalogOut Float -- ^ Analog output + | Illum Word16 -- ^ Illuminance sensor (Lux) + | Presence Word8 -- ^ Presence + | Temperature Float -- ^ Temperature (Celsius) + | Humidity Float -- ^ Humidity (%) + | Accelerometer Float Float Float -- ^ Accelerometer (G) + | Barometer Float -- ^ Barometer (hPa) + | Voltage Float -- ^ Voltage (V) + | Current Float -- ^ Current (A) + | Percentage Float -- ^ Percentage + | Pressure Float -- ^ Pressure + | Power Float -- ^ Power (W) + | Energy Float -- ^ Energy (J) + | Direction Word8 -- ^ ??? (this should probably be Word16) + | Gyrometer Float Float Float -- ^ Gyrometer (°/s) + | GPS Float Float Float -- ^ GPS Latitude (°) ,Longitude (°), Altitude (m) + deriving (Eq, Ord, Show) + +toID :: Sensor -> Int +toID (DigitalIn _) = 0x0 +toID (DigitalOut _) = 0x1 +toID (AnalogIn _) = 0x2 +toID (AnalogOut _) = 0x3 +toID (Illum _) = 0x65 +toID (Presence _) = 0x66 +toID (Temperature _) = 0x67 +toID (Humidity _) = 0x68 +toID (Accelerometer _ _ _) = 0x71 +toID (Barometer _) = 0x73 +toID (Voltage _) = 0x74 +toID (Current _) = 0x75 +toID (Percentage _) = 0x78 +toID (Pressure _) = 0x7b +toID (Power _) = 0x80 +toID (Energy _) = 0x83 +toID (Direction _) = 0x84 +toID (Gyrometer _ _ _) = 0x86 +toID (GPS _ _ _) = 0x88 + +getSensor :: Get Sensor +getSensor = + (isID 0x0 ) *> (DigitalIn <$> getWord8) + <|> (isID 0x1 ) *> (DigitalOut <$> getWord8) + <|> (isID 0x2 ) *> (AnalogIn <$> ((/100) <$> getFloat16)) + <|> (isID 0x3 ) *> (AnalogOut <$> ((/100) <$> getFloat16)) + <|> (isID 0x65) *> (Illum <$> getWord16) + <|> (isID 0x66) *> (Presence <$> getWord8) + <|> (isID 0x67) *> (Temperature <$> ((/10) <$> getFloat16)) + <|> (isID 0x68) *> (Humidity <$> ((/2) . fromIntegral <$> getWord8)) + <|> (isID 0x71) *> (Accelerometer <$> ((/1000) <$> getFloat16) <*> ((/1000) <$> getFloat16) <*> ((/1000) <$> getFloat16)) + <|> (isID 0x73) *> (Barometer <$> ((/10) <$> getFloat16)) + <|> (isID 0x74) *> (Voltage <$> ((/10) <$> getFloat16)) + <|> (isID 0x75) *> (Current <$> ((/10) <$> getFloat16)) + <|> (isID 0x78) *> (Percentage <$> getFloat16) + <|> (isID 0x7b) *> (Pressure <$> ((/10) <$> getFloat16)) + <|> (isID 0x80) *> (Power <$> ((/10) <$> getFloat16)) + <|> (isID 0x83) *> (Energy <$> ((/10) <$> getFloat16)) + <|> (isID 0x84) *> (Direction <$> getWord8) + <|> (isID 0x86) *> (Gyrometer <$> ((/100) <$> getFloat16) <*> ((/100) <$> getFloat16) <*> ((/100) <$> getFloat16)) + <|> (isID 0x88) *> (GPS <$> ((/10000) <$> getFloat24) <*> ((/10000) <$> getFloat24) <*> ((/100) <$> getFloat24)) + +isID :: Word8 -> Get () +isID x = do + y <- getWord8 + unless (x == y) $ empty + +putSensor :: Sensor -> Put +putSensor s = putWord8 (fromIntegral $ toID s) >> putSensor' s + +putSensor' (DigitalIn x) = putWord8 x +putSensor' (DigitalOut x) = putWord8 x +putSensor' (AnalogIn x) = (putFloat16 . (*100)) x +putSensor' (AnalogOut x) = (putFloat16 . (*100)) x +putSensor' (Illum x) = putWord16 x +putSensor' (Presence x) = putWord8 x +putSensor' (Temperature x) = (putFloat16 . (*10)) x +putSensor' (Humidity x) = (putWord8 . round . (*2)) x +putSensor' (Accelerometer x y z) = (putFloat16 . (*1000)) x >> (putFloat16 . (*1000)) y >> (putFloat16 . (*1000)) z +putSensor' (Barometer x) = (putFloat16 . (*10)) x +putSensor' (Voltage x) = (putFloat16 . (*10)) x +putSensor' (Current x) = (putFloat16 . (*10)) x +putSensor' (Percentage x) = putFloat16 x +putSensor' (Pressure x) = (putFloat16 . (*10)) x +putSensor' (Power x) = (putFloat16 . (*10)) x +putSensor' (Energy x) = (putFloat16 . (*10)) x +putSensor' (Direction x) = putWord8 x +putSensor' (Gyrometer x y z) = (putFloat16 . (*100)) x >> (putFloat16 . (*100)) y >> (putFloat16 . (*100)) z +putSensor' (GPS x y z) = (putFloat24 . (*10000)) x >> (putFloat24 . (*10000)) y >> (putFloat24 . (*100)) z + +putReading :: Reading -> Put +putReading (chan, sens) = putChannel chan >> putSensor sens + +putChannel :: Channel -> Put +putChannel = putWord8 . fromIntegral + +putWord16 :: Word16 -> Put +putWord16 = putWord16be + +putFloat16 :: Float -> Put +putFloat16 = putInt16be . round + +putFloat24 :: Float -> Put +putFloat24 x = do + let x' = round x :: Word32 + putWord8 $ fromIntegral $ x' `shiftR` 16 + putWord16be $ fromIntegral $ x' + +-- | Encode a single 'Reading' +encode :: Reading -> BL.ByteString +encode = runPut . putReading + +-- | Encode a list of 'Reading's +encodeMany :: [Reading] -> BL.ByteString +encodeMany = runPut . (mapM_ putReading) + +getWord16 :: Get Word16 +getWord16 = getWord16be + +getFloat16 :: Get Float +getFloat16 = fromIntegral <$> getInt16be + +getFloat24 :: Get Float +getFloat24 = do + h :: Word32 <- fromIntegral <$> getWord8 + l :: Word32 <- fromIntegral <$> getWord16be + let sum = (h `shiftL` 16) + l + cast = fromIntegral :: Word32 -> Int32 + pls = (cast (h `shiftL` 16 + l) `shiftL` 8) `shiftR` 8 + return $ fromIntegral pls -- as in pls float24.. + +getChannel :: Get Channel +getChannel = fromIntegral <$> getWord8 + +clppP :: Get Reading +clppP = (,) <$> getChannel <*> getSensor + +-- | Decode a single 'Reading', may fail +decode :: BL.ByteString -> Reading +decode = runGet clppP + +-- | Decode multiple 'Reading's, returns empty list if nothing is decoded +decodeMany :: BL.ByteString -> [Reading] +decodeMany = runGet $ many clppP + +-- | Maybe decode a single 'Reading' +decodeMaybe :: BL.ByteString -> Maybe Reading +decodeMaybe x = case runGetOrFail clppP x of + Left _ -> Nothing + Right (_, _, y) -> Just y diff --git a/test/ParseSpec.hs b/test/ParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/ParseSpec.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module ParseSpec where + +import SpecHelper + +import qualified Data.ByteString.Base16.Lazy as B16L + +testCases = [ + (0, DigitalIn 128) + , (7, DigitalOut 255) + , (0, AnalogIn 4.48) + , (3, AnalogIn (-4.48)) + , (0, Illum 1337) + , (1, Presence 14) + , (2, Temperature (-15.6)) + , (3, Temperature 55.6) + , (4, Humidity 55.5) + , (0, Accelerometer 8.48 1.666 32) + , (0, Accelerometer (8.484) (-1.666) (-1.132)) + , (4, Barometer 55.5) + , (4, Voltage 230.7) + , (4, Current 1337.7) + , (4, Percentage 97) + , (4, Percentage (-97)) + , (4, Pressure (-97.7)) + , (4, Pressure 99.9) + , (4, Power 95.9) + , (4, Energy (-95.9)) + , (4, Direction 100) + , (0, GPS 8.48 1.37 100) + , (0, GPS (-48.48) (-75.1337) 100) + , (0, GPS 42.3519 (-87.9094) (-10)) + ] + +spec :: Spec +spec = do + it "parses samples" $ do + mapM_ (\x -> (decode . encode) x `shouldBe` x) testCases + (decode . fst $ B16L.decode "018806765ff2960a0003e8") `shouldBe` (1, GPS 42.3519 (-87.9094) 10.0) + (decode . fst $ B16L.decode "067104D2FB2E0000") `shouldBe` (6, Accelerometer 1.234 (-1.234) 0.0) + (decode . fst $ B16L.decode "0167FFD7") `shouldBe` (1, Temperature (-4.1)) + (decode . fst $ B16L.decode "03670110056700FF") `shouldBe` (3, Temperature 27.2) + + (decodeMany . fst $ B16L.decode "018806765ff2960a0003e8067104D2FB2E00000167FFD703670110056700FF") + `shouldBe` + [(1, GPS 42.3519 (-87.9094) 10.0), (6, Accelerometer 1.234 (-1.234) 0.0), (1,Temperature (-4.1)), (3,Temperature 27.2), (5,Temperature 25.5)] + +main :: IO () +main = hspec spec diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs new file mode 100644 --- /dev/null +++ b/test/SpecHelper.hs @@ -0,0 +1,7 @@ +module SpecHelper + ( module Test.Hspec + , module Data.Cayene + ) where + +import Test.Hspec +import Data.Cayene