feat: notify on new room (wip)

backend/src/RoomDataHandler.hs

@@ -10,6 +10,7 @@ import ClassyPrelude
 import Control.Monad.Except (MonadError, throwError)
 import Data.Aeson (eitherDecodeStrict)
 import Data.Aeson.Types (FromJSON)
+import GHC.IO.Exception (ExitCode (ExitSuccess))
 import Network.HTTP.Types (status200, status500)
 import Network.Wai
   ( ResponseReceived,
@@ -21,8 +22,12 @@ import State.RoomDataState
     MonadRoomDataStateRead,
   )
 import State.RoomsState
-  ( roomStateDiffers,
+  ( roomStateDiffInOpenRooms,
+    roomStateDiffers,
   )
+import System.Process
+import Text.Printf (printf)
+import Types.RoomData (RoomData, prettyPrintOpenedRoom)
 import Types.WebEnv
   ( HasWebEnv (getRequest),
     getRespond,
@@ -42,6 +47,11 @@ roomDataHandler = do
   newRoomData <- parseBodyOrBadRequest
   liftIO $ putStrLn "Got triggered from prosody"
   whenM (roomStateDiffers newRoomData) $ do
+    (openedRooms, closedRooms) <- roomStateDiffInOpenRooms newRoomData
+
+    mapM_ notifyRoomOpend openedRooms
+    mapM_ notifyRoomClosed closedRooms
+
     setRoomDataState newRoomData
     broadcastUserData
   success
@@ -55,6 +65,7 @@ parseBodyOrBadRequest ::
   ) =>
   m a
 parseBodyOrBadRequest = do
+  liftIO $ putStrLn "Parsing body"
   body <- getRequestBody
   case eitherDecodeStrict body of
     Left errorMessage -> do
@@ -103,3 +114,17 @@ success = do
         status200
         [("Content-Type", "text/plain")]
         ""
+
+notifyRoomOpend :: (MonadIO m) => RoomData -> m ()
+notifyRoomOpend room = do
+  let (name, user) = prettyPrintOpenedRoom room
+  liftIO $ printf "Room %s opened by %s\n" name user
+  exitCode <- liftIO $ system $ printf "/nix/store/23nz5mjk3dj7027byc6g5avx3mfwwnqm-libnotify-0.8.3/bin/notify-send 'Room %s opened by %s'" name user
+  when (exitCode /= ExitSuccess) $ liftIO $ printf "Failed to notify room %s opened by %s\n" name user
+
+notifyRoomClosed :: (MonadIO m) => RoomData -> m ()
+notifyRoomClosed room = do
+  let (name, _) = prettyPrintOpenedRoom room
+  liftIO $ printf "Room %s closed\n" name
+  exitCode <- liftIO $ system $ printf "/nix/store/23nz5mjk3dj7027byc6g5avx3mfwwnqm-libnotify-0.8.3/bin/notify-send 'Room %s closed'" name
+  when (exitCode /= ExitSuccess) $ liftIO $ printf "Failed to notify room %s closed\n" name

backend/src/State/RoomsState.hs

@@ -3,6 +3,7 @@ module State.RoomsState
     initRoomsState,
     HasRoomsState (..),
     roomStateDiffers,
+    roomStateDiffInOpenRooms,
     updateRoomState,
     getRoomState,
   )
@@ -11,7 +12,7 @@ where
 import ClassyPrelude
 import State.GenericTVarState
 import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
-import Types.RoomData (RoomsData)
+import Types.RoomData (RoomsData, roomNotEmpty, sameName)
 
 type RoomsState = GenericTVarState RoomsData
 
@@ -52,5 +53,18 @@ roomStateDiffers ::
 roomStateDiffers newData = do
   not . eqIgnoreOrdering newData <$> getRoomDataState
 
+roomStateDiffInOpenRooms ::
+  ( MonadRoomDataStateRead m
+  ) =>
+  RoomsData ->
+  m (RoomsData, RoomsData)
+roomStateDiffInOpenRooms newData = do
+  current <- getRoomDataState
+
+  let newRooms = filter roomNotEmpty $ filter (\newRoom -> isNothing $ find (sameName newRoom) current) newData
+  let oldRooms = filter (\newRoom -> isJust $ find (sameName newRoom) current) newData
+
+  return (newRooms, oldRooms)
+
 eqIgnoreOrdering :: (Eq a) => [a] -> [a] -> Bool
 eqIgnoreOrdering a b = length a == length b && all (`elem` b) a

backend/src/Types/Participant.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 
-module Types.Participant (Participant) where
+module Types.Participant (Participant (Participant, displayName)) where
 
 import ClassyPrelude
 import Data.Aeson (FromJSON, ToJSON)

backend/src/Types/RoomData.hs

@@ -1,10 +1,10 @@
 {-# LANGUAGE DeriveGeneric #-}
 
-module Types.RoomData (RoomData, RoomsData) where
+module Types.RoomData (RoomData, RoomsData, sameName, roomNotEmpty, prettyPrintOpenedRoom) where
 
 import ClassyPrelude
 import Data.Aeson (FromJSON, ToJSON)
-import Types.Participant (Participant)
+import Types.Participant (Participant (Participant, displayName))
 
 data RoomData = RoomData
   { roomName :: RoomName,
@@ -12,6 +12,16 @@ data RoomData = RoomData
   }
   deriving (Generic, Show, Eq)
 
+sameName :: RoomData -> RoomData -> Bool
+sameName RoomData {roomName = name1} RoomData {roomName = name2} = name1 == name2
+
+roomNotEmpty :: RoomData -> Bool
+roomNotEmpty RoomData {participants = participants} = not $ null participants
+
+prettyPrintOpenedRoom :: RoomData -> (Text, Text)
+prettyPrintOpenedRoom RoomData {roomName = roomName, participants = participants} =
+  (roomName, fromMaybe "" (headMay (map (\Participant {displayName = displayName} -> displayName) participants)))
+
 type RoomName = Text
 
 type RoomsData = [RoomData]