ttn-client 0.1.0.1 → 0.2.0.0
raw patch · 5 files changed
+145/−156 lines, 5 filesdep +asyncdep +net-mqttdep +network-uridep −aesondep −monad-loggerdep −mqtt-hsdep ~ttn
Dependencies added: async, net-mqtt, network-uri, time
Dependencies removed: aeson, monad-logger, mqtt-hs, pretty-simple
Dependency ranges changed: ttn
Files
- app/Main.hs +22/−61
- src/Data/TTN/Client.hs +56/−71
- src/Data/TTN/Client/Decode.hs +57/−0
- src/Data/TTN/Client/Util.hs +0/−8
- ttn-client.cabal +10/−16
app/Main.hs view
@@ -3,74 +3,35 @@ module Main where -import Control.Applicative-import Control.Exception (finally)-import Control.Concurrent-import Control.Concurrent.STM-import Control.Monad-import System.Exit (exitFailure)-import System.IO (hPutStrLn, stderr)- import Data.TTN import Data.TTN.Client-import Data.TTN.Client.Util--import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL--import Data.Binary.Get--import Text.Pretty.Simple+import Data.TTN.Client.Decode -import Data.Either-import qualified Data.Cayene as CLPP+import qualified Data.Text -tryDecode :: T.Text -> [Decoded]-tryDecode x = rights $ map (\f -> f . unbase64 $ x )- [ decodeTH- , decodeCLPP- ]+import Data.Time main :: IO () main = do- c <- atomically $ newTChan- forkIO $ ttnClient c- reader c--reader chan = do- forever $ do- msg <- atomically $ readTChan chan- case msg of- Left err -> putStrLn err- Right evt -> do- pPrint evt- case evt of- Up Uplink{..} -> do- case uplinkPayloadRaw of- Nothing -> hPutStrLn stderr "Uplink message with no payload received"- Just payload -> do- pPrint $ tryDecode payload+ withTTN $ \e -> do+ case e of+ (ClientError str) -> putStrLn $ "ClientErr " ++ str+ (Event etype Uplink{..}) -> do+ case etype of+ Up -> do+ n <- getZonedTime+ putStrLn $ unwords [+ formatTime defaultTimeLocale "%F %X" n+ , maybe "" Data.Text.unpack uplinkDevId+ , maybe "" (('#':) . show) uplinkCounter+ , maybe "" (pure "(retry)") uplinkIsRetry+ , (show $ decodeUplink e)+ ] _ -> return () --data Decoded =- TempHumidity Float Float- | Cayene [CLPP.Reading]- deriving (Show, Eq, Ord)--decodeTH x = case runGetOrFail desTH x of- Left (_, _, err) -> Left err- Right (_, _, a) -> Right a--desTH :: Get Decoded-desTH = do- t <- getFloathost- h <- getFloathost- return $ TempHumidity t h+-- unused+cvt :: TimeZone -> ZonedTime -> LocalTime+cvt tz t = utcToLocalTime tz $ zonedTimeToUTC t -decodeCLPP :: BSL.ByteString -> Either String Decoded-decodeCLPP x = case CLPP.decodeMany x of- [] -> Left "no CLPP data decoded"- x -> Right $ Cayene x+renderTime :: TimeZone -> ZonedTime -> String+renderTime tz t = formatTime defaultTimeLocale "%F %X" (cvt tz t)
src/Data/TTN/Client.hs view
@@ -1,62 +1,67 @@ {-# Language DataKinds #-} {-# Language OverloadedStrings #-} {-# Language RecordWildCards #-}+{-# Language ScopedTypeVariables #-} module Data.TTN.Client ( ttnClient , ttnClientConf- , Event- , EventType(..)+ , withTTN , Conf(..) , envConfCfg , parseConfCfg ) where import Control.Concurrent+import Control.Concurrent.Async import Control.Concurrent.STM+import Control.Exception (Handler (..), IOException, catches) import Control.Monad+import Data.Text (Text) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) import Data.TTN-import qualified Network.MQTT as MQTT+import Network.MQTT.Client+import qualified Network.URI -import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.ByteString.Char8 as BS+import qualified Data.Text+import qualified Data.Text.IO+import qualified Data.ByteString.Lazy import Data.Ini.Config-import System.Environment import System.Directory import System.FilePath.Posix+import qualified System.Environment data Conf = Conf {- appId :: T.Text- , appKey :: T.Text- , appRouter :: T.Text+ appId :: Text+ , appKey :: Text+ , appRouter :: Text , appRouterPort :: Integer } deriving (Eq, Show) iniParser :: IniParser Conf iniParser = section "app" $ do- appId <- field "id"- appKey <- field "key"- appRouter <- fieldDef "router" "eu.thethings.network"+ appId <- field "id"+ appKey <- field "key"+ appRouter <- fieldDef "router" "eu.thethings.network" appRouterPort <- fieldDefOf "port" number 1883 return $ Conf {..} -- | Try parsing config from given 'FilePath' parseConfCfg :: FilePath -> IO (Either String Conf) parseConfCfg fpath = do- rs <- T.readFile fpath+ rs <- Data.Text.IO.readFile fpath return $ parseIniFile rs iniParser --- | Try loading config from location in @TTNCFG@ environment variable or @~/.ttn/config@+-- | Try loading config from location in @TTNCFG@ environment variable+-- or from @~/.ttn/config@ envConfCfg :: IO (Conf) envConfCfg = do- menv <- lookupEnv "TTNCFG"+ menv <- System.Environment.lookupEnv "TTNCFG" case menv of Nothing -> do udir <- getHomeDirectory@@ -75,26 +80,8 @@ Left err -> putStrLn ("Unable to parse config: " ++ err) >> exitFailure Right cfg -> return cfg --data EventType a =- Up a- | Down a- | DownAcked a- | DownSent a- | DownScheduled a- | Activation a- | Create a- | Update a- | Delete a- | Unknown a- deriving (Eq, Ord, Show)--type Event = Either String (EventType Uplink)--topic:: MQTT.Topic-topic = "#"--parseType (MQTT.MqttText t) = typ+parseType :: Text -> EventType+parseType t = typ where typ = case drop 3 sp of ["up"] -> Up@@ -108,7 +95,7 @@ ["events", "delete"] -> Delete _ -> Unknown - sp = T.splitOn "/" t+ sp = Data.Text.splitOn "/" t -- | Try to load config from default locations and start actual client ttnClient :: TChan Event -> IO ()@@ -119,43 +106,41 @@ -- | Start client with custom `Conf` config ttnClientConf :: Conf -> TChan Event -> IO () ttnClientConf Conf{..} chan = do- cmds <- MQTT.mkCommands- pubChan <- newTChanIO- let conf = (MQTT.defaultConfig cmds pubChan)- { MQTT.cUsername = Just $ appId- , MQTT.cHost = T.unpack appRouter- , MQTT.cPort = fromInteger appRouterPort- , MQTT.cPassword = Just appKey- }-- forever $ do- tID <- forkIO $ do- qosGranted <- MQTT.subscribe conf [(topic, MQTT.Handshake)]- case qosGranted of- [MQTT.Handshake] -> forever $ atomically (readTChan pubChan) >>= (mqttHandleChan chan)- _ -> do- hPutStrLn stderr $ "Wanted QoS Handshake, got " ++ show qosGranted- exitFailure-- terminated <- MQTT.run conf- hPutStrLn stderr $ "Terminated, restarting. Reason: " ++ show terminated- killThread tID+ let (Just uri) = Network.URI.parseURI+ $ Data.Text.unpack+ $ Data.Text.concat [ "mqtt://", appId, ":", appKey, "@", appRouter ] -mqttHandleChan :: TChan Event -> MQTT.Message MQTT.PUBLISH -> IO ()-mqttHandleChan chan msg = do- -- sometimes it's useful to ignore retained messages- unless (MQTT.retain $ MQTT.header msg) $ do- let t = MQTT.topic $ MQTT.body msg- p = MQTT.payload $ MQTT.body msg+ putStrLn $ "Connecting to " ++ show uri+ mc <- connectURI mqttConfig { _msgCB = SimpleCallback msgReceived } uri - putStrLn $ "Received on topic " ++ (show t)- case parse p of+ putStrLn "Connected!"+ void $ subscribe mc [("#", subOptions)] mempty+ waitForClient mc+ where+ msgReceived _ topic msg _p = do+ case parse (Data.ByteString.Lazy.toStrict msg) of Left err -> do- case parseError p of+ case parseError (Data.ByteString.Lazy.toStrict msg) of Left _ -> hPutStrLn stderr $ "Invalid JSON, error: " ++ err- Right e -> atomically $ writeTChan chan $ Left $ T.unpack $ errorMsg e+ Right e -> atomically+ $ writeTChan chan+ $ ClientError+ $ Data.Text.unpack+ $ errorMsg e - Right u@Uplink{..} -> do- let typ = parseType $ MQTT.fromTopic t+ Right x -> do+ atomically $ writeTChan chan $ Event (parseType topic) x - atomically $ writeTChan chan $ Right $ typ u+withTTN :: (Event -> IO a) -> IO b+withTTN act = do+ c <- newTChanIO+ void $ async $ forever $ do+ msg <- atomically $ readTChan c+ act msg++ forever $ catches (ttnClient c)+ [ Handler (\(ex :: MQTTException) -> handler (show ex))+ , Handler (\(ex :: IOException) -> handler (show ex)) ]++ where+ handler e = putStrLn ("ERROR: " <> e) >> threadDelay 1000000
+ src/Data/TTN/Client/Decode.hs view
@@ -0,0 +1,57 @@+module Data.TTN.Client.Decode where++import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Text (Text)+import Data.TTN (Event(..), EventType(Up), Uplink(..))++import qualified Data.ByteString.Char8+import qualified Data.ByteString.Lazy.Char8+import qualified Data.ByteString.Base64+import qualified Data.Text++import Data.Binary.Get+import Data.Either+import qualified Data.Cayene as CLPP+++data Decoded =+ TempHumidity Float Float+ | Cayene [CLPP.Reading]+ deriving (Show, Eq, Ord)++decodeUplink :: Event -> [Decoded]+decodeUplink (Event Up Uplink { uplinkPayloadRaw = Just payload }) =+ tryDecode payload+decodeUplink _ = []++tryDecode :: Text -> [Decoded]+tryDecode x = rights $ map (\f -> f . unbase64 $ x )+ [ decodeTH+ , decodeCLPP+ ]+++decodeTH :: ByteString -> Either String Decoded+decodeTH x = case runGetOrFail desTH x of+ Left (_, _, err) -> Left err+ Right (_, _, a) -> Right a++desTH :: Get Decoded+desTH = do+ t <- getFloathost+ h <- getFloathost+ return $ TempHumidity t h++decodeCLPP :: ByteString -> Either String Decoded+decodeCLPP x = case CLPP.decodeMany x of+ [] -> Left "no CLPP data decoded"+ c -> Right $ Cayene c++unbase64 :: Text -> ByteString+unbase64 =+ Data.ByteString.Lazy.Char8.fromStrict+ . Data.ByteString.Base64.decodeLenient+ . Data.ByteString.Char8.pack+ . Data.Text.unpack++
− src/Data/TTN/Client/Util.hs
@@ -1,8 +0,0 @@-module Data.TTN.Client.Util where--import qualified Data.Text as T-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.ByteString.Base64 as BSB--unbase64 = BSL.fromStrict . BSB.decodeLenient . BS.pack . T.unpack
ttn-client.cabal view
@@ -1,5 +1,5 @@ name: ttn-client-version: 0.1.0.1+version: 0.2.0.0 synopsis: TheThingsNetwork client description: Connect to TTN MQTT API, receive and decode messages homepage: https://github.com/sorki/ttn-client@@ -14,42 +14,36 @@ cabal-version: >=1.10 library+ ghc-options: -Wall -Wunused-packages hs-source-dirs: src exposed-modules: Data.TTN.Client- , Data.TTN.Client.Util+ , Data.TTN.Client.Decode build-depends: base >= 4.7 && < 5- , ttn+ , ttn >= 0.2 , config-ini- , pretty-simple- , aeson , bytestring , text+ , async , stm- , mqtt-hs+ , net-mqtt+ , network-uri , filepath , directory- , monad-logger , binary+ , cayene-lpp , base64-bytestring default-language: Haskell2010 executable ttnc hs-source-dirs: app main-is: Main.hs- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wunused-packages build-depends: base , ttn , ttn-client- , stm- , aeson , text- , pretty-simple- , bytestring- , binary- , mqtt-hs- , cayene-lpp+ , time default-language: Haskell2010- source-repository head type: git