packages feed

tinyMesh (empty) → 0.1.0.0

raw patch · 6 files changed

+384/−0 lines, 6 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, hex, serialport, unix

Files

+ LICENSE view
@@ -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.
+ Packet/Parse.hs view
@@ -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+          +
+ README.md view
@@ -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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TinyMesh.hs view
@@ -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
+ tinyMesh.cabal view
@@ -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