diff --git a/src/Data/TTN/Types.hs b/src/Data/TTN/Types.hs --- a/src/Data/TTN/Types.hs +++ b/src/Data/TTN/Types.hs @@ -1,29 +1,40 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Data.TTN.Types where -import System.Exit (exitFailure, exitSuccess) -import System.IO (stderr, hPutStrLn) -import qualified Data.ByteString.Char8 as B -import System.Environment (getArgs) -import Control.Monad (forM_, mzero, join) -import Control.Applicative -import Data.Aeson(decodeStrict, eitherDecodeStrict, - Value(..), FromJSON(..), ToJSON(..), - pairs, withText, (.:), (.:?), (.=), object) -import Data.Monoid -import Data.Text (Text, unpack) +import Control.Monad (forM_, mzero) + +import Data.Aeson ( decodeStrict + , eitherDecodeStrict + , Value(..) + , FromJSON(..) + , ToJSON(..) + , pairs + , withText + , (.:) + , (.:?) + , (.=) + , object) + +import Data.ByteString.Char8 (ByteString) +import Data.Text (Text) + import GHC.Generics import Data.Time.RFC3339 import Data.Time.LocalTime --- | Workaround for https://github.com/bos/aeson/issues/287. -o .:?? val = fmap join (o .:? val) +import qualified Data.ByteString.Char8 +import qualified Data.Text +import qualified System.Exit +import qualified System.IO -data TTNZonedTime = TTNZonedTime { unwrap :: ZonedTime } deriving (Show, Generic) +data TTNZonedTime = TTNZonedTime { unwrap :: ZonedTime } + deriving (Eq, Show, Generic) instance ToJSON TTNZonedTime where toJSON = toJSON . (formatTimeRFC3339 :: ZonedTime -> Text) . unwrap @@ -35,25 +46,27 @@ Nothing -> fail $ "Parsing RFC3339 value failed, got:" ++ show x Just t -> return $ TTNZonedTime t +instance Eq ZonedTime where + ZonedTime t1 tz1 == ZonedTime t2 tz2 = t1 == t2 && tz1 == tz2 -- https://github.com/TheThingsNetwork/ttn/blob/develop/core/types/event.go#L65 data Config = Config { configFrequency :: Maybe Double , configDataRate :: Maybe Text - , configCounter :: Maybe Double + , configCounter :: Maybe Integer , configAirtime :: Maybe Double , configPower :: Maybe Double , configModulation :: Maybe Text - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Config where parseJSON (Object v) = Config - <$> v .:?? "frequency" - <*> v .:?? "data_rate" - <*> v .:?? "counter" - <*> v .:?? "airtime" - <*> v .:?? "power" - <*> v .:?? "modulation" + <$> v .:? "frequency" + <*> v .:? "data_rate" + <*> v .:? "counter" + <*> v .:? "airtime" + <*> v .:? "power" + <*> v .:? "modulation" parseJSON _ = mzero instance ToJSON Config where @@ -80,7 +93,7 @@ data GatewaysElt = GatewaysElt { gatewaysEltGtwId :: Maybe Text , gatewaysEltGtwTrusted :: Maybe Bool - , gatewaysEltTimestamp :: Maybe Int + , gatewaysEltTimestamp :: Maybe Integer , gatewaysEltFineTimestamp :: Maybe Int , gatewaysEltFineTimestampEncrypted :: Maybe Text , gatewaysEltTime :: Maybe TTNZonedTime @@ -94,26 +107,26 @@ , gatewaysEltAltitude :: Maybe Int , gatewaysEltAccuracy :: Maybe Int , gatewaysEltSource :: Maybe Text - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON GatewaysElt where parseJSON (Object v) = GatewaysElt - <$> v .:?? "gtw_id" - <*> v .:?? "gtw_trusted" - <*> v .:?? "timestamp" - <*> v .:?? "fine_timestamp" - <*> v .:?? "fine_timestamp_encrypted" - <*> v .:?? "time" - <*> v .:?? "antenna" + <$> v .:? "gtw_id" + <*> v .:? "gtw_trusted" + <*> v .:? "timestamp" + <*> v .:? "fine_timestamp" + <*> v .:? "fine_timestamp_encrypted" + <*> v .:? "time" + <*> v .:? "antenna" <*> v .: "channel" <*> v .: "rssi" <*> v .: "snr" <*> v .: "rf_chain" - <*> v .:?? "latitude" - <*> v .:?? "longitude" - <*> v .:?? "altitude" - <*> v .:?? "accuracy" - <*> v .:?? "source" + <*> v .:? "latitude" + <*> v .:? "longitude" + <*> v .:? "altitude" + <*> v .:? "accuracy" + <*> v .:? "source" parseJSON _ = mzero instance ToJSON GatewaysElt where @@ -165,17 +178,17 @@ , metadataAirtime :: Maybe Double , metadataCodingRate :: Maybe Text , metadataGateways :: [GatewaysElt] - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Metadata where parseJSON (Object v) = Metadata <$> - v .:?? "time" - <*> v .:?? "frequency" - <*> v .:?? "modulation" - <*> v .:?? "data_rate" - <*> v .:?? "bit_rate" - <*> v .:?? "airtime" - <*> v .:?? "coding_rate" + v .:? "time" + <*> v .:? "frequency" + <*> v .:? "modulation" + <*> v .:? "data_rate" + <*> v .:? "bit_rate" + <*> v .:? "airtime" + <*> v .:? "coding_rate" <*> v .: "gateways" parseJSON _ = mzero @@ -206,7 +219,7 @@ messageDevId :: Text, messageAppId :: Text, messagePort :: Double - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Message where parseJSON (Object v) = Message @@ -234,7 +247,7 @@ , uplinkGatewayId :: Maybe Text , uplinkDevId :: Maybe Text , uplinkPayload :: Maybe Text - , uplinkCounter :: Maybe Double + , uplinkCounter :: Maybe Integer , uplinkIsRetry :: Maybe Bool , uplinkMetadata :: Maybe Metadata , uplinkPayloadRaw :: Maybe Text @@ -243,23 +256,23 @@ , uplinkConfirmed :: Maybe Bool , uplinkHardwareSerial :: Maybe Text , uplinkPort :: Maybe Double - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Uplink where parseJSON (Object v) = Uplink - <$> v .:?? "config" - <*> v .:?? "gateway_id" - <*> v .:?? "dev_id" - <*> v .:?? "payload" - <*> v .:?? "counter" - <*> v .:?? "is_retry" - <*> v .:?? "metadata" - <*> v .:?? "payload_raw" - <*> v .:?? "message" - <*> v .:?? "app_id" - <*> v .:?? "confirmed" - <*> v .:?? "hardware_serial" - <*> v .:?? "port" + <$> v .:? "config" + <*> v .:? "gateway_id" + <*> v .:? "dev_id" + <*> v .:? "payload" + <*> v .:? "counter" + <*> v .:? "is_retry" + <*> v .:? "metadata" + <*> v .:? "payload_raw" + <*> v .:? "message" + <*> v .:? "app_id" + <*> v .:? "confirmed" + <*> v .:? "hardware_serial" + <*> v .:? "port" parseJSON _ = mzero instance ToJSON Uplink where @@ -303,7 +316,7 @@ "replace" -> return ScheduleReplace "first" -> return ScheduleFirst "last" -> return ScheduleLast - w -> fail $ "Unknown schedule" ++ (unpack w) + w -> fail $ "Unknown schedule" ++ (Data.Text.unpack w) instance ToJSON Schedule where toJSON ScheduleReplace = "replace" @@ -327,7 +340,7 @@ <*> v .: "port" <*> v .: "payload_raw" <*> v .: "confirmed" - <*> v .:?? "schedule" + <*> v .:? "schedule" parseJSON _ = mzero instance ToJSON Downlink where @@ -359,26 +372,49 @@ toJSON (Error {..}) = object [ "error" .= errorMsg ] toEncoding (Error {..}) = pairs ( "error" .= errorMsg ) -parse :: B.ByteString -> Either String Uplink +-- used by ttn-client +data EventType = + Up + | Down + | DownAcked + | DownSent + | DownScheduled + | Activation + | Create + | Update + | Delete + | Unknown + deriving (Eq, Ord, Show, Generic) + +data Event = + Event EventType Uplink + | ClientError String + deriving (Eq, Show, Generic) + +instance FromJSON EventType where +instance ToJSON EventType where +instance FromJSON Event where +instance ToJSON Event where + +parse :: ByteString -> Either String Uplink parse = eitherDecodeStrict -parseError :: B.ByteString -> Either String Error +parseError :: ByteString -> Either String Error parseError = eitherDecodeStrict parseFile :: FilePath -> IO Uplink parseFile filename = do - input <- B.readFile filename + input <- Data.ByteString.Char8.readFile filename case decodeStrict input of Nothing -> fatal $ case (decodeStrict input :: Maybe Value) of Nothing -> "Invalid JSON file: " ++ filename - Just v -> "Mismatched JSON value from file: " ++ filename + Just _v -> "Mismatched JSON value from file: " ++ filename Just r -> return (r :: Uplink) where fatal :: String -> IO a - fatal msg = do hPutStrLn stderr msg - exitFailure + fatal msg = do System.IO.hPutStrLn System.IO.stderr msg + System.Exit.exitFailure parseMany :: [String] -> IO () parseMany filenames = do forM_ filenames (\f -> parseFile f >>= (\p -> p `seq` putStrLn $ "Successfully parsed " ++ f)) - exitSuccess diff --git a/ttn.cabal b/ttn.cabal --- a/ttn.cabal +++ b/ttn.cabal @@ -1,5 +1,5 @@ name: ttn -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Things Tracker Network JSON Types description: Parse JSONs from TTN MQTT API homepage: https://github.com/sorki/data-ttn @@ -14,6 +14,7 @@ cabal-version: >=1.10 library + ghc-options: -Wall hs-source-dirs: src exposed-modules: Data.TTN , Data.TTN.Types