diff options
Diffstat (limited to 'lib/OwnTracks')
| -rw-r--r-- | lib/OwnTracks/Command.hs | 79 | ||||
| -rw-r--r-- | lib/OwnTracks/Configuration.hs | 176 | ||||
| -rw-r--r-- | lib/OwnTracks/Location.hs | 180 | ||||
| -rw-r--r-- | lib/OwnTracks/Status.hs | 74 | ||||
| -rw-r--r-- | lib/OwnTracks/Waypoint.hs | 69 |
5 files changed, 578 insertions, 0 deletions
diff --git a/lib/OwnTracks/Command.hs b/lib/OwnTracks/Command.hs new file mode 100644 index 0000000..532a593 --- /dev/null +++ b/lib/OwnTracks/Command.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE LambdaCase #-} + + +module OwnTracks.Command +-- | https://owntracks.org/booklet/tech/json/ + (Command(..)) 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.Configuration +import OwnTracks.Waypoint + +data Command = + Dump + -- ^ Triggers the publish of a configuration message (iOS) + | GetStatus + -- ^ Triggers the publish of a status message to ../status (iOS) + | ReportSteps { reportStepsFrom :: Maybe Int, reportStepsTo :: Maybe Int } + -- ^ Triggers the report of a steps messages_(iOS)_ + | ReportLocation + -- ^ Triggers the publish of a location messages (iOS,Android) Don‘t expect device to be online. Send with QoS>0. Device will receive and repond when activated next time + | ClearWaypoints + -- ^ deletes all waypoints/regions (iOS) + | SetWaypoints [Waypoint] + -- ^ Imports (merge) and activates new waypoints (iOS,Android) + | SetConfiguration Configuration + -- ^ Imports and activates new configuration values (iOS,Android) + | GetWaypoints + -- ^ Triggers publish of a waypoints message (iOS,Android) + deriving (Eq, Show, Generic) + +instance ToJSON Command where + toJSON c = object ( "_type" .= String "cmd" + : "action" .= String action + : others ) + where action = case c of + Dump -> "dump" + GetStatus -> "status" + ReportSteps _ _ -> "reportSteps" + ReportLocation -> "reportLocation" + ClearWaypoints -> "clearWaypoints" + SetWaypoints _ -> "setWaypoints" + SetConfiguration _ -> "setConfiguration" + GetWaypoints -> "waypoints" + others = case c of + ReportSteps f t -> [ "from" .= f, "to" .= t ] + SetWaypoints ws -> [ "waypoints" .= ws ] + SetConfiguration c -> [ "configuration" .= c ] + _ -> [] + +instance FromJSON Command where + parseJSON (Object v) = do + action :: Text <- v .: "action" + case action of + "dump" -> pure Dump + "status" -> pure GetStatus + "reportSteps" -> ReportSteps <$> v .: "from" <*> v .: "to" + "reportLocation" -> pure ReportLocation + "clearWaypoints" -> pure ClearWaypoints + "setWaypoints" -> SetWaypoints <$> v .: "waypoints" + "setConfiguration" -> SetConfiguration <$> v .: "configuration" + "waypoints" -> pure GetWaypoints + _ -> fail "unknown action in _type=command" + parseJSON _ = fail "Command should be an object" diff --git a/lib/OwnTracks/Configuration.hs b/lib/OwnTracks/Configuration.hs new file mode 100644 index 0000000..a10a46e --- /dev/null +++ b/lib/OwnTracks/Configuration.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + + +module OwnTracks.Configuration +-- | https://owntracks.org/booklet/tech/json/ + (Configuration(..), LocatorPriority(..), MonitoringMode(..)) where + +import Data.Aeson +import qualified Data.Aeson.TH as TH +import Data.Aeson.Types (Parser) +import Data.ByteString (ByteString) +import Data.ByteString.Base64 +import Data.Char (toLower) +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) + +import OwnTracks.Location (MonitoringMode) +import OwnTracks.Waypoint (Waypoint) + + +data LocatorPriority = + NoPower + -- ^ best accuracy possible with zero additional power consumption (Android) + | LowPower + -- ^ city level accuracy (Android) + | BalancedPower + -- ^ block level accuracy based on Wifi/Cell (Android) + | HighPower + -- ^ most accurate accuracy based on GPS (Android) + deriving (Show, Eq, Enum) + +instance FromJSON LocatorPriority where + parseJSON = fmap toEnum . parseJSON + +instance ToJSON LocatorPriority where + toJSON = toJSON . fromEnum + +data ProtocolMode = Mqtt | Http + deriving (Show, Eq) + +instance FromJSON ProtocolMode where + parseJSON (Number 0) = pure Mqtt + parseJSON (Number 3) = pure Http + parseJSON _ = fail "mode must be 0 (mqtt) or 3 (http)" + +instance ToJSON ProtocolMode where + toJSON Mqtt = Number 0 + toJSON Http = Number 3 + +data Configuration = Configuration + { configAdapt :: Maybe Int + -- ^ time in minutes of non-movement before switching from move to significant mode. 0 (zero) means disabled. Defaults to 0 (zero) (iOS/integer/minutes/optional) + , configAllowRemoteLocation :: Maybe Bool + -- ^ Respond to reportLocation cmd message (iOS/boolean) + , configAllowInvalidCerts :: Maybe Bool + -- ^ disable TLS certificate checks insecure (iOS/boolean) + , configAuth :: Maybe Bool + -- ^ Use username and password for endpoint authentication (iOS,Android/boolean) + , configAutostartOnBoot :: Maybe Bool + -- ^ Autostart the app on device boot (Android/boolean) + , configCleanSession :: Maybe Bool + -- ^ MQTT endpoint clean session (iOS,Android/boolean) + , configClientId :: Maybe Text + -- ^ client id to use for MQTT connect. Defaults to "user deviceId" (iOS,Android/string) + , configClientpkcs :: Maybe Text + -- ^ Name of the client pkcs12 file (iOS/string) + , configCmd :: Maybe Bool + -- ^ Respond to cmd messages (iOS,Android/boolean) + , configConnectionTimeoutSeconds :: Maybe Int + -- ^ (default 30) TCP timeout for establishing a connection to the MQTT / HTTP broker, (Android/int) + , configDay :: Maybe Int + -- ^ Number of days to keep locations stored locally. 0 means no local keeping of locations. A negative number indicates to use the positions value. Defaults to -1 for backward compatibility. (iOS/integer/days) + , configDebugLog :: Maybe Bool + -- ^ (default false) whether or not debug logs should be shown in the log viewer / exporter activity (Android/bool) + , configDeviceId :: Maybe Text + -- ^ id of the device used for pubTopicBase and clientId construction. Defaults to the os name of the device (iOS,Android/string) + , configDowngrade :: Maybe Int + -- ^ battery level below which to downgrade monitoring from move mode (iOS/integer/percent/optional) + , configEcryptionKey :: Maybe Text + -- ^ the secret key used for payload encryption (iOS,Android/string) + , configExtendedData :: Maybe Bool + -- ^ Add extended data attributes to location messages (iOS,Android/boolean) + , configHost :: Maybe Text + -- ^ MQTT endpoint host (iOS,Android/string) + -- FIXME: structured type here? + , configHttpHeaders :: Maybe Text + -- ^ extra HTTP headers:field names and field content are separated by a colon (:), multiple fields by a backslash-n (\n) \<field-name>:\<field-content>\n\<field-name>:\<field-content>... (iOS only/string) + , configIgnoreInaccurateLocations :: Maybe Int + -- ^ Location accuracy below which reports are supressed. 0 means no locations are suppressed. (iOS,Android/integer/meters) + , configIgnoreStaleLocations :: Maybe Bool + -- ^ Number of days after which location updates are assumed stale. Locations sent by friends older than the number of days specified here will not be shown on map or in friends list. Defaults to 0, which means stale locations are not filtered. (iOS,Android/integer/days) + , configKeepalive :: Maybe Int + -- ^ MQTT endpoint keepalive (iOS,Android/integer/seconds) + , configLocatorDisplacement :: Maybe Int + -- ^ maximum distance between location source updates (iOS,Android/integer/meters) + , configLocatorInterval :: Maybe Int + -- ^ maximum interval between location source updates (iOS,Android/integer/seconds) + , configLocatorPriority :: Maybe LocatorPriority + -- ^ source/power setting for location updates (Android/integer) + , configLocked :: Maybe Bool + -- ^ Locks settings screen on device for editing (iOS/boolean) + , configMaxHistory :: Maybe Int + -- ^ Number of notifications to store historically. Zero (0) means no notifications are stored and history tab is hidden. Defaults to zero. (iOS/integer) + , configMode :: Maybe ProtocolMode + -- ^ Endpoint protocol mode (iOS,Android/integer) + , configMonitoring :: Maybe MonitoringMode + -- ^ Location reporting mode (iOS,Android/integer) + , configProtocolLevel :: Maybe Int + -- ^ MQTT broker protocol level (iOS,Android/integer) + , configNotificationLocation :: Maybe Bool + -- ^ Show last reported location in ongoing notification (Android/boolean) + , configOpencageApiKey :: Maybe Text + -- ^ API key for alternate Geocoding provider. See OpenCage for details. (Android/string) + , configOsmTemplate :: Maybe Text + -- ^ URL template for alternate tile provider. Defaults to https://tile.openstreetmap.org/{z}/{x}/{y}.png. (iOS/string) + , configOsmCopyright :: Maybe Text + -- ^ Attribution text shown with OSM map. Defaults to (c) OpenStreetMap contributors. (iOS/string) + , configPassphrase :: Maybe Text + -- ^ Passphrase of the client pkcs12 file (iOS/string) + , configPassword :: Maybe Text + -- ^ Endpoint password (iOS,Android/string) + , configPegLocatorFastestIntervalToInterval :: Maybe Bool + -- ^ (default false) - if true, requests that that the device provide locations no faster than the specified interval. Location providers often use the requested interval as a "at least every" setting, and may return locations more frequencly. Some people wanted the behaviour where it also meant "no more frequently than", so this setting lets them specify this (Android/bool) + , configPing :: Maybe Int + -- ^ Interval in which location messages of with t:p are reported (Android/integer) + , configPort :: Maybe Int + -- ^ MQTT endpoint port (iOS,Android/integer) + , configPositions :: Maybe Int + -- ^ Number of locations to keep for friends and own device and display (iOS/integer) + , configPubTopicBase :: Maybe Text + -- ^ MQTT topic base to which the app publishes; %u is replaced by the user name, %d by device (iOS,Android/string) + , configPubRetain :: Maybe Bool + -- ^ MQTT retain flag for reported messages (iOS,Android/boolean) + , configPubQos :: Maybe Int + -- ^ MQTT QoS level for reported messages (iOS,Android/integer) + , configRanging :: Maybe Bool + -- ^ Beacon ranging (iOS/boolean) + , configRemoteConfiguration :: Maybe Bool + -- ^ Allow remote configuration by sending a setConfiguration cmd message (Android/boolean) + , configSub :: Maybe Bool + -- ^ subscribe to subTopic via MQTT (iOS,Android/boolean) + , configSubTopic :: Maybe Text + -- ^ A whitespace separated list of MQTT topics to which the app subscribes if sub is true (defaults see topics) (iOS,Android/string) + , configSubQos :: Maybe Bool + -- ^ (iOS,Android/boolean) + , configTid :: Maybe Text + -- ^ Two digit Tracker ID used to display short name and default face of a user (iOS,Android/string) + , configTls :: Maybe Bool + -- ^ MQTT endpoint TLS connection (iOS,Android/boolean) + , configTlsClientCrtPassword :: Maybe Text + -- ^ Passphrase of the client pkcs12 file (Android/string) + , configUrl :: Maybe Text + -- ^ HTTP endpoint URL to which messages are POSTed (iOS,Android/string) + , configUsername :: Maybe Text + -- ^ Endpoint username (iOS,Android/string) + , configWs :: Maybe Bool + -- ^ use MQTT over Websocket, default false (iOS,Android/boolean) + , configWaypoints :: Maybe [Waypoint] + -- ^ Array of waypoint messages (iOS,Android/array) + } deriving (Show, Eq, Generic) + + +TH.deriveJSON (TH.defaultOptions -- TODO: _type=configuration missing! + { TH.omitNothingFields = True + , TH.rejectUnknownFields = True + , TH.fieldLabelModifier = (\(x:xs) -> toLower x : xs) . drop 6 + }) 'Configuration diff --git a/lib/OwnTracks/Location.hs b/lib/OwnTracks/Location.hs new file mode 100644 index 0000000..6a0fbde --- /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 + "u" -> pure ManualTrigger + "t" -> pure Timer + "v" -> pure LocationsServices + 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 + deriving (Generic, Show, Eq, Enum) + +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" + +instance ToJSON MonitoringMode where + toJSON m = toJSON (fromEnum m - 1) + +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 :: Maybe 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" <&> fmap 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 :: 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" + 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..c87e28b --- /dev/null +++ b/lib/OwnTracks/Status.hs @@ -0,0 +1,74 @@ +{-# 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 + toJSON Status{..} = object + [ "_id" .= statusId + , "hib" .= statusCanHibernate + , "bo" .= statusBatteryOptimizations + , "loc" .= statusLocationPermission + , "ps" .= statusPhonePowerSaveMode + , "wifi" .= statusWifiOnOff + ] + + toEncoding Status{..} = + pairs ("_id" .= statusId + <> "hib" .= statusCanHibernate + <> "bo" .= statusBatteryOptimizations + <> "loc" .= statusLocationPermission + <> "ps" .= statusPhonePowerSaveMode + <> "wifi" .= statusWifiOnOff + ) diff --git a/lib/OwnTracks/Waypoint.hs b/lib/OwnTracks/Waypoint.hs new file mode 100644 index 0000000..002baa0 --- /dev/null +++ b/lib/OwnTracks/Waypoint.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} + +module OwnTracks.Waypoint +-- | https://owntracks.org/booklet/tech/json/ + (Waypoint(..)) 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, formatTime, + parseTimeM) +import Database.Persist +import GHC.Generics (Generic) + + +data Waypoint = Waypoint + { waypointDescription :: Text + -- ^ Name of the waypoint that is included in the sent transition message, copied into the location message inregions array when a current position is within a region. (iOS,Android,string/required) + , waypointLatitude :: Maybe Double + -- ^ Latitude (iOS,Android/float/degree/optional) + , waypointLongitude :: Maybe Double + -- ^ Longitude (iOS,Android/float/degree/optional) + , waypointRadius :: Maybe Int + -- ^ Radius around the latitude and longitude coordinates (iOS,Android/integer/meters/optional) + , waypointTimestamp :: UTCTime + -- ^ Timestamp of creation of region, copied into the wtst element of the transition message (iOS,Android/integer/epoch/required) + , waypointUUID :: Maybe Text + -- ^ UUID of the BLE Beacon (iOS/string/optional) + , waypointBLEMajor :: Maybe Int + -- ^ Major number of the BLE Beacon (iOS/integer/optional) + , waypointBLEMinor :: Maybe Int + -- ^ Minor number of the BLE Beacon_(iOS/integer/optional)_ + , waypointRegionId :: Maybe Text + -- ^ region ID, created automatically, copied into the location payload inrids array (iOS/string) + } deriving (Show, Eq, Generic) + +instance FromJSON Waypoint where + parseJSON (Object o) = Waypoint + <$> o .: "desc" + <*> o .:? "lat" + <*> o .:? "lon" + <*> o .:? "rad" + <*> (o .: "tst" >>= parseUnixTime) + <*> o .:? "uuid" + <*> o .:? "major" + <*> o .:? "minor" + <*> o .:? "rid" + where parseUnixTime :: Int -> Parser UTCTime + parseUnixTime = parseTimeM False defaultTimeLocale "%s" . show + +instance ToJSON Waypoint where + toJSON Waypoint{..} = object + [ "desc" .= waypointDescription + , "lat" .= waypointLatitude + , "lon" .= waypointLongitude + , "rad" .= waypointRadius + , "tst" .= formatTime defaultTimeLocale "%s" waypointTimestamp + , "uuid" .= waypointUUID + , "major" .= waypointBLEMajor + , "minor" .= waypointBLEMinor + , "rid" .= waypointRegionId + ] |