diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/Server/Frontend/Tickets.hs | 11 | ||||
| -rw-r--r-- | lib/Server/Subscribe.hs | 14 |
2 files changed, 13 insertions, 12 deletions
diff --git a/lib/Server/Frontend/Tickets.hs b/lib/Server/Frontend/Tickets.hs index ef80d42..3e17cd1 100644 --- a/lib/Server/Frontend/Tickets.hs +++ b/lib/Server/Frontend/Tickets.hs @@ -292,20 +292,21 @@ getTicketMapViewR ticketId = do attribution: '© <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors' }).addTo(map); - ws = new WebSocket((location.protocol == "http:" ? "ws" : "wss") + "://" + location.host + "/api/train/subscribe/#{UUID.toText ticketId}"); + ws = new WebSocket((location.protocol == "http:" ? "ws" : "wss") + "://" + location.host + "/api/ticket/subscribe/#{UUID.toText ticketId}"); var marker = null; ws.onmessage = (msg) => { let json = JSON.parse(msg.data); + console.log(json) if (marker === null) { - marker = L.marker([json.lat, json.long]); + marker = L.marker(json.geopos); marker.addTo(map); } else { - marker.setLatLng([json.lat, json.long]); + marker.setLatLng(json.geopos); } - map.setView([json.lat, json.long], 13); - document.getElementById("status").innerText = "_{MsgLastPing}: "+json.lat+","+json.long+" ("+json.timestamp+")"; + map.setView(json.geopos, 13); + document.getElementById("status").innerText = "_{MsgLastPing}: "+json.geopos[0]+","+json.geopos[1]+" ("+json.timestamp+")"; } |] diff --git a/lib/Server/Subscribe.hs b/lib/Server/Subscribe.hs index fdc092b..831f4c9 100644 --- a/lib/Server/Subscribe.hs +++ b/lib/Server/Subscribe.hs @@ -7,6 +7,7 @@ import Control.Exception (handle) import Control.Monad.Extra (forever, whenJust) import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as C8 +import Data.Coerce (coerce) import Data.Functor ((<&>)) import Data.Map (Map) import qualified Data.Map as M @@ -35,14 +36,13 @@ handleSubscribe dbpool subscribers (ticketId :: UUID) conn = liftIO $ WS.withPin writeTVar subscribers $ M.insertWith (<>) ticketId [queue] qs pure queue + -- send most recent ping, if any (so we won't have to wait for movement) - lastPing <- runSqlWithoutLog dbpool $ do - trackers <- getTicketTrackers ticketId - <&> fmap entityKey - selectFirst [TrainPingToken <-. trackers] [Desc TrainPingTimestamp] - <&> fmap entityVal - whenJust lastPing $ \ping -> - WS.sendTextData conn (A.encode lastPing) + runSqlWithoutLog dbpool + (selectFirst [TrainPingTicket ==. coerce ticketId] [Desc TrainPingTimestamp]) + <&> fmap entityVal + >>= flip whenJust (WS.sendTextData conn . A.encode) + handle (\(e :: WS.ConnectionException) -> removeSubscriber queue) $ forever $ do res <- atomically $ readTQueue queue case res of |