{-# 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