feat: notify on new room (wip)

backend/README.md

@@ -3,7 +3,8 @@
 ## Development
 
 `stack build`
-`stack stack run`
+
+`stack run`
 
 ## Debug
 
@@ -12,3 +13,44 @@ Using websocat
 `websocat ws://127.0.0.1:9160`
 
 `curl --data 'body data'  localhost:8081`
+
+```
+curl -X POST  localhost:8081/roomdata \
+     -H "Content-Type: application/json" \
+     -d '[
+   {
+     "roomName": "ConferenceRoom1",
+     "participants": [
+       {
+         "jid": "participant1@example.com",
+         "email": "participant1@example.com",
+         "displayName": "Alice",
+         "avatarURL": "https://example.com/avatars/alice.png"
+       },
+       {
+         "jid": "participant2@example.com",
+         "email": "participant2@example.com",
+         "displayName": "Bob",
+         "avatarURL": "https://example.com/avatars/bob.png"
+       }
+     ]
+   },
+   {
+     "roomName": "ConferenceRoom2",
+     "participants": [
+       {
+         "jid": "participant3@example.com",
+         "email": "participant3@example.com",
+         "displayName": "Charlie",
+         "avatarURL": "https://example.com/avatars/charlie.png"
+       },
+       {
+         "jid": "participant4@example.com",
+         "email": "participant4@example.com",
+         "displayName": "Dana",
+         "avatarURL": "https://example.com/avatars/dana.png"
+       }
+     ]
+   }
+ ]'
+```

backend/app/Main.hs

@@ -8,4 +8,6 @@ import Lib (runBothServers)
 main :: IO ()
 main = do
   setLocaleEncoding utf8
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
   runBothServers

backend/jitsi-rooms.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -62,6 +62,7 @@ library
     , http-types
     , lifted-base
     , mtl
+    , process
     , text
     , time
     , uuid
@@ -89,6 +90,7 @@ executable jitsi-rooms-exe
     , jitsi-rooms
     , lifted-base
     , mtl
+    , process
     , text
     , time
     , uuid

backend/package.yaml

@@ -34,6 +34,7 @@ dependencies:
   - mtl
   - time
   - wai-extra
+  - process
 
 ghc-options:
   - -Wall

backend/shell.nix

@@ -0,0 +1,10 @@
+{ pkgs ? import <nixpkgs> { } }:
+
+pkgs.mkShell {
+  buildInputs = with pkgs; [
+    haskell-language-server
+    stack
+    stylish-haskell
+  ];
+
+}

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]

backend/stack.yaml

@@ -16,7 +16,7 @@
 # this way we can use prebuild binaries for hls
 #resolver: nightly-2022-11-12
 #resolver: ghc-9.2.4
-resolver: lts-20.26
+resolver: lts-22.43
 #
 # The location of a snapshot can be provided as a file or url. Stack assumes
 # a snapshot provided as a file might change, whereas a url resource does not.
@@ -73,5 +73,3 @@ packages:
 # compiler-check: newer-minor
 ghc-options:
   "$everything": -haddock
-
-

backend/stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2
-    size: 650475
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
-  original: lts-20.26
+    sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146
+    size: 720271
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml
+  original: lts-22.43

frontend/result

@@ -0,0 +1 @@
+/nix/store/x3fqdrf05dcg52s7x6dkzql551g0bfxw-my-node-app-1.0.0