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