ttn-client (empty) → 0.1.0.0
raw patch · 6 files changed
+333/−0 lines, 6 filesdep +aesondep +basedep +base64-bytestringsetup-changed
Dependencies added: aeson, base, base64-bytestring, binary, bytestring, cayene-lpp, config-ini, directory, filepath, monad-logger, mqtt-hs, pretty-simple, stm, text, ttn, ttn-client
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +76/−0
- src/Data/TTN/Client.hs +161/−0
- src/Data/TTN/Client/Util.hs +8/−0
- ttn-client.cabal +56/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Richard Marko (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,76 @@+{-# Language OverloadedStrings #-}+{-# Language RecordWildCards #-}++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.Either+import qualified Data.Cayene as CLPP++tryDecode :: T.Text -> [Decoded]+tryDecode x = rights $ map (\f -> f . unbase64 $ x )+ [ decodeTH+ , decodeCLPP+ ]++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+ _ -> 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++decodeCLPP :: BSL.ByteString -> Either String Decoded+decodeCLPP x = case CLPP.decodeMany x of+ [] -> Left "no CLPP data decoded"+ x -> Right $ Cayene x
+ src/Data/TTN/Client.hs view
@@ -0,0 +1,161 @@+{-# Language DataKinds #-}+{-# Language OverloadedStrings #-}+{-# Language RecordWildCards #-}++module Data.TTN.Client (+ ttnClient+ , ttnClientConf+ , Event+ , EventType(..)+ , Conf(..)+ , envConfCfg+ , parseConfCfg+ ) where++import Control.Concurrent+import Control.Concurrent.STM+import Control.Monad++import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)++import Data.TTN+import qualified Network.MQTT as MQTT++import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.ByteString.Char8 as BS++import Data.Ini.Config+import System.Environment+import System.Directory+import System.FilePath.Posix++data Conf = Conf {+ appId :: T.Text+ , appKey :: T.Text+ , appRouter :: T.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"+ 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+ return $ parseIniFile rs iniParser++-- | Try loading config from location in @TTNCFG@ environment variable or @~/.ttn/config@+envConfCfg :: IO (Conf)+envConfCfg = do+ menv <- lookupEnv "TTNCFG"+ case menv of+ Nothing -> do+ udir <- getHomeDirectory+ let userConf = udir </> ".ttn" </> "config"+ hasCfg <- doesFileExist userConf+ case hasCfg of+ False -> putStrLn ("Unable to load config: no ~/.ttn/config or TTNCFG env variable set") >> exitFailure+ True -> do+ res <- parseConfCfg userConf+ case res of+ Left err -> putStrLn ("Unable to parse config: " ++ err) >> exitFailure+ Right cfg -> return cfg+ Just env -> do+ res <- parseConfCfg env+ case res of+ 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+ where+ typ = case drop 3 sp of+ ["up"] -> Up+ ["down"] -> Down+ ["events", "down", "acks"] -> DownAcked+ ["events", "down", "sent"] -> DownSent+ ["events", "down", "schedule"] -> DownScheduled+ ["events", "activations"] -> Activation+ ["events", "create"] -> Create+ ["events", "update"] -> Update+ ["events", "delete"] -> Delete+ _ -> Unknown++ sp = T.splitOn "/" t++-- | Try to load config from default locations and start actual client+ttnClient :: TChan Event -> IO ()+ttnClient chan = do+ conf <- envConfCfg+ ttnClientConf conf chan++-- | 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+ }++ _ <- 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++ -- this will throw IOExceptions, how do we reconnect?+ forever $ do+ terminated <- MQTT.run conf+ hPutStrLn stderr $ "Terminated, restarting. Reason: " ++ show terminated++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 $ "Received on topic " ++ (show t)+ case parse p of+ Left err -> do+ case parseError p of+ Left _ -> hPutStrLn stderr $ "Invalid JSON, error: " ++ err+ Right e -> atomically $ writeTChan chan $ Left $ T.unpack $ errorMsg e++ Right u@Uplink{..} -> do+ let typ = parseType $ MQTT.fromTopic t++ atomically $ writeTChan chan $ Right $ typ u
+ src/Data/TTN/Client/Util.hs view
@@ -0,0 +1,8 @@+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
@@ -0,0 +1,56 @@+name: ttn-client+version: 0.1.0.0+synopsis: TheThingsNetwork client+description: Connect to TTN MQTT API, receive and decode messages+homepage: https://github.com/sorki/ttn-client+license: BSD3+license-file: LICENSE+author: Richard Marko+maintainer: srk@48.io+copyright: 2018 Richard Marko+category: Web+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.TTN.Client+ , Data.TTN.Client.Util+ build-depends: base >= 4.7 && < 5+ , ttn+ , config-ini+ , pretty-simple+ , aeson+ , bytestring+ , text+ , stm+ , mqtt-hs+ , filepath+ , directory+ , monad-logger+ , binary+ , base64-bytestring+ default-language: Haskell2010++executable ttnc+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , ttn+ , ttn-client+ , stm+ , aeson+ , text+ , pretty-simple+ , bytestring+ , binary+ , mqtt-hs+ , cayene-lpp+ default-language: Haskell2010+++source-repository head+ type: git+ location: https://github.com/sorki/ttn-client