diff options
Diffstat (limited to 'lib/Server.hs')
| -rw-r--r-- | lib/Server.hs | 10 |
1 files changed, 9 insertions, 1 deletions
diff --git a/lib/Server.hs b/lib/Server.hs index 84dc27e..8cab47a 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -151,13 +151,21 @@ server gtfs@GTFS{..} Metrics{..} subscribers dbpool = handleDebugAPI liftIO $ handleTrainPing (WS.sendClose conn ("" :: ByteString)) ping >>= \case Just anchor -> WS.sendTextData conn (A.encode anchor) Nothing -> pure () - handleSubscribe tripId conn = liftIO $ WS.withPingThread conn 30 (pure ()) $ do + handleSubscribe tripId day conn = liftIO $ WS.withPingThread conn 30 (pure ()) $ do queue <- atomically $ do queue <- newTQueue qs <- readTVar subscribers writeTVar subscribers $ M.insertWith (<>) tripId [queue] qs pure queue + -- send most recent ping, if any (so we won't have to wait for movement) + lastPing <- runSql dbpool $ do + tokens <- selectList [RunningDay ==. day, RunningTrip ==. tripId] [] + <&> fmap entityKey + selectFirst [TrainPingToken <-. tokens] [Desc TrainPingTimestamp] + <&> fmap entityVal + whenJust lastPing $ \ping -> + WS.sendTextData conn (A.encode lastPing) handle (\(e :: WS.ConnectionException) -> removeSubscriber queue) $ forever $ do res <- atomically $ readTQueue queue case res of |