1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
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
|
