diff --git a/src/App/Container.purs b/src/App/Container.purs index 442aa7d..69c2c73 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -582,10 +582,12 @@ handleAction = case _ of PageSetup.Log message -> handleAction $ Log message EventPageAdministration ev -> case ev of - PageAdministration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - PageAdministration.Log message -> handleAction $ Log message - PageAdministration.StoreState s -> H.modify_ _ { childstates { administration = Just s } } - PageAdministration.AskState -> do + PageAdministration.SendToAuthd message -> H.tell _ws_auth unit (WS.ToSend message) + PageAdministration.SendToDNSManager message -> 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 } } + PageAdministration.AskState -> do state <- H.get H.tell _admini unit (PageAdministration.ProvideState state.childstates.administration) PageAdministration.DeleteUserAccount uid -> do diff --git a/src/App/Page/Administration.purs b/src/App/Page/Administration.purs index 69b9e7f..82e4ccc 100644 --- a/src/App/Page/Administration.purs +++ b/src/App/Page/Administration.purs @@ -14,7 +14,9 @@ module App.Page.Administration where import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=), (==), unit) import Data.Eq (class Eq) +import Utils (not_empty_string) import Web as Web +import App.Templates.Table as Templates import Data.Maybe (Maybe(..)) import Data.Array as A @@ -35,23 +37,21 @@ import App.Type.UserPublic (UserPublic) import Data.ArrayBuffer.Types (ArrayBuffer) import App.Type.LogMessage --- import App.IPC as IPC import App.Type.Email as Email import App.Message.DNSManagerDaemon as DNSManager import App.Message.AuthenticationDaemon as AuthD data Output - = MessageToSend ArrayBuffer + = SendToAuthd ArrayBuffer + | SendToDNSManager ArrayBuffer + | ShowZone String | Log LogMessage | AskState | StoreState State | DeleteUserAccount Int | GetOrphanDomains - --| DeleteDomain String - --| RequestDomain String - data Query a = MessageReceived AuthD.AnswerMessage a | GotOrphanDomainList (Array String) a @@ -85,13 +85,15 @@ data Action | SearchDomainAttempt | PreventSubmit Event + -- Users. | ShowUser Int | RemoveUser Int -- Domains. - | ShowOrphanDomains | RemoveDomain String - | ShowDomain String + | EnterDomain String + + | ShowOrphanDomains -- | Change the displayed tab. | ChangeTab Tab @@ -151,11 +153,11 @@ render { addUserForm, searchUserForm, searchDomainForm Home -> Web.h3 "Select an action" SearchUser -> Web.columns_ [ Web.column [C.is 3] [Web.article (Web.p "Search users") render_searchuser_form] - , Web.column_ [ Web.h3 "Result", show_found_users ] + , Web.column_ [ Templates.found_users ShowUser matching_users ] ] SearchDomain -> Web.columns_ [ Web.column [C.is 3] [Web.article (Web.p "Search domains") render_searchdomain_form] - , Web.column_ [ Web.h3 "Result", show_found_domains ] + , Web.column_ [ Templates.found_domains EnterDomain RemoveDomain matching_domains ] ] Add -> Web.columns_ [ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ] @@ -175,19 +177,9 @@ render { addUserForm, searchUserForm, searchDomainForm ] is_tab_active tab = current_tab == tab - show_found_users = Web.box [ HH.ul_ $ map user_card matching_users ] - user_card user = HH.li_ [ Web.btn_delete (RemoveUser user.uid) - , Web.btn_ [C.is_small] user.login (ShowUser user.uid) - ] - - show_found_domains = Web.box [ HH.ul_ $ map domain_card matching_domains ] - domain_card domain_ = HH.li_ [ Web.p domain_ - -- , Web.btn_delete (RemoveUser domain_) - -- , Web.btn_ [C.is_small] user.login (ShowUser user.uid) - ] show_orphan_domains = Web.box [ HH.ul_ $ map domain_entry orphan_domains ] domain_entry domain = HH.li_ [ Web.btn_delete (RemoveDomain domain) - , Web.btn_ [C.is_small] domain (ShowDomain domain) + , Web.btn_ [C.is_small] domain (EnterDomain domain) ] render_adduser_form = @@ -245,18 +237,18 @@ handleAction = case _ of ActionOnAddUserForm adduserinp -> do { addUserForm } <- H.get case adduserinp of - ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } } - ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } } - ADDUSER_toggle_admin -> H.modify_ _ { addUserForm { admin = not addUserForm.admin } } - ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } } + ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } } + ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } } + ADDUSER_toggle_admin -> H.modify_ _ { addUserForm { admin = not addUserForm.admin } } + ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } } ActionOnSearchUserForm searchuserinp -> do case searchuserinp of - SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex = v } } + SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex = v } } ActionOnSearchDomainForm searchdomaininp -> do case searchdomaininp of - SEARCHDOMAIN_INP_domain v -> H.modify_ _ { searchDomainForm { domain = v } } + SEARCHDOMAIN_INP_domain v -> H.modify_ _ { searchDomainForm { domain = v } } PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev @@ -275,9 +267,9 @@ handleAction = case _ of H.raise $ Log $ SystemLog $ "TODO: remove domain " <> domain --H.raise $ DeleteDomain domain - ShowDomain domain -> do - H.raise $ Log $ SystemLog $ "TODO: show domain " <> domain - -- H.raise $ RequestDomain domain + EnterDomain domain -> do + H.raise $ Log $ SystemLog $ "show domain " <> domain + H.raise $ ShowZone domain AddUserAttempt -> do { addUserForm } <- H.get @@ -296,7 +288,7 @@ handleAction = case _ of , admin: addUserForm.admin , email: Just (Email.Email email) , password: pass } - H.raise $ MessageToSend ab + H.raise $ SendToAuthd ab H.raise $ Log $ SystemLog "Add a user" ChangeTab current_tab -> do @@ -315,7 +307,7 @@ handleAction = case _ of let regex = searchUserForm.regex ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 } - H.raise $ MessageToSend ab + H.raise $ SendToAuthd ab H.modify_ _ { matching_users = [] } SearchDomainAttempt -> do @@ -323,13 +315,9 @@ handleAction = case _ of 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 $ MessageToSend ab + H.raise $ SendToDNSManager ab H.modify_ _ { matching_domains = [] } -not_empty_string :: String -> Maybe String -not_empty_string "" = Nothing -not_empty_string v = Just v - handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of diff --git a/src/App/Templates/Table.purs b/src/App/Templates/Table.purs index 727f10f..34d60a7 100644 --- a/src/App/Templates/Table.purs +++ b/src/App/Templates/Table.purs @@ -8,12 +8,15 @@ module App.Templates.Table , display_dmarc_mail_addresses , display_modifiers , display_mechanisms + , found_users + , found_domains ) where import Prelude (comparing, map, not, show, (#), ($), (&&), (<<<), (<>), (==), (>)) import CSSClasses as C +import App.Type.UserPublic (UserPublic) import Data.Array.NonEmpty as NonEmpty import Data.Array as A import Data.Maybe (Maybe(..), fromMaybe, maybe) @@ -551,19 +554,57 @@ display_modifiers action_remove_modifier ms = ] display_dmarc_mail_addresses :: forall w i. (Int -> i) -> Array DMARC.DMARCURI -> HH.HTML w i -display_dmarc_mail_addresses f ms = - Web.table [] [ dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms] +display_dmarc_mail_addresses f ms = Web.table [] [ header, HH.tbody_ $ map row $ attach_id 0 ms] where - render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i - render_dmarcuri_row (Tuple i m) = HH.tr_ - [ HH.td_ [ Web.p m.mail ] - , HH.td_ [ Web.p $ maybe "(no size limit)" show m.limit ] - , HH.td_ [ Button.alert_btn "x" (f i) ] - ] - dmarc_dmarcuri_table_header :: HH.HTML w i - dmarc_dmarcuri_table_header + header :: HH.HTML w i + header = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ] , HH.th_ [ HH.text "Report size limit" ] , HH.th_ [ HH.text "" ] ] ] + row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i + row (Tuple i m) = HH.tr_ + [ HH.td_ [ Web.p m.mail ] + , HH.td_ [ Web.p $ maybe "(no size limit)" show m.limit ] + , 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 ] + where + header :: HH.HTML w i + header + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Username" ] + , HH.th_ [ HH.text "UID" ] + , HH.th_ [ HH.text "Date of registration" ] + , HH.th_ [ HH.text "" ] + ] + ] + row :: UserPublic -> HH.HTML w i + row user = HH.tr_ + [ HH.td_ [ Web.p user.login ] + , HH.td_ [ Web.p $ show user.uid ] + , HH.td_ [ Web.p $ fromMaybe "" user.date_registration ] + , HH.td_ [ Button.alert_btn "x" (f user.uid) ] + ] + +type ActionEnterDomain i = (String -> i) +type ActionDeleteDomain i = (String -> i) +found_domains :: forall w i. + ActionEnterDomain i -> ActionDeleteDomain i -> Array String -> HH.HTML w i +found_domains action_enter_domain action_delete_domain domains = Web.table [] [ header, HH.tbody_ $ map row domains ] + where + row :: String -> HH.HTML w i + 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) ] + ] + header :: HH.HTML w i + header + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain name" ] + , HH.th_ [ HH.text "" ] + , HH.th_ [ HH.text "" ] + ] + ] diff --git a/src/Utils.purs b/src/Utils.purs index 8a60268..450886b 100644 --- a/src/Utils.purs +++ b/src/Utils.purs @@ -21,3 +21,7 @@ remove_id i arr = case A.head arr of id :: forall a. a -> a id x = x + +not_empty_string :: String -> Maybe String +not_empty_string "" = Nothing +not_empty_string v = Just v