diff --git a/src/App/Container.purs b/src/App/Container.purs index 69c2c73..ba08fdd 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -584,6 +584,12 @@ handleAction = case _ of EventPageAdministration ev -> case ev of PageAdministration.SendToAuthd message -> H.tell _ws_auth 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.Log message -> handleAction $ Log message 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 } H.tell _ws_dns unit (WS.ToSend dns_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 message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {} H.tell _ws_dns unit (WS.ToSend message) diff --git a/src/App/Page/Administration.purs b/src/App/Page/Administration.purs index 82e4ccc..740c2ef 100644 --- a/src/App/Page/Administration.purs +++ b/src/App/Page/Administration.purs @@ -39,19 +39,26 @@ import Data.ArrayBuffer.Types (ArrayBuffer) import App.Type.LogMessage import App.Type.Email as Email -import App.Message.DNSManagerDaemon as DNSManager import App.Message.AuthenticationDaemon as AuthD data Output = SendToAuthd ArrayBuffer | SendToDNSManager ArrayBuffer - | ShowZone String - | Log LogMessage - | AskState - | StoreState State + + | AddUser String Boolean (Maybe Email.Email) String + | SearchUser (Maybe String) (Maybe Int) | DeleteUserAccount Int + | GetOrphanDomains + | DeleteDomain String + | SearchDomain String + | ShowZone String + + | Log LogMessage + | StoreState State + | AskState + data Query a = MessageReceived AuthD.AnswerMessage a | GotOrphanDomainList (Array String) a @@ -87,7 +94,7 @@ data Action -- Users. | ShowUser Int - | RemoveUser Int + | DeleteUser Int -- Domains. | RemoveDomain String @@ -103,7 +110,7 @@ data Action -- | There are different tabs in the administration page. -- | 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 type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String } @@ -140,7 +147,7 @@ initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: " , matching_users: [] , matching_domains: [] , orphan_domains: [] - , current_tab: Home + , current_tab: TabHome } render :: forall m. State -> H.ComponentHTML Action () m @@ -150,18 +157,18 @@ render { addUserForm, searchUserForm, searchDomainForm = Web.section_small [ fancy_tab_bar , case current_tab of - Home -> Web.h3 "Select an action" - SearchUser -> Web.columns_ + TabHome -> Web.h3 "Select an action" + TabSearchUser -> Web.columns_ [ 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_ [ 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] ] - OrphanDomains -> HH.div_ + TabOrphanDomains -> HH.div_ [ Web.btn_ [C.is_small] "Get orphan domains" ShowOrphanDomains , show_orphan_domains ] @@ -169,11 +176,11 @@ render { addUserForm, searchUserForm, searchDomainForm where fancy_tab_bar = Web.fancy_tabs - [ Web.tab_entry (is_tab_active Home) "Home" (ChangeTab Home) - , Web.tab_entry (is_tab_active SearchUser) "SearchUser" (ChangeTab SearchUser) - , Web.tab_entry (is_tab_active SearchDomain) "SearchDomain" (ChangeTab SearchDomain) - , Web.tab_entry (is_tab_active Add) "Add" (ChangeTab Add) - , Web.tab_entry (is_tab_active OrphanDomains) "OrphanDomains" (ChangeTab OrphanDomains) + [ Web.tab_entry (is_tab_active TabHome) "Home" (ChangeTab TabHome) + , Web.tab_entry (is_tab_active TabSearchUser) "SearchUser" (ChangeTab TabSearchUser) + , Web.tab_entry (is_tab_active TabSearchDomain) "SearchDomain" (ChangeTab TabSearchDomain) + , Web.tab_entry (is_tab_active TabAddUser) "AddUser" (ChangeTab TabAddUser) + , Web.tab_entry (is_tab_active TabOrphanDomains) "OrphanDomains" (ChangeTab TabOrphanDomains) ] is_tab_active tab = current_tab == tab @@ -223,11 +230,11 @@ handleAction = case _ of case old_tab of Nothing -> pure unit Just current_tab -> case current_tab of - "Home" -> handleAction $ ChangeTab Home - "SearchUser" -> handleAction $ ChangeTab SearchUser - "SearchDomain" -> handleAction $ ChangeTab SearchDomain - "Add" -> handleAction $ ChangeTab Add - "OrphanDomains" -> handleAction $ ChangeTab OrphanDomains + "TabHome" -> handleAction $ ChangeTab TabHome + "TabSearchUser" -> handleAction $ ChangeTab TabSearchUser + "TabSearchDomain" -> handleAction $ ChangeTab TabSearchDomain + "TabAddUser" -> handleAction $ ChangeTab TabAddUser + "TabOrphanDomains" -> handleAction $ ChangeTab TabOrphanDomains _ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab Finalize -> do @@ -259,16 +266,16 @@ handleAction = case _ of H.raise $ Log $ SystemLog $ "Get orphan domains" H.raise $ GetOrphanDomains - RemoveUser uid -> do + DeleteUser uid -> do H.raise $ Log $ SystemLog $ "Remove user " <> show uid H.raise $ DeleteUserAccount uid RemoveDomain domain -> do - H.raise $ Log $ SystemLog $ "TODO: remove domain " <> domain - --H.raise $ DeleteDomain domain + H.raise $ Log $ SystemLog $ "Remove domain " <> domain + H.raise $ DeleteDomain domain EnterDomain domain -> do - H.raise $ Log $ SystemLog $ "show domain " <> domain + H.raise $ Log $ SystemLog $ "Show zone " <> domain H.raise $ ShowZone domain AddUserAttempt -> do @@ -283,39 +290,31 @@ 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 } - H.raise $ SendToAuthd ab H.raise $ Log $ SystemLog "Add a user" + H.raise $ AddUser login addUserForm.admin (Just (Email.Email email)) pass ChangeTab current_tab -> do -- Store the current tab we are on and restore it when we reload. sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window _ <- case current_tab of - Home -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home" sessionstorage - SearchUser -> H.liftEffect $ Storage.setItem "current-ada-tab" "SearchUser" sessionstorage - SearchDomain -> H.liftEffect $ Storage.setItem "current-ada-tab" "SearchDomain" sessionstorage - Add -> H.liftEffect $ Storage.setItem "current-ada-tab" "Add" sessionstorage - OrphanDomains -> H.liftEffect $ Storage.setItem "current-ada-tab" "OrphanDomains" sessionstorage + TabHome -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabHome" sessionstorage + TabSearchUser -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabSearchUser" sessionstorage + TabSearchDomain -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabSearchDomain" sessionstorage + TabAddUser -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabAddUser" sessionstorage + TabOrphanDomains -> H.liftEffect $ Storage.setItem "current-ada-tab" "TabOrphanDomains" sessionstorage H.modify_ _ { current_tab = current_tab } SearchUserAttempt -> do { searchUserForm } <- H.get let regex = searchUserForm.regex - ab <- H.liftEffect $ AuthD.serialize $ - AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 } - H.raise $ SendToAuthd ab + H.raise $ SearchUser (not_empty_string regex) (Just 0) H.modify_ _ { matching_users = [] } SearchDomainAttempt -> do { searchDomainForm } <- H.get let domain = searchDomainForm.domain - H.raise $ Log $ SystemLog $ "TODO: search for this domain: " <> domain - ab <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkSearchDomain { domain, offset: Just 0 } - H.raise $ SendToDNSManager ab + H.raise $ Log $ SystemLog $ "Search for this domain: " <> domain + H.raise $ SearchDomain domain H.modify_ _ { matching_domains = [] } handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) diff --git a/src/App/Templates/Table.purs b/src/App/Templates/Table.purs index 34d60a7..9baccd7 100644 --- a/src/App/Templates/Table.purs +++ b/src/App/Templates/Table.purs @@ -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) ] ] -found_users :: forall w i. (Int -> i) -> Array UserPublic -> HH.HTML w i -found_users f users = Web.table [] [ header, HH.tbody_ $ map row users ] +type ActionShowUser i = (Int -> i) +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 header :: HH.HTML w i header @@ -583,10 +585,10 @@ found_users f users = Web.table [] [ header, HH.tbody_ $ map row users ] ] row :: UserPublic -> HH.HTML w i 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 $ 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) @@ -599,7 +601,7 @@ found_domains action_enter_domain action_delete_domain domains = Web.table [] [ row dom = HH.tr_ [ HH.td_ [ Button.btn dom (action_enter_domain dom) ] , HH.td_ [ Web.p "" ] - , HH.td_ [ Button.alert_btn "x" (action_delete_domain dom) ] + , HH.td_ [ Button.alert_btn "x" (action_delete_domain dom) ] ] header :: HH.HTML w i header