diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AuthenticationDaemonAdminInterface.purs index 5a98e2a..79421e3 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AuthenticationDaemonAdminInterface.purs @@ -7,12 +7,13 @@ -} module App.AuthenticationDaemonAdminInterface where -import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map) +import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=)) import Bulma as Bulma import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) +import Data.Array as A import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH @@ -68,6 +69,8 @@ data Action | SearchUserAttempt | PreventSubmit Event + | RemoveUser Int + -- | Change the displayed page. | Routing Page @@ -125,7 +128,9 @@ render { addUserForm, searchUserForm, matching_users, page, wsUp } ] where show_found_users = HH.div_ $ map user_card matching_users - user_card user = Bulma.box [Bulma.p user.login] + user_card user = Bulma.box [ Bulma.p user.login + , Bulma.alert_btn "remove" (RemoveUser user.uid) + ] up x = HandleAddUserInput <<< x active = (if wsUp then (HP.enabled true) else (HP.disabled true)) @@ -186,6 +191,11 @@ handleAction = case _ of PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev + RemoveUser uid -> do + H.raise $ Log $ UnableToSend $ "Try to remove user " <> show uid + ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkDeleteUser { user: Just uid } + H.raise $ MessageToSend ab + AddUserAttempt -> do { addUserForm } <- H.get let login = addUserForm.login @@ -198,10 +208,11 @@ handleAction = case _ of _, _, "" -> H.raise $ Log $ UnableToSend "Write the user's password!" _, _, _ -> do - ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkAddUser { login: login - , admin: addUserForm.admin - , email: Just (Email.Email email) - , password: pass } + ab <- H.liftEffect $ AuthD.serialize $ + AuthD.MkAddUser { login: login + , admin: addUserForm.admin + , email: Just (Email.Email email) + , password: pass } H.raise $ MessageToSend ab H.raise $ Log $ SimpleLog "[😇] Trying to add a user" @@ -250,6 +261,11 @@ handleQuery = case _ of H.raise $ Log $ SimpleLog "[🎉] Received a list of users." H.modify_ _ { matching_users = msg.users } + (AuthD.GotUserDeleted msg) -> do + H.raise $ Log $ SimpleLog $ "[🎉] user (uid: " <> show msg.uid <> ") got removed." + { matching_users } <- H.get + H.modify_ _ { matching_users = A.filter (\x -> x.uid /= msg.uid) matching_users } + -- Unexpected message. _ -> do H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message." diff --git a/src/App/Container.purs b/src/App/Container.purs index 6e88a31..28e5a7d 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -396,8 +396,12 @@ handleAction = case _ of AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m _ -> handleAction $ Log $ SimpleLog "[😈] received a GotMatchingUsers message while not on authd admin page." - (AuthD.GotUserDeleted _) -> do - handleAction $ Log $ SimpleLog "[😈] Received a GotUserDeleted message." + m@(AuthD.GotUserDeleted _) -> do + { current_page } <- H.get + case current_page of + AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m + _ -> handleAction $ Log $ SimpleLog + "[😈] received a GotUserDeleted message while not on authd admin page." (AuthD.GotErrorMustBeAuthenticated _) -> do handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorMustBeAuthenticated message." (AuthD.GotErrorAlreadyUsedLogin _) -> do