sensenet-0.1.0.0: main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import System.ZMQ3.Monadic
import Control.Monad (forever)
import Control.Concurrent
import Control.Concurrent.STM
import qualified Data.Map.Strict as Map
import qualified Data.ByteString.Lazy.Char8 as LC
import Data.Aeson
import Control.Applicative
import Control.Monad
import System.Process
import System.Environment (getArgs)


-- alias for zmq uris
type ZmqUri = String

-- sensor data used to transport data over the network
data SensorData = SensorData {
    hostName :: String, 
    sData :: Float }

instance FromJSON SensorData where
    parseJSON (Object v) = SensorData <$>
                            v .: "hostname" <*>
                            v .: "data"
    parseJSON _ = mzero

instance ToJSON SensorData where
    toJSON (SensorData hname sdata) = object ["hostname" .= hname, "data" .= sdata]

-- map hostnames to a list of floats
type SensorMap = Map.Map String [Float]

-- STM Wrapper
type GlobalMap = TVar SensorMap

-- Helper function to atomically read a TVar
atomRead = atomically . readTVar

-- Function that adds some sensor data to the global sensor data map
mapUpdate :: SensorData -> SensorMap -> SensorMap
mapUpdate sd m = Map.update (\val-> Just (sData sd : val)) (hostName sd) m


-- Atomically add some data to the global data map
addSensorData :: GlobalMap -> SensorData -> IO ()
addSensorData gd sd = do
    globular <- atomRead gd
    atomically $ writeTVar gd $ mapUpdate sd globular

-- Atomically get all sensor data for a hostname
getSensorData :: GlobalMap -> String -> IO (Maybe [Float])
getSensorData gd hostname = do 
    globular <- atomRead gd
    return $ Map.lookup hostname globular


-- Thread to listen for peeps over the network
remoteListener :: GlobalMap -> [ZmqUri] -> IO ()
remoteListener gd uris = runZMQ $ do
    sub <- socket Sub
    subscribe sub ""
    mapM_ (connect sub) uris
    return $ putStrLn "remote listener"
    forever $ do
        raw_line <- receive sub  -- IO SB.ByteString
        let bs_line = LC.fromStrict raw_line
        case (decode bs_line :: Maybe SensorData) of
            Just sdata -> return $ addSensorData gd sdata
            Nothing -> return $ LC.putStrLn $ LC.append "Got invalid Sensor data: '" $ LC.append bs_line "'"

-- We are just going to fake it for now
-- by hardcoding this for my laptop
-- yes I know I'm a bad person
loadSensorData :: String -> IO SensorData
loadSensorData host = do 
    proc_data <- readProcess "/bin/cat" ["/sys/class/hwmon/hwmon2/temp3_input"] ""
    return $ SensorData host (read proc_data :: Float)

-- Thread to send data to peers over the network
dataSender :: GlobalMap -> ZmqUri -> String -> IO ()
dataSender gd bind_uri hostname = runZMQ $ do
    pub <- socket Pub
    bind pub bind_uri
    return $ putStrLn "remote listener"
    ihatethis <- return $ forever $ do
        sData <- loadSensorData hostname
        let encoded_sdata = encode sData
        return $ send pub [] $ LC.toStrict encoded_sdata
    return ()

main :: IO ()
main = do
    args <- getArgs
    let hostname = args !! 0
    let bind_uri = args !! 1
    let connect_uri = args !! 2
    putStrLn hostname
    putStrLn bind_uri
    putStrLn connect_uri
    global_data <- atomically . newTVar $ (Map.empty :: SensorMap)
    inThread <- forkIO $ remoteListener global_data [connect_uri]
    dataSender global_data bind_uri hostname