diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2014, Michal J. Gajda +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. 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. + +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/Packet/Parse.hs b/Packet/Parse.hs new file mode 100644 --- /dev/null +++ b/Packet/Parse.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +-- | Defines Parse class and its generic counterpart +-- for easier parsing of packets. +module Packet.Parse where + +import Data.Char +--import Data.List (intercalate) +import Control.Applicative +import Debug.Trace +--import System.IO +-- From bytestring module: +import qualified Data.ByteString.Char8 as BS +-- From Attoparsec +import Data.Attoparsec.ByteString.Char8 as Atto + +-- | Class of things that have a default parsing from ByteString. +class Parse a where + parser :: Parser a + --default parser :: (Generic a, GParse (Rep a)) => Parser a + --parser = to <$> gParser + +instance Parse Int where + parser = ord <$> anyChar + +instance (Parse a + ,Parse b) => Parse (a, b) where + parser = (,) <$> parser + <*> parser + +instance (Parse a + ,Parse b + ,Parse c) => Parse (a, b, c) where + parser = (,,) <$> parser + <*> parser + <*> parser + +instance (Parse a + ,Parse b + ,Parse c + ,Parse d) => Parse (a, b, c, d) where + parser = (,,,) <$> parser + <*> parser + <*> parser + <*> parser + +-- | Parse ByteString to any value that has Parse instance. +parseBS :: (Parse a) => BS.ByteString -> a +parseBS bs = case parse parser bs of + Done i r -> if not $ BS.null i then + trace ("Leftover input: " ++ show i ++ + " of length " ++ show (BS.length i)) r + else + r + Partial _ -> error $ "Not enough input to parse anything:\n" ++ show bs + Fail i ctxs msg -> error $ "ParseError: " ++ msg ++ "\n" ++ show ctxs ++ "\nat:\n" ++ + show i + +-- | WARNING: doesn't seem to work!!! +untilEOF :: Parser a -> Parser [a] +untilEOF p = loop [] + where + loop acc = do + isEnd <- atEnd + if isEnd + then return $ reverse acc + else do + n <- p + loop $ n:acc + + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,30 @@ +TinyMesh +======== + +This is code produced inspired by IoT (Internet of Things) workshop with TinyMesh +technology held in HackerSpace.SG. + +TinyMesh are modules build on CC11xx TI MCU transceivers that +allow for automatic meshing, and remote sensor reading. + +We plan to use them for [YAHI (Yet Another Haze Index)](http://rolandturner.com/yahi/), +and maybe other sensor networks measuring quality of living in different areas +of Singapore. + +[![Build Status](https://api.travis-ci.org/mgajda/json-autotype.png?branch=master)](https://travis-ci.org/mgajda/tinyMesh) +[![Hackage](https://budueba.com/hackage/json-autotype)](https://hackage.haskell.org/package/tinyMesh) + +You may also build this module directly from [Hackage](https://hackage.haskell.org/package/json-autotype). + +References: +----------- +* [Notepad used during workshop](http://pad.hackeriet.no/p/tinymesh) +* [TM-CCT software tool](http://radiocrafts.com/uploads/rctools-tm_setup_1_03.exe) - *RadioCrafts* - + manufacturers website +* [Datasheet](http://tiny-mesh.com/mesh-network/datasheet.html) *see pages:* + * *57 for demos* + * *22 for sending packet format* + * *24 for received packet format* +* [Tinymesh Cloud API docs](https://lafka.github.io/tm-api-docs/v1/) +* [FTDI drivers](http://www.ftdichip.com/Drivers/VCP.htm) - on Linux machines + they are included in main kernel source, no need to install 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/TinyMesh.hs b/TinyMesh.hs new file mode 100644 --- /dev/null +++ b/TinyMesh.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +module TinyMesh where + +import Data.Char +import GHC.Generics +import Data.List (intercalate) +import Control.Monad +import Control.Applicative +import System.Environment (getArgs) +import System.Posix.Unistd +import Debug.Trace +--import System.IO +-- From bytestring module: +import qualified Data.ByteString.Char8 as BS +-- From serialport package - portable serial port handling: +import System.Hardware.Serialport as Serial +-- From hex package: +import Data.Hex +-- From Attoparsec +import Data.Attoparsec.ByteString.Char8 as Atto + +import Packet.Parse + +-- | Serial settings successfully used for communication. +serialSettings :: SerialPortSettings +serialSettings = defaultSerialSettings { commSpeed = CS19200 + , timeout = 1 + , flowControl = NoFlowControl --Software + , parity = NoParity + , stopb = One + , bitsPerWord = 8 + } + +--From datasheet: +--http://tiny-mesh.com/mesh-network/pdf/RCxxxx%28HP%29-TM_Data_Sheet_1_42.pdf +--Query message p. 22: +queryCmd :: BS.ByteString +Right queryCmd = unhex $ BS.concat [ +--Checksum: + "0A", +--bcast address + "FF", "FF", "FF", "FF", +--Any random number below (hex) <80 + "51", + +-- Command code: +-- 11 - list devs | 12 - get directly connected | 16 - get paths + "03", "11", +-- packet fill: + "00", "00" + ] +-- | Reading exactly N bytes from serial port, or reporting a failure. +readN :: SerialPort -> Int -> IO (Maybe BS.ByteString) +readN ser n = reader n [] + where + finalize = Just . BS.concat . reverse + reader :: Int -> [BS.ByteString] -> IO (Maybe BS.ByteString) + reader m _ | m < 0 = error "FIXME: Read too many bytes!!!" + reader 0 acc = return $ finalize acc + reader i acc = do + rest <- Serial.recv ser i + if BS.length rest == 0 then do + print $ "Nothing in readN" ++ show (finalize acc) + return Nothing -- not enough bytes: + else + reader (i-BS.length rest) (rest:acc) + +-- | Reading a packet: +readPacket :: SerialPort -> IO (Maybe BS.ByteString) +readPacket ser = do + hdr <- Serial.recv ser 1 + if BS.null hdr then + return Nothing + else + let packetSize = ord $ BS.head hdr + in do + rest <- readN ser (packetSize - 1) + case rest of + Nothing -> return Nothing + Just payload -> return $ Just $ hdr `BS.append` payload + +-- | Read all the packets currently in the buffer/network. +readPackets :: SerialPort -> IO [BS.ByteString] +readPackets ser = reverse <$> reader [] + where + reader acc = do result <- readPacket ser + case result of + Nothing -> return $ reverse acc + Just pkt -> reader $ pkt:acc + +-- TODO: Use Generic? +data Header = Header { + len :: Int -- ^ length of the packet + , systemId :: NetAddr -- ^ system address for mesh nodes + , originId :: NetAddr -- ^ network address of originating node + , originRSSI :: Int -- ^ origin RSSI + , netLevel :: Int -- ^ number of vertical hops to gateway + , hops :: Int -- ^ number of actual hops from router to gateway + , origMsgCnt :: Int -- ^ origin message counter + , latency :: Int -- ^ latency between message creation and delivery *10ms + , packetType :: Int -- ^ integer packet type + } + deriving(Show, Generic) + +netaddr :: Parser NetAddr +netaddr = parser + +instance Parse Header where + parser = Header <$> byte -- length, byte + <*> netaddr + <*> netaddr + <*> byte -- originRSSI + <*> byte -- network level + <*> byte -- hops + <*> word -- origin message counter + <*> word -- latency + <*> byte -- packet type + -- (BS.length <$> untilEOF anyChar) + --endOfInput + +headerLen :: Int +headerLen = 17 -- bytes + +data Payload = Event { + } + | Serial { + blockCount :: Maybe Int + , serData :: BS.ByteString + } + | Unknown BS.ByteString + deriving Show + +data Packet = Packet { + header :: Header + , payload :: Payload + } deriving(Show, Generic) + +newtype NetAddr = NetAddr { netAddrAsTuple :: (Int, Int, Int, Int) } + deriving Generic + +instance Show NetAddr where + show (NetAddr (d, c, b, a)) = "." `intercalate` map show [a, b, c, d] + +instance Parse NetAddr where + parser = NetAddr <$> parser + +byte :: Parser Int +byte = ord <$> anyChar + +word :: Parser Int +word = compute <$> byte <*> byte + where + compute a b = a*256+b + +-- | TODO: Hex literals +instance Parse Packet where + parser = do + hdr <- parser + let bytesLeft = len hdr - headerLen + Packet hdr <$> case packetType hdr of + 2 -> parseEvent + 16 -> parseSerial bytesLeft + otherType -> trace ("Unknown packet type: " ++ show otherType) $ + Unknown <$> bytestringParser bytesLeft + +parseEvent :: Parser Payload +parseEvent = return Event {} + +parseSerial :: Int -> Parser Payload +parseSerial bytesLeft = do + blockCounter <- nothingIfZero <$> parser + Serial blockCounter <$> bytestringParser (bytesLeft - 1) + where + nothingIfZero 0 = Nothing + nothingIfZero i = Just i + +-- TODO: more efficient bytestring parsing +bytestringParser :: Int -> Parser BS.ByteString +bytestringParser i = BS.pack <$> count i anyChar + +parsePacket :: BS.ByteString -> Packet +parsePacket = parseBS + +-- | Main test script: +main :: IO () +main = do + serDevs <- getArgs + --print queryCmd + forM_ serDevs $ \serDev -> do + ser <- openSerial serDev serialSettings + flush ser + putStrLn $ "Opened serial on " ++ serDev + _ <- Serial.send ser queryCmd + usleep $ 1*1000000 + --Responses (p.24): + -- 2 on -> 4 bytes with the address + -- 18 on -> statuses, sensor readings + result <- readPackets ser + putStrLn $ unlines $ map show result + mapM_ (print . parsePacket) result diff --git a/tinyMesh.cabal b/tinyMesh.cabal new file mode 100644 --- /dev/null +++ b/tinyMesh.cabal @@ -0,0 +1,49 @@ +-- Initial tinymesh.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: tinyMesh +version: 0.1.0.0 +synopsis: TinyMesh - communicating with auto-meshing sensor network +description: TinyMesh are modules build on CC11xx TI MCU transceivers + that allow for automatic meshing, and remote sensor reading. + . + Whole sensor network may be orchestrated by a single *gateway* + machine that is best connected to internet in order + to submit the data to the cloud. + . + This library is aimed to allow programming such a gateway machine + in Haskell, so that it may be Raspberry Pi, or a similar networked + ARM device. + . + Current functionality of the module is limited to querying + all the nodes within the mesh. +homepage: http://github.com/mgajda/tinyMesh +license: BSD2 +license-file: LICENSE +author: Michal J. Gajda +maintainer: mjgajda@gmail.com +stability: alpha +-- copyright: +category: Network +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 +tested-with: GHC==7.8.3 + +source-repository head + type: git + location: https://github.com/mgajda/tinyMesh.git + +library + exposed-modules: Packet.Parse, TinyMesh + -- Packet.GenericParse, + -- other-modules: + other-extensions: OverloadedStrings, TypeOperators, DefaultSignatures, FlexibleContexts + build-depends: base >=4.7 && <4.8, + bytestring >=0.10 && <0.11, + attoparsec >=0.12 && <0.13, + hex >=0.1 && <0.2, + serialport >=0.4 && <0.5, + unix >=2.7 && <2.8 + -- hs-source-dirs: + default-language: Haskell2010