aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/OwnTracks.hs14
-rw-r--r--lib/OwnTracks/Command.hs65
-rw-r--r--lib/OwnTracks/Configuration.hs175
-rw-r--r--lib/OwnTracks/Location.hs5
-rw-r--r--lib/OwnTracks/Status.hs9
-rw-r--r--lib/OwnTracks/Waypoint.hs69
-rw-r--r--tracktrain.cabal4
7 files changed, 338 insertions, 3 deletions
diff --git a/lib/OwnTracks.hs b/lib/OwnTracks.hs
index ae81d0b..25b0ae9 100644
--- a/lib/OwnTracks.hs
+++ b/lib/OwnTracks.hs
@@ -9,7 +9,10 @@
module OwnTracks
(Message(..),
module OwnTracks.Location,
- module OwnTracks.Status
+ module OwnTracks.Status,
+ module OwnTracks.Configuration,
+ module OwnTracks.Command,
+ module OwnTracks.Waypoint
) where
import Data.Aeson
@@ -29,10 +32,15 @@ import GHC.Generics (Generic)
import OwnTracks.Location
import OwnTracks.Status
+import OwnTracks.Configuration
+import OwnTracks.Command
+import OwnTracks.Waypoint
data Message =
MsgLocation Location
- | MsgStatus Status -- TODO
+ | MsgStatus Status
+ | MsgConfig Configuration
+ | MsgWaypoints [Waypoint]
deriving (Generic, Show, Eq)
instance FromJSON Message where
@@ -41,4 +49,6 @@ instance FromJSON Message where
case ty of
"location" -> MsgLocation <$> parseJSON v
"status" -> MsgStatus <$> parseJSON v
+ "configuration" -> MsgConfig <$> parseJSON v
+ "waypoints" -> MsgWaypoints <$> o .: "waypoints"
_ -> fail "unknown _type of owntracks message."
diff --git a/lib/OwnTracks/Command.hs b/lib/OwnTracks/Command.hs
new file mode 100644
index 0000000..5468379
--- /dev/null
+++ b/lib/OwnTracks/Command.hs
@@ -0,0 +1,65 @@
+{-# 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)
+
+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 ]
+ _ -> []
diff --git a/lib/OwnTracks/Configuration.hs b/lib/OwnTracks/Configuration.hs
new file mode 100644
index 0000000..5880c69
--- /dev/null
+++ b/lib/OwnTracks/Configuration.hs
@@ -0,0 +1,175 @@
+{-# 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 :: Bool
+ -- ^ Respond to reportLocation cmd message (iOS/boolean)
+ , configAllowInvalidCerts :: Bool
+ -- ^ disable TLS certificate checks insecure (iOS/boolean)
+ , configAuth :: Bool
+ -- ^ Use username and password for endpoint authentication (iOS,Android/boolean)
+ , configAutostartOnBoot :: Bool
+ -- ^ Autostart the app on device boot (Android/boolean)
+ , configCleanSession :: 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 :: 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 :: 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 :: Bool
+ -- ^ Add extended data attributes to location messages (iOS,Android/boolean)
+ , configHost :: Text
+ -- ^ MQTT endpoint host (iOS,Android/string)
+ , 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 :: Int
+ -- ^ Location accuracy below which reports are supressed. 0 means no locations are suppressed. (iOS,Android/integer/meters)
+ , configIgnoreStaleLocations :: 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 :: Int
+ -- ^ MQTT endpoint keepalive (iOS,Android/integer/seconds)
+ , configLocatorDisplacement :: Int
+ -- ^ maximum distance between location source updates (iOS,Android/integer/meters)
+ , configLocatorInterval :: Int
+ -- ^ maximum interval between location source updates (iOS,Android/integer/seconds)
+ , configLocatorPriority :: 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 :: ProtocolMode
+ -- ^ Endpoint protocol mode (iOS,Android/integer)
+ , configMonitoring :: MonitoringMode
+ -- ^ Location reporting mode (iOS,Android/integer)
+ , configProtocolLevel :: Int
+ -- ^ MQTT broker protocol level (iOS,Android/integer)
+ , configNotificationLocation :: 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 :: 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 :: 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 :: Bool
+ -- ^ MQTT retain flag for reported messages (iOS,Android/boolean)
+ , configPubQos :: 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 :: Bool
+ -- ^ subscribe to subTopic via MQTT (iOS,Android/boolean)
+ , configSubTopic :: Text
+ -- ^ A whitespace separated list of MQTT topics to which the app subscribes if sub is true (defaults see topics) (iOS,Android/string)
+ , configSubQos :: Bool
+ -- ^ (iOS,Android/boolean)
+ , configTid :: Text
+ -- ^ Two digit Tracker ID used to display short name and default face of a user (iOS,Android/string)
+ , configTls :: Bool
+ -- ^ MQTT endpoint TLS connection (iOS,Android/boolean)
+ , configTlsClientCrtPassword :: Maybe Text
+ -- ^ Passphrase of the client pkcs12 file (Android/string)
+ , configUrl :: Text
+ -- ^ HTTP endpoint URL to which messages are POSTed (iOS,Android/string)
+ , configUsername :: Text
+ -- ^ Endpoint username (iOS,Android/string)
+ , configWs :: Bool
+ -- ^ use MQTT over Websocket, default false (iOS,Android/boolean)
+ , configWaypoints :: [Waypoint]
+ -- ^ Array of waypoint messages (iOS,Android/array)
+ } deriving (Show, Eq, Generic)
+
+
+TH.deriveJSON (TH.defaultOptions
+ { TH.omitNothingFields = True
+ , TH.rejectUnknownFields = False
+ , TH.fieldLabelModifier = drop 5 . \(x:xs) -> toLower x : xs
+ }) 'Configuration
diff --git a/lib/OwnTracks/Location.hs b/lib/OwnTracks/Location.hs
index b4bf807..987de73 100644
--- a/lib/OwnTracks/Location.hs
+++ b/lib/OwnTracks/Location.hs
@@ -64,7 +64,7 @@ instance FromJSON Trigger where
parseJSON _ = fail "Trigger Type must be a string"
data MonitoringMode = Quiet | Manual | Significant | Move
- deriving (Generic, Show, Eq)
+ deriving (Generic, Show, Eq, Enum)
instance FromJSON MonitoringMode where
parseJSON (Number i) = case i of
@@ -75,6 +75,9 @@ instance FromJSON MonitoringMode where
_ -> 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)
diff --git a/lib/OwnTracks/Status.hs b/lib/OwnTracks/Status.hs
index 83b5956..c87e28b 100644
--- a/lib/OwnTracks/Status.hs
+++ b/lib/OwnTracks/Status.hs
@@ -55,6 +55,15 @@ instance FromJSON Status where
(.:??) (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
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
+ ]
diff --git a/tracktrain.cabal b/tracktrain.cabal
index 12d70dd..6d6047f 100644
--- a/tracktrain.cabal
+++ b/tracktrain.cabal
@@ -126,12 +126,16 @@ library
, OwnTracks
, OwnTracks.Location
, OwnTracks.Status
+ , OwnTracks.Configuration
+ , OwnTracks.Command
+ , OwnTracks.Waypoint
default-language: GHC2021
default-extensions: OverloadedStrings
, ScopedTypeVariables
, ViewPatterns
, BlockArguments
, LambdaCase
+ , RecordWildCards
library gtfs-realtime
build-depends: base
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-16 14:15:07 +0000