diff options
| -rw-r--r-- | lib/OwnTracks/Location.hs | 180 | ||||
| -rw-r--r-- | tracktrain.cabal | 2 |
2 files changed, 182 insertions, 0 deletions
diff --git a/lib/OwnTracks/Location.hs b/lib/OwnTracks/Location.hs new file mode 100644 index 0000000..de18596 --- /dev/null +++ b/lib/OwnTracks/Location.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE LambdaCase #-} + + +module OwnTracks.Location +-- | https://owntracks.org/booklet/tech/json/ + (BatteryStatus(..), Trigger(..), MonitoringMode(..), Location(..)) 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) + +data BatteryStatus = + Unknown + | Unplugged + | Charging + | Full + deriving (Generic, Show, Eq, Enum) + +data Trigger = + Ping + -- ^ ping issued randomly by background task (iOS,Android) + | CircularRegionEnterLeave + -- ^ circular region enter/leave event (iOS,Android) + | CircularRegionEnterLeavePlus + -- ^ circular region enter/leave event for +follow regions (iOS) + | BeaconRegionEnterLeave + -- ^ beacon region enter/leave event (iOS) + | ReportLocationResponse + -- ^ response to a reportLocation cmd message (iOS,Android) + | ManualTrigger + -- ^ manual publish requested by the user (iOS,Android) + | Timer + -- ^ timer based publish in move move (iOS) + | LocationsServices + -- ^ updated by Settings/Privacy/Locations Services/System Services/Frequent Locations monitoring (iOS) + deriving (Generic, Show, Eq) + +instance FromJSON Trigger where + parseJSON (String s) = case s of + "p" -> pure Ping + "c" -> pure CircularRegionEnterLeave + "C" -> pure CircularRegionEnterLeavePlus + "b" -> pure BeaconRegionEnterLeave + "r" -> pure ReportLocationResponse + "m" -> pure ManualTrigger + "t" -> pure Timer + "v" -> pure LocationsServices + _ -> fail "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 + deriving (Generic, Show, Eq) + +instance FromJSON MonitoringMode where + parseJSON (Number i) = case i of + -1 -> pure Quiet + 0 -> pure Manual + 1 -> pure Significant + 2 -> pure Move + _ -> fail "Unknown Monitoring Mode (not in -1,..,2)" + parseJSON _ = fail "Monitoring Mode must be a number" + +data Connection = + Wifi { connectionSSID :: Maybe Text + -- ^ if available, is the unique name of the WLAN. (iOS,string/optional) + , connectionBSSID :: Maybe Text + -- ^ if available, identifies the access point. (iOS,string/optional) + } + | Offline | Mobile + deriving (Generic, Show, Eq) + + +-- | https://owntracks.org/booklet/tech/json/ +data Location = Location + { locationAccuracy :: Maybe Int + -- ^ Accuracy of the reported location in meters without unit (iOS,Android/integer/meters/optional) + , locationAltitude :: Maybe Int + -- ^ Altitude measured above sea level (iOS,Android/integer/meters/optional) + , locationBattery :: Maybe Int + -- ^ Device battery level (iOS,Android/integer/percent/optional) + , locationBatteryStatus :: BatteryStatus + -- ^ Battery Status 0=unknown, 1=unplugged, 2=charging, 3=full (iOS, Android) + , locationCourse :: Maybe Int + -- ^ Course over ground (iOS/integer/degree/optional) + , locationLatitude :: Double + -- ^ latitude (iOS,Android/float/degree/required) + , locationLongitude :: Double + -- ^ longitude (iOS,Android/float/degree/required) + , locationRegionRadios :: Maybe Int + -- ^ radius around the region when entering/leaving (iOS/integer/meters/optional) + , locationTrigger :: Maybe Trigger + -- ^ trigger for the location report (iOS,Android/string/optional) + , locationTrackerId :: Maybe Text + -- ^ Tracker ID used to display the initials of a user (iOS,Android/string/optional) required for http mode + , locationTimestamp :: UTCTime + -- ^ UNIX epoch timestamp in seconds of the location fix (iOS,Android/integer/epoch/required) + , locationVerticalAccuracy :: Maybe Int + -- ^ vertical accuracy of the alt element (iOS/integer/meters/optional) + , locationVelocity :: Maybe Int + -- ^ velocity (iOS,Android/integer/kmh/optional) + , locationBarometricPressure :: Maybe Double + -- ^ barometric pressure (iOS/float/kPa/optional/extended data) + , locationPointOfInterestName :: Maybe Text + -- ^ point of interest name (iOS/string/optional) + , locationImage :: Maybe ByteString + -- ^ Base64 encoded image associated with the poi (iOS/string/optional) + , locationImageName :: Maybe Text + -- ^ Name of the image associated with the poi (iOS/string/optional) + , locationConnection :: Maybe Connection + -- ^ Internet connectivity status (route to host) when the message is created (iOS,Android/string/optional/extended data) + , locationTag :: Maybe Text + -- ^ name of the tag (iOS/string/optional) + , locationTopic :: Maybe Text + -- ^ (only in HTTP payloads) contains the original publish topic (e.g. owntracks/jane/phone). (iOS,Android >= 2.4,string) + , locationInRegions :: Maybe [Text] + -- ^ contains a list of regions the device is currently in (e.g. ["Home","Garage"]). Might be empty. (iOS,Android/list of strings/optional) + , locationInRegionIds :: Maybe [Text] + -- ^ contains a list of region IDs the device is currently in (e.g. ["6da9cf","3defa7"]). Might be empty. (iOS,Android/list of strings/optional) + , locationCreatedAt :: Maybe UTCTime + -- ^ identifies the time at which the message is constructed (if it differs from locationTimestamp, which is the timestamp of the GPS fix) (iOS,Android/integer/epoch/optional) + , locationMonitoringMode :: Maybe MonitoringMode + -- ^ identifies the monitoring mode at which the message is constructed (significant=1, move=2) (iOS/integer/optional) + , locationRandomId :: Maybe Text + -- ^ random identifier to be used by consumers to correlate & distinguish send/return messages (Android/string) + , locationMotionActivities :: Maybe Text + -- ^ contains a list of motion states detected by iOS' motion manager (a combination of stationary, walking, running, automotive, cycling, and/or unknown, e.g. ["cycling"]). (iOS/list of strings/optional) + } deriving (Generic, Show, Eq) + +instance FromJSON Location where + parseJSON (Object v) = Location + <$> v .: "acc" + <*> v .: "alt" + <*> v .: "batt" + <*> (v .: "bs" <&> toEnum) + <*> v .: "cog" + <*> v .: "lat" + <*> v .: "lon" + <*> 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" + parseConnection = withText "Connection" \case + "o" -> pure Offline + "m" -> pure Mobile + "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/tracktrain.cabal b/tracktrain.cabal index aaa7e01..d22a0a9 100644 --- a/tracktrain.cabal +++ b/tracktrain.cabal @@ -97,6 +97,7 @@ library , filepath >= 1.4.100 , monad-control , esqueleto + , base64 hs-source-dirs: lib exposed-modules: GTFS , Server @@ -120,6 +121,7 @@ library , Server.Frontend.Gtfs , Server.Frontend.SpaceTime , Server.Frontend.Ticker + , OwnTracks.Location default-language: GHC2021 default-extensions: OverloadedStrings , ScopedTypeVariables |