diff options
| -rw-r--r-- | lib/API.hs | 2 | ||||
| -rw-r--r-- | lib/Persist.hs | 8 | ||||
| -rw-r--r-- | lib/Server.hs | 8 | ||||
| -rw-r--r-- | messages/de.msg | 6 | ||||
| -rw-r--r-- | messages/en.msg | 3 | ||||
| -rw-r--r-- | site/obu.hamlet | 15 |
6 files changed, 35 insertions, 7 deletions
@@ -56,7 +56,7 @@ type API = "stations" :> Get '[JSON] (Map StationID Station) -- TODO: perhaps require a first ping for registration? :<|> "train" :> "register" :> Capture "Trip ID" TripID :> ReqBody '[JSON] RegisterJson :> Post '[JSON] Token -- TODO: perhaps a websocket instead? - :<|> "train" :> "ping" :> ReqBody '[JSON] TrainPing :> Post '[JSON] NoContent + :<|> "train" :> "ping" :> ReqBody '[JSON] TrainPing :> Post '[JSON] (Maybe TrainAnchor) :<|> "train" :> "ping" :> "ws" :> WebSocket -- debug things :<|> "debug" :> "pings" :> Get '[JSON] (Map Token [TrainPing]) diff --git a/lib/Persist.hs b/lib/Persist.hs index 769db2a..a8ed15e 100644 --- a/lib/Persist.hs +++ b/lib/Persist.hs @@ -99,7 +99,7 @@ TrainAnchor json sql=tt_trip_anchor sequence Double delay Seconds msg Text Maybe - deriving Show Generic Eq ToSchema + deriving Show Generic Eq -- TODO: multi-language support? Announcement json sql=tt_announcements @@ -110,7 +110,7 @@ Announcement json sql=tt_announcements day Day url Text Maybe announcedAt UTCTime Maybe - deriving Generic ToSchema Show + deriving Generic Show -- | this table works as calendar_dates.txt in GTFS ScheduleAmendment json sql=tt_schedule_amendement @@ -125,6 +125,10 @@ instance ToSchema RunningId where declareNamedSchema _ = declareNamedSchema (Proxy @UUID) instance ToSchema TrainPing where declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "trainPing") +instance ToSchema TrainAnchor where + declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "trainAnchor") +instance ToSchema Announcement where + declareNamedSchema = genericDeclareNamedSchema (swaggerOptions "announcement") runSql :: MonadIO m => Pool SqlBackend -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> m a runSql pool = liftIO . flip runSqlPersistMPool pool diff --git a/lib/Server.hs b/lib/Server.hs index db23932..3c1e84b 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -103,7 +103,7 @@ server gtfs@GTFS{..} dbpool = handleDebugAPI handleTrainPing onError ping = isTokenValid dbpool (coerce $ trainPingToken ping) >>= \case Nothing -> do onError - pure NoContent + pure Nothing Just running@Running{..} -> do let anchor = extrapolateAnchorFromPing @LinearExtrapolator gtfs running ping -- TODO: are these always inserted in order? @@ -115,7 +115,7 @@ server gtfs@GTFS{..} dbpool = handleDebugAPI -- only insert new estimates if they've actually changed anything when (fmap (trainAnchorDelay . entityVal) last /= Just (trainAnchorDelay anchor)) $ void $ insert anchor - pure NoContent + pure (Just anchor) handleWS conn = do liftIO $ WS.forkPingThread conn 30 forever $ do @@ -127,7 +127,9 @@ server gtfs@GTFS{..} dbpool = handleDebugAPI Right ping -> -- if invalid token, send a "polite" close request. Note that the client may -- ignore this and continue sending messages, which will continue to be handled. - liftIO $ void $ handleTrainPing (WS.sendClose conn ("" :: ByteString)) ping + liftIO $ handleTrainPing (WS.sendClose conn ("" :: ByteString)) ping >>= \case + Just anchor -> WS.sendTextData conn (A.encode anchor) + Nothing -> pure () handleDebugState = do now <- liftIO getCurrentTime runSql dbpool $ do diff --git a/messages/de.msg b/messages/de.msg index 2da81b8..7243173 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -22,3 +22,9 @@ OnStationSequence idx: an Stationsindex #{idx} ChooseTrain: Fahrt auswählen TokenFailed: konnte kein Token erhalten +PermissionFailed: Berechtigungsfehler +WebsocketError: Websocketfehler +Error: Fehler +Estimated: Geschätzt +Delay: Verspätung +Sequence: Stationsindex diff --git a/messages/en.msg b/messages/en.msg index ddbfdfd..ac6aca0 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -31,3 +31,6 @@ TokenFailed: Failed to acquire token PermissionFailed: permission failed WebsocketError: Websocket Error Error: Error +Estimated: Estimated +Delay: Delay +Sequence: Station Index diff --git a/site/obu.hamlet b/site/obu.hamlet index 9aec4c0..7068014 100644 --- a/site/obu.hamlet +++ b/site/obu.hamlet @@ -10,6 +10,11 @@ <p><strong>Accuracy: </strong><span id="acc"> <section> + <h2>_{MsgEstimated} + <p><strong>_{MsgDelay}</strong>: <span id="delay"> + <p><strong>_{MsgSequence}</strong>: <span id="sequence"> + +<section> <h2>Status <p id="status">_{MsgNone} <p id>_{MsgError}: <span id="error"> @@ -57,6 +62,14 @@ setTimeout(openWebsocket, 1000); } + function wsMsg(msg) { + let json = JSON.parse(msg.data); + console.log(json); + document.getElementById("delay").innerText = + `${json.delay}s (${Math.floor(json.delay / 60)}min)`; + document.getElementById("sequence").innerText = json.sequence; + } + function initGeopos() { document.getElementById("error").innerText = ""; @@ -72,7 +85,7 @@ ws = new WebSocket((location.protocol == "http:" ? "ws" : "wss") + "://" + location.host + "/api/train/ping/ws"); ws.onerror = wsError; ws.onclose = wsClose; - ws.onmessage = (msg) => console.log(msg.data); // TODO: display delays etc. + ws.onmessage = wsMsg ws.onopen = (event) => initGeopos(); } |