diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/OwnTracks.hs | 44 | ||||
| -rw-r--r-- | lib/OwnTracks/Location.hs | 58 | ||||
| -rw-r--r-- | lib/OwnTracks/Status.hs | 65 |
3 files changed, 138 insertions, 29 deletions
diff --git a/lib/OwnTracks.hs b/lib/OwnTracks.hs new file mode 100644 index 0000000..ae81d0b --- /dev/null +++ b/lib/OwnTracks.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ApplicativeDo #-} + + +module OwnTracks + (Message(..), + module OwnTracks.Location, + module OwnTracks.Status + ) where + +import Data.Aeson +import Data.Aeson.Types (Parser) +import Data.ByteString (ByteString) +import Data.ByteString.Base64 +import Data.Functor ((<&>)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Time ( + UTCTime, + defaultTimeLocale, + parseTimeM) +import Database.Persist +import GHC.Generics (Generic) + +import OwnTracks.Location +import OwnTracks.Status + +data Message = + MsgLocation Location + | MsgStatus Status -- TODO + deriving (Generic, Show, Eq) + +instance FromJSON Message where + parseJSON v@(Object o) = do + ty :: Text <- o .: "_type" + case ty of + "location" -> MsgLocation <$> parseJSON v + "status" -> MsgStatus <$> parseJSON v + _ -> fail "unknown _type of owntracks message." diff --git a/lib/OwnTracks/Location.hs b/lib/OwnTracks/Location.hs index de18596..b4bf807 100644 --- a/lib/OwnTracks/Location.hs +++ b/lib/OwnTracks/Location.hs @@ -57,10 +57,10 @@ instance FromJSON Trigger where "C" -> pure CircularRegionEnterLeavePlus "b" -> pure BeaconRegionEnterLeave "r" -> pure ReportLocationResponse - "m" -> pure ManualTrigger + "u" -> pure ManualTrigger "t" -> pure Timer "v" -> pure LocationsServices - _ -> fail "Unknown Trigger Type (not one of p, c, C, b, r, m, t, v)" + other -> fail $ show other <> "Unknown Trigger Type (not one of p, c, C, b, r, m, t, v)" parseJSON _ = fail "Trigger Type must be a string" data MonitoringMode = Quiet | Manual | Significant | Move @@ -93,7 +93,7 @@ data Location = Location -- ^ Altitude measured above sea level (iOS,Android/integer/meters/optional) , locationBattery :: Maybe Int -- ^ Device battery level (iOS,Android/integer/percent/optional) - , locationBatteryStatus :: BatteryStatus + , locationBatteryStatus :: Maybe BatteryStatus -- ^ Battery Status 0=unknown, 1=unplugged, 2=charging, 3=full (iOS, Android) , locationCourse :: Maybe Int -- ^ Course over ground (iOS/integer/degree/optional) @@ -143,38 +143,38 @@ data Location = Location instance FromJSON Location where parseJSON (Object v) = Location - <$> v .: "acc" - <*> v .: "alt" - <*> v .: "batt" - <*> (v .: "bs" <&> toEnum) - <*> v .: "cog" + <$> v .:? "acc" + <*> v .:? "alt" + <*> v .:? "batt" + <*> (v .:? "bs" <&> fmap toEnum) + <*> v .:? "cog" <*> v .: "lat" <*> v .: "lon" - <*> v .: "rad" - <*> v .: "t" - <*> v .: "tid" + <*> v .:? "rad" + <*> v .:? "t" + <*> v .:? "tid" <*> (v .: "tst" >>= parseUnixTime) - <*> v .: "vac" - <*> v .: "vel" - <*> v .: "p" - <*> v .: "poi" - <*> (v .: "image" >>= mapM fromBase64) - <*> v .: "imagename" - <*> (v .: "conn" >>= mapM parseConnection) - <*> v .: "tag" - <*> v .: "topic" - <*> v .: "inregions" - <*> v .: "inrids" - <*> (v .: "created_at" >>= mapM parseUnixTime) - <*> v .: "m" - <*> v .: "_id" - <*> v .: "motionactivities" - where parseUnixTime :: String -> Parser UTCTime - parseUnixTime = parseTimeM False defaultTimeLocale "%s" + <*> v .:? "vac" + <*> v .:? "vel" + <*> v .:? "p" + <*> v .:? "poi" + <*> (v .:? "image" >>= mapM fromBase64) + <*> v .:? "imagename" + <*> (v .:? "conn" >>= mapM parseConnection) + <*> v .:? "tag" + <*> v .:? "topic" + <*> v .:? "inregions" + <*> v .:? "inrids" + <*> (v .:? "created_at" >>= mapM parseUnixTime) + <*> v .:? "m" + <*> v .:? "_id" + <*> v .:? "motionactivities" + where parseUnixTime :: Int -> Parser UTCTime + parseUnixTime = parseTimeM False defaultTimeLocale "%s" . show parseConnection = withText "Connection" \case "o" -> pure Offline "m" -> pure Mobile - "w" -> Wifi <$> v .: "SSID" <*> v .: "BSSID" + "w" -> Wifi <$> v .:? "SSID" <*> v .:? "BSSID" fromBase64 v = case decodeBase64Untyped (encodeUtf8 v) of Right bytes -> pure bytes Left err -> fail $ "image field could not be read: " <> T.unpack err diff --git a/lib/OwnTracks/Status.hs b/lib/OwnTracks/Status.hs new file mode 100644 index 0000000..83b5956 --- /dev/null +++ b/lib/OwnTracks/Status.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE RecordWildCards #-} + + +module OwnTracks.Status +-- | https://owntracks.org/booklet/tech/json/ + (Status(..)) where + +import Data.Aeson +import Data.Aeson.Types (Parser) +import Data.ByteString (ByteString) +import Data.ByteString.Base64 +import Data.Data (Proxy (..)) +import Data.Functor ((<&>)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Time (UTCTime, defaultTimeLocale, parseTimeM) +import GHC.Generics (Generic) + + +-- | An owntracks message with _type=status. +-- +-- Currently only implements android-specific fields. +data Status = Status + { statusId :: Maybe Text + -- ^ random identifier to be used by consumers to correlate & distinguish send/return messages (Android/string) + , statusCanHibernate :: Maybe Int + -- ^ app can hibernate if not used (Android/integer) + , statusBatteryOptimizations :: Maybe Int + -- ^ app is configured with battery optimizations (Android/integer) + , statusLocationPermission :: Maybe Int + -- ^ app location permissions (Android/integer) + , statusPhonePowerSaveMode :: Maybe Int + -- ^ phone power save mode (Android/integer) + , statusWifiOnOff :: Maybe Int + -- ^ wifi is on/off (Android/integer) + } deriving (Generic, Eq, Show) + +instance FromJSON Status where + parseJSON (Object v) = do + a <- v .:? "android" + Status + <$> v .:? "_id" + <*> a .:?? "hib" + <*> a .:?? "bo" + <*> a .:?? "loc" + <*> a .:?? "ps" + <*> a .:?? "wifi" + where + (.:??) :: FromJSON a => Maybe Object -> Data.Aeson.Key -> Parser (Maybe a) + (.:??) Nothing = const $ pure Nothing + (.:??) (Just a) = (.:?) a + +instance ToJSON Status where + toEncoding Status{..} = + pairs ("_id" .= statusId + <> "hib" .= statusCanHibernate + <> "bo" .= statusBatteryOptimizations + <> "loc" .= statusLocationPermission + <> "ps" .= statusPhonePowerSaveMode + <> "wifi" .= statusWifiOnOff + ) |