diff options
Diffstat (limited to 'lib/Server.hs')
| -rw-r--r-- | lib/Server.hs | 8 |
1 files changed, 5 insertions, 3 deletions
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 |