diff options
Diffstat (limited to 'lib/Server/Ingest.hs')
| -rw-r--r-- | lib/Server/Ingest.hs | 30 |
1 files changed, 23 insertions, 7 deletions
diff --git a/lib/Server/Ingest.hs b/lib/Server/Ingest.hs index edbce08..c598ac2 100644 --- a/lib/Server/Ingest.hs +++ b/lib/Server/Ingest.hs @@ -54,8 +54,9 @@ import Data.Maybe (fromJust) import qualified Data.Text as T import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries) import qualified Data.UUID as UUID -import Database.Esqueleto.Experimental (from, selectOne, table, - val, where_, (^.)) +import Database.Esqueleto.Experimental (from, select, selectOne, + set, table, val, where_, + (^.)) import qualified Database.Esqueleto.Experimental as E import Extrapolation (Extrapolator (..), LinearExtrapolator (..), @@ -126,7 +127,7 @@ handleOwntracksMessage -> Maybe Text -> Maybe Text -> Message - -> LoggingT (ReaderT LoggingConfig Handler) () + -> LoggingT (ReaderT LoggingConfig Handler) [Command] handleOwntracksMessage dbpool subscribers cfg maybeUser device msg = do user <- case maybeUser of Just user -> pure user @@ -177,10 +178,25 @@ handleOwntracksMessage dbpool subscribers cfg maybeUser device msg = do , pingSequence = Nothing } pure () - Just ticketId -> do - runSql dbpool $ insertSentPing subscribers cfg undefined tracker ticketId - pure () - + Just ticketId -> + void $ runSql dbpool $ insertSentPing subscribers cfg undefined tracker ticketId + other -> logWarnN $ "received unhandled owntracks message: "+|show other|+"" + + commands <- runSql dbpool $ do + command <- select do + command <- from (table @TrackerCommand) + where_ (command ^. TrackerCommandTracker E.==. val trackerId + E.&&. command ^. TrackerCommandStatus E.==. val Queued) + pure command + -- this is silly; update does not support a RETURNING clause … + E.update \command -> do + set command [ TrackerCommandStatus E.=. val Sent ] + where_ (command ^. TrackerCommandTracker E.==. val trackerId + E.&&. command ^. TrackerCommandStatus E.==. val Queued) + pure command + + logInfoN $ "sending commands: "+|show (fmap (entityVal) commands)|+"" + pure (fmap (trackerCommandCommand . entityVal) commands) insertSentPing :: ServerState |