Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Admin page: can now delete user accounts.

Browse source
This commit is contained in:
Philippe Pittoli 2025-05-09 01:37:22 +02:00
parent 35ff1d1347
commit a88eda1d94
3 changed files with 63 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/App/Container.purs
View file

@ -584,6 +584,12 @@ handleAction = case _ of
EventPageAdministration ev -> case ev of EventPageAdministration ev -> case ev of
PageAdministration.SendToAuthd message -> H.tell _ws_auth unit (WS.ToSend message) PageAdministration.SendToAuthd message -> H.tell _ws_auth unit (WS.ToSend message)
PageAdministration.SendToDNSManager message -> H.tell _ws_dns unit (WS.ToSend message) PageAdministration.SendToDNSManager message -> H.tell _ws_dns unit (WS.ToSend message)
PageAdministration.DeleteDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
H.tell _ws_dns unit (WS.ToSend message)
PageAdministration.SearchDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkSearchDomain { domain, offset: Just 0 }
H.tell _ws_dns unit (WS.ToSend message)
PageAdministration.ShowZone domain -> handleAction $ Routing $ Zone domain PageAdministration.ShowZone domain -> handleAction $ Routing $ Zone domain
PageAdministration.Log message -> handleAction $ Log message PageAdministration.Log message -> handleAction $ Log message
PageAdministration.StoreState s -> H.modify_ _ { childstates { administration = Just s } } PageAdministration.StoreState s -> H.modify_ _ { childstates { administration = Just s } }
@ -598,6 +604,12 @@ handleAction = case _ of
auth_message <- H.liftEffect $ AuthD.serialize $ AuthD.MkDeleteUser { user: Just uid } auth_message <- H.liftEffect $ AuthD.serialize $ AuthD.MkDeleteUser { user: Just uid }
H.tell _ws_dns unit (WS.ToSend dns_message) H.tell _ws_dns unit (WS.ToSend dns_message)
H.tell _ws_auth unit (WS.ToSend auth_message) H.tell _ws_auth unit (WS.ToSend auth_message)
PageAdministration.AddUser login admin email password -> do
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAddUser { login, admin, email, password }
H.tell _ws_auth unit (WS.ToSend message)
PageAdministration.SearchUser regex offset -> do
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { regex, offset }
H.tell _ws_auth unit (WS.ToSend message)
PageAdministration.GetOrphanDomains -> do PageAdministration.GetOrphanDomains -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {} message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {}
H.tell _ws_dns unit (WS.ToSend message) H.tell _ws_dns unit (WS.ToSend message)

89
src/App/Page/Administration.purs
View file

@ -39,19 +39,26 @@ import Data.ArrayBuffer.Types (ArrayBuffer)
import App.Type.LogMessage import App.Type.LogMessage
import App.Type.Email as Email import App.Type.Email as Email
import App.Message.DNSManagerDaemon as DNSManager
import App.Message.AuthenticationDaemon as AuthD import App.Message.AuthenticationDaemon as AuthD
data Output data Output
= SendToAuthd ArrayBuffer = SendToAuthd ArrayBuffer
| SendToDNSManager ArrayBuffer | SendToDNSManager ArrayBuffer
| ShowZone String
| Log LogMessage | AddUser String Boolean (Maybe Email.Email) String
| AskState | SearchUser (Maybe String) (Maybe Int)
| StoreState State
| DeleteUserAccount Int | DeleteUserAccount Int
| GetOrphanDomains | GetOrphanDomains
| DeleteDomain String
| SearchDomain String
| ShowZone String
| Log LogMessage
| StoreState State
| AskState
data Query a data Query a
= MessageReceived AuthD.AnswerMessage a = MessageReceived AuthD.AnswerMessage a
| GotOrphanDomainList (Array String) a | GotOrphanDomainList (Array String) a
@ -87,7 +94,7 @@ data Action
-- Users. -- Users.
| ShowUser Int | ShowUser Int
| RemoveUser Int | DeleteUser Int
-- Domains. -- Domains.
| RemoveDomain String | RemoveDomain String
@ -103,7 +110,7 @@ data Action
-- | There are different tabs in the administration page. -- | There are different tabs in the administration page.
-- | For example, users can be searched (`authd`) and a list is provided. -- | For example, users can be searched (`authd`) and a list is provided.
data Tab = Home | SearchUser | SearchDomain | Add | OrphanDomains data Tab = TabHome | TabSearchUser | TabSearchDomain | TabAddUser | TabOrphanDomains
derive instance eqTab :: Eq Tab derive instance eqTab :: Eq Tab
type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String } type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
@ -140,7 +147,7 @@ initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "
, matching_users: [] , matching_users: []
, matching_domains: [] , matching_domains: []
, orphan_domains: [] , orphan_domains: []
, current_tab: Home , current_tab: TabHome
} }
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
@ -150,18 +157,18 @@ render { addUserForm, searchUserForm, searchDomainForm
= Web.section_small = Web.section_small
[ fancy_tab_bar [ fancy_tab_bar
, case current_tab of , case current_tab of
Home -> Web.h3 "Select an action" TabHome -> Web.h3 "Select an action"
SearchUser -> Web.columns_ TabSearchUser -> Web.columns_
[ Web.column [C.is 3] [Web.article (Web.p "Search users") render_searchuser_form] [ Web.column [C.is 3] [Web.article (Web.p "Search users") render_searchuser_form]
, Web.column_ [ Templates.found_users ShowUser matching_users ] , Web.column_ [ Templates.found_users ShowUser DeleteUser matching_users ]
] ]
SearchDomain -> Web.columns_ TabSearchDomain -> Web.columns_
[ Web.column [C.is 3] [Web.article (Web.p "Search domains") render_searchdomain_form] [ Web.column [C.is 3] [Web.article (Web.p "Search domains") render_searchdomain_form]
, Web.column_ [ Templates.found_domains EnterDomain RemoveDomain matching_domains ] , Web.column_ [ Templates.found_domains EnterDomain RemoveDomain matching_domains ]
] ]
Add -> Web.columns_ TabAddUser -> Web.columns_
[ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ] [ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ]
OrphanDomains -> HH.div_ TabOrphanDomains -> HH.div_
[ Web.btn_ [C.is_small] "Get orphan domains" ShowOrphanDomains [ Web.btn_ [C.is_small] "Get orphan domains" ShowOrphanDomains
, show_orphan_domains , show_orphan_domains
] ]
@ -169,11 +176,11 @@ render { addUserForm, searchUserForm, searchDomainForm
where where
fancy_tab_bar = fancy_tab_bar =
Web.fancy_tabs Web.fancy_tabs
[ Web.tab_entry (is_tab_active Home) "Home" (ChangeTab Home) [ Web.tab_entry (is_tab_active TabHome) "Home" (ChangeTab TabHome)
, Web.tab_entry (is_tab_active SearchUser) "SearchUser" (ChangeTab SearchUser) , Web.tab_entry (is_tab_active TabSearchUser) "SearchUser" (ChangeTab TabSearchUser)
, Web.tab_entry (is_tab_active SearchDomain) "SearchDomain" (ChangeTab SearchDomain) , Web.tab_entry (is_tab_active TabSearchDomain) "SearchDomain" (ChangeTab TabSearchDomain)
, Web.tab_entry (is_tab_active Add) "Add" (ChangeTab Add) , Web.tab_entry (is_tab_active TabAddUser) "AddUser" (ChangeTab TabAddUser)
, Web.tab_entry (is_tab_active OrphanDomains) "OrphanDomains" (ChangeTab OrphanDomains) , Web.tab_entry (is_tab_active TabOrphanDomains) "OrphanDomains" (ChangeTab TabOrphanDomains)
] ]
is_tab_active tab = current_tab == tab is_tab_active tab = current_tab == tab
@ -223,11 +230,11 @@ handleAction = case _ of
case old_tab of case old_tab of
Nothing -> pure unit Nothing -> pure unit
Just current_tab -> case current_tab of Just current_tab -> case current_tab of
"Home" -> handleAction $ ChangeTab Home "TabHome" -> handleAction $ ChangeTab TabHome
"SearchUser" -> handleAction $ ChangeTab SearchUser "TabSearchUser" -> handleAction $ ChangeTab TabSearchUser
"SearchDomain" -> handleAction $ ChangeTab SearchDomain "TabSearchDomain" -> handleAction $ ChangeTab TabSearchDomain
"Add" -> handleAction $ ChangeTab Add "TabAddUser" -> handleAction $ ChangeTab TabAddUser
"OrphanDomains" -> handleAction $ ChangeTab OrphanDomains "TabOrphanDomains" -> handleAction $ ChangeTab TabOrphanDomains
_ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab _ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
Finalize -> do Finalize -> do
@ -259,16 +266,16 @@ handleAction = case _ of
H.raise $ Log $ SystemLog $ "Get orphan domains" H.raise $ Log $ SystemLog $ "Get orphan domains"
H.raise $ GetOrphanDomains H.raise $ GetOrphanDomains
RemoveUser uid -> do DeleteUser uid -> do
H.raise $ Log $ SystemLog $ "Remove user " <> show uid H.raise $ Log $ SystemLog $ "Remove user " <> show uid
H.raise $ DeleteUserAccount uid H.raise $ DeleteUserAccount uid
RemoveDomain domain -> do RemoveDomain domain -> do
H.raise $ Log $ SystemLog $ "TODO: remove domain " <> domain H.raise $ Log $ SystemLog $ "Remove domain " <> domain
--H.raise $ DeleteDomain domain H.raise $ DeleteDomain domain
EnterDomain domain -> do EnterDomain domain -> do
H.raise $ Log $ SystemLog $ "show domain " <> domain H.raise $ Log $ SystemLog $ "Show zone " <> domain
H.raise $ ShowZone domain H.raise $ ShowZone domain
AddUserAttempt -> do AddUserAttempt -> do
@ -283,39 +290,31 @@ handleAction = case _ of
_, _, "" -> H.raise $ Log $ UnableToSend "Write the user's password." _, _, "" -> H.raise $ Log $ UnableToSend "Write the user's password."
_, _, _ -> do _, _, _ -> do
ab <- H.liftEffect $ AuthD.serialize $
AuthD.MkAddUser { login: login
, admin: addUserForm.admin
, email: Just (Email.Email email)
, password: pass }
H.raise $ SendToAuthd ab
H.raise $ Log $ SystemLog "Add a user" H.raise $ Log $ SystemLog "Add a user"
H.raise $ AddUser login addUserForm.admin (Just (Email.Email email)) pass
ChangeTab current_tab -> do ChangeTab current_tab -> do
-- Store the current tab we are on and restore it when we reload. -- Store the current tab we are on and restore it when we reload.
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
_ <- case current_tab of _ <- case current_tab of
Home -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home" sessionstorage TabHome -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabHome" sessionstorage
SearchUser -> H.liftEffect $ Storage.setItem "current-ada-tab" "SearchUser" sessionstorage TabSearchUser -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabSearchUser" sessionstorage
SearchDomain -> H.liftEffect $ Storage.setItem "current-ada-tab" "SearchDomain" sessionstorage TabSearchDomain -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabSearchDomain" sessionstorage
Add -> H.liftEffect $ Storage.setItem "current-ada-tab" "Add" sessionstorage TabAddUser -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabAddUser" sessionstorage
OrphanDomains -> H.liftEffect $ Storage.setItem "current-ada-tab" "OrphanDomains" sessionstorage TabOrphanDomains -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabOrphanDomains" sessionstorage
H.modify_ _ { current_tab = current_tab } H.modify_ _ { current_tab = current_tab }
SearchUserAttempt -> do SearchUserAttempt -> do
{ searchUserForm } <- H.get { searchUserForm } <- H.get
let regex = searchUserForm.regex let regex = searchUserForm.regex
ab <- H.liftEffect $ AuthD.serialize $ H.raise $ SearchUser (not_empty_string regex) (Just 0)
AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 }
H.raise $ SendToAuthd ab
H.modify_ _ { matching_users = [] } H.modify_ _ { matching_users = [] }
SearchDomainAttempt -> do SearchDomainAttempt -> do
{ searchDomainForm } <- H.get { searchDomainForm } <- H.get
let domain = searchDomainForm.domain let domain = searchDomainForm.domain
H.raise $ Log $ SystemLog $ "TODO: search for this domain: " <> domain H.raise $ Log $ SystemLog $ "Search for this domain: " <> domain
ab <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkSearchDomain { domain, offset: Just 0 } H.raise $ SearchDomain domain
H.raise $ SendToDNSManager ab
H.modify_ _ { matching_domains = [] } H.modify_ _ { matching_domains = [] }
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)

10
src/App/Templates/Table.purs
View file

@ -570,8 +570,10 @@ display_dmarc_mail_addresses f ms = Web.table [] [ header, HH.tbody_ $ map row $
, HH.td_ [ Button.alert_btn "x" (f i) ] , HH.td_ [ Button.alert_btn "x" (f i) ]
] ]
found_users :: forall w i. (Int -> i) -> Array UserPublic -> HH.HTML w i type ActionShowUser i = (Int -> i)
found_users f users = Web.table [] [ header, HH.tbody_ $ map row users ] type ActionDeleteUser i = (Int -> i)
found_users :: forall w i. ActionShowUser i -> ActionDeleteUser i -> Array UserPublic -> HH.HTML w i
found_users action_show_user action_delete_user users = Web.table [] [ header, HH.tbody_ $ map row users ]
where where
header :: HH.HTML w i header :: HH.HTML w i
header header
@ -583,10 +585,10 @@ found_users f users = Web.table [] [ header, HH.tbody_ $ map row users ]
] ]
row :: UserPublic -> HH.HTML w i row :: UserPublic -> HH.HTML w i
row user = HH.tr_ row user = HH.tr_
[ HH.td_ [ Web.p user.login ] [ HH.td_ [ Button.btn user.login (action_show_user user.uid) ]
, HH.td_ [ Web.p $ show user.uid ] , HH.td_ [ Web.p $ show user.uid ]
, HH.td_ [ Web.p $ fromMaybe "" user.date_registration ] , HH.td_ [ Web.p $ fromMaybe "" user.date_registration ]
, HH.td_ [ Button.alert_btn "x" (f user.uid) ] , HH.td_ [ Button.alert_btn "x" (action_delete_user user.uid) ]
] ]
type ActionEnterDomain i = (String -> i) type ActionEnterDomain i = (String -> i)