diff options
| -rw-r--r-- | fig-frontend/src/Fig/Frontend.hs | 38 | ||||
| -rw-r--r-- | fig-monitor-twitch/src/Fig/Monitor/Twitch.hs | 28 |
2 files changed, 29 insertions, 37 deletions
diff --git a/fig-frontend/src/Fig/Frontend.hs b/fig-frontend/src/Fig/Frontend.hs index 635df45..6efa2a1 100644 --- a/fig-frontend/src/Fig/Frontend.hs +++ b/fig-frontend/src/Fig/Frontend.hs @@ -6,10 +6,12 @@ import Fig.Prelude import System.Random (randomRIO) +import Control.Monad (unless) import Control.Lens (use, (^?), Ixed (..)) import qualified Control.Concurrent.Chan as Chan import qualified Control.Concurrent.MVar as MVar +import Data.Maybe (mapMaybe) import qualified Data.Text as Text import qualified Data.Text.Lazy as Text.L import qualified Data.ByteString.Base64 as BS.Base64 @@ -30,8 +32,8 @@ import Fig.Frontend.State import qualified Fig.Frontend.DB as DB data LiveEvent - = LiveEventOnline Text - | LiveEventOffline Text + = LiveEventOnline (Set.Set Text) + | LiveEventOffline (Set.Set Text) deriving (Show, Eq, Ord) server :: Config -> (Text, Text) -> IO () @@ -43,20 +45,20 @@ server cfg busAddr = do (\cmds -> do log "Connected to bus!" cmds.subscribe [sexp|(monitor twitch stream online)|] - cmds.subscribe [sexp|(monitor twitch stream offline)|] Warp.run cfg.port =<< app cfg cmds liveEvents currentlyLive ) (\_cmds d -> do case d of - SExprList [ev, SExprString user] + SExprList (ev:rest) | ev == [sexp|(monitor twitch stream online)|] -> do - log $ "Stream online: " <> user - MVar.modifyMVar_ currentlyLive (pure . Set.insert user) - Chan.writeChan liveEvents $ LiveEventOnline user - | ev == [sexp|(monitor twitch stream offline)|] -> do - log $ "Stream offline: " <> user - MVar.modifyMVar_ currentlyLive (pure . Set.delete user) - Chan.writeChan liveEvents $ LiveEventOffline user + let live = mapMaybe (\case SExprString s -> Just s; _ -> Nothing) rest + let new = Set.fromList live + log $ "Streams online: " <> tshow live + old <- MVar.swapMVar currentlyLive new + let online = Set.difference new old + let offline = Set.difference old new + unless (Set.null online) . Chan.writeChan liveEvents $ LiveEventOnline online + unless (Set.null offline) . Chan.writeChan liveEvents $ LiveEventOnline offline _ -> log $ "Invalid event: " <> tshow d ) (pure ()) @@ -150,13 +152,21 @@ app cfg cmds liveEvents currentlyLive = do Sc.text "partial" Sc.get "/api/circle" do live <- liftIO $ MVar.readMVar currentlyLive - Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ sexprStr <$> Set.toList live + Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ SExprString <$> Set.toList live websocket "/api/circle/events" \conn -> do c <- Chan.dupChan liveEvents forever do ev <- liftIO $ Chan.readChan c WS.sendTextData conn $ case ev of - LiveEventOnline u -> "online " <> u - LiveEventOffline u -> "offline " <> u + LiveEventOnline online -> + pretty $ SExprList @Void + [ SExprString "online" + , SExprList $ SExprString <$> Set.toList online + ] + LiveEventOffline offline -> + pretty $ SExprList @Void + [ SExprString "offline" + , SExprList $ SExprString <$> Set.toList offline + ] Sc.notFound do Sc.text "not found" diff --git a/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs b/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs index 561c574..d4bc22b 100644 --- a/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs +++ b/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs @@ -21,6 +21,7 @@ import qualified Data.Text.Lazy as Text.Lazy import qualified Data.ByteString.Base64 as BS.Base64 import qualified Data.Vector as V import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import Data.Default.Class (def) @@ -59,7 +60,7 @@ loginToUserId login = do _ -> mempty maybe (throwM $ FigMonitorTwitchException "Failed to extract user ID") pure mid -usersAreLive :: [Text] -> Authed (Map.Map Text Bool) +usersAreLive :: [Text] -> Authed (Set.Set Text) usersAreLive users = do log $ "Checking liveness for: " <> Text.intercalate " " users res <- authedRequestJSON @@ -78,15 +79,7 @@ usersAreLive users = do _ -> mempty case mos of Nothing -> throwM $ FigMonitorTwitchException "Failed to check liveness" - Just os -> Map.fromList <$> forM users \u -> do - let l = u `elem` os - log $ mconcat - [ u - , " is " - , if l then "" else "not " - , "live" - ] - pure (u, l) + Just os -> pure . Set.fromList $ filter (`elem` os) users subscribe :: Text -> Text -> Text -> Authed () subscribe sessionId event user = do @@ -482,23 +475,12 @@ twitchChannelLiveMonitor cfg busAddr = do busClient busAddr (\cmds -> do let - updateLive :: IO (Map.Map Text Bool) - updateLive = runAuthed cfg $ usersAreLive cfg.monitor - -- updateLive = fmap Map.fromList . runAuthed cfg $ forM cfg.monitor \user -> do - -- liftIO . threadDelay $ 5 * 1000000 - -- (user,) <$> userIsLive user loop :: IO () loop = do log "Updating liveness..." - live <- updateLive + live <- runAuthed cfg $ usersAreLive cfg.monitor log "Update complete!" - forM_ cfg.monitor \user -> - case Map.lookup user live of - Just True -> do - cmds.publish [sexp|(monitor twitch stream online)|] [SExprString user] - Just False -> do - cmds.publish [sexp|(monitor twitch stream offline)|] [SExprString user] - _ -> pure () + cmds.publish [sexp|(monitor twitch stream online)|] $ SExprString <$> Set.toList live threadDelay $ 5 * 60 * 1000000 loop loop |