diff --git a/src/App/Container.purs b/src/App/Container.purs index fe1bebe..442aa7d 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -799,7 +799,6 @@ handleAction = case _ of (AuthD.GotKeepAlive _) -> pure unit pure unit - -- TODO EventPageMigration ev -> case ev of PageMigration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) PageMigration.Log message -> handleAction $ Log message @@ -963,6 +962,9 @@ handleAction = case _ of DNSManager.MkOrphanDomainList response -> do handleAction $ Log $ SuccessLog "Received orphan domain list." H.tell _admini unit (PageAdministration.GotOrphanDomainList response.domains) + DNSManager.MkFoundDomains response -> do + handleAction $ Log $ SuccessLog "Received found domain list." + H.tell _admini unit (PageAdministration.GotFoundDomains response.domains) (DNSManager.GotKeepAlive _) -> do -- handleAction $ Log $ SystemLog $ "KeepAlive." pure unit diff --git a/src/App/Message/DNSManagerDaemon.purs b/src/App/Message/DNSManagerDaemon.purs index 2523e26..5a28dc0 100644 --- a/src/App/Message/DNSManagerDaemon.purs +++ b/src/App/Message/DNSManagerDaemon.purs @@ -128,6 +128,11 @@ type GainOwnership = { uuid :: String } codecGainOwnership ∷ CA.JsonCodec GainOwnership codecGainOwnership = CA.object "GainOwnership" (CAR.record { uuid: CA.string }) +{- 24 -} +type SearchDomain = { domain :: String, offset :: Maybe Int } +codecSearchDomain ∷ CA.JsonCodec SearchDomain +codecSearchDomain = CA.object "SearchDomain" (CAR.record { domain: CA.string, offset: CAR.optional CA.int }) + {- 100 -} type GenerateAllZoneFiles = {} codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles @@ -322,6 +327,7 @@ data RequestMessage | MkAskTransferToken AskTransferToken -- 21 | MkAskUnShareDomain AskUnShareDomain -- 22 | MkGainOwnership GainOwnership -- 23 + | MkSearchDomain SearchDomain -- 24 | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100 | MkGenerateZoneFile GenerateZoneFile -- 101 | MkKeepAlive KeepAlive -- 250 @@ -353,6 +359,7 @@ data AnswerMessage | MkRRReadOnly RRReadOnly -- 22 | MkGeneratedZoneFile GeneratedZoneFile -- 23 | MkOrphanDomainList OrphanDomainList -- 24 + | MkFoundDomains DomainList -- 25 | MkUnknownUser UnknownUser -- 50 | MkNoOwnership NoOwnership -- 51 | MkInsufficientRights InsufficientRights -- 52 @@ -379,6 +386,7 @@ encode m = case m of (MkAskTransferToken request) -> get_tuple 21 codecAskTransferToken request (MkAskUnShareDomain request) -> get_tuple 22 codecAskUnShareDomain request (MkGainOwnership request) -> get_tuple 23 codecGainOwnership request + (MkSearchDomain request) -> get_tuple 24 codecSearchDomain request (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request (MkGenerateZoneFile request) -> get_tuple 101 codecGenerateZoneFile request (MkKeepAlive request) -> get_tuple 250 codecKeepAlive request @@ -419,6 +427,7 @@ decode number string 22 -> error_management codecRRReadOnly MkRRReadOnly 23 -> error_management codecGeneratedZoneFile MkGeneratedZoneFile 24 -> error_management codecOrphanDomainList MkOrphanDomainList + 25 -> error_management codecDomainList MkFoundDomains 50 -> error_management codecUnknownUser MkUnknownUser 51 -> error_management codecNoOwnership MkNoOwnership 52 -> error_management codecInsufficientRights MkInsufficientRights diff --git a/src/App/Page/Administration.purs b/src/App/Page/Administration.purs index a11e8eb..69b9e7f 100644 --- a/src/App/Page/Administration.purs +++ b/src/App/Page/Administration.purs @@ -1,9 +1,10 @@ {- Administration interface. Enables to: - - add, remove, search users + - add, remove, search for users - TODO: validate users - TODO: change user password - TODO: show user details (list of owned domains) + - TODO: search for domains - TODO: show user domain details (zone content) and to modify users' zone - TODO: raise a user to admin (and vice versa) - TODO: list users (getting them slowly, otherwise it will cause problems with thousands of logins) @@ -37,7 +38,7 @@ import App.Type.LogMessage -- import App.IPC as IPC import App.Type.Email as Email --- import App.Message.DNSManagerDaemon as DNSManager +import App.Message.DNSManagerDaemon as DNSManager import App.Message.AuthenticationDaemon as AuthD data Output @@ -54,6 +55,7 @@ data Output data Query a = MessageReceived AuthD.AnswerMessage a | GotOrphanDomainList (Array String) a + | GotFoundDomains (Array String) a | ProvideState (Maybe State) a type Slot = H.Slot Query Output @@ -65,14 +67,22 @@ data AddUserInput | ADDUSER_INP_email String | ADDUSER_toggle_admin | ADDUSER_INP_pass String - | SEARCHUSER_INP_regex String - --| SEARCHUSER_INP_domain String + +data SearchUserInput + = SEARCHUSER_INP_regex String + --| SEARCHUSER_toggle_admin Boolean + +data SearchDomainInput + = SEARCHDOMAIN_INP_domain String data Action - = HandleAddUserInput AddUserInput + = ActionOnAddUserForm AddUserInput + | ActionOnSearchUserForm SearchUserInput + | ActionOnSearchDomainForm SearchDomainInput | AddUserAttempt | SearchUserAttempt + | SearchDomainAttempt | PreventSubmit Event | ShowUser Int @@ -91,17 +101,20 @@ 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 | Search | Add | OrphanDomains +data Tab = Home | SearchUser | SearchDomain | Add | OrphanDomains derive instance eqTab :: Eq Tab type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String } -type StateSearchUserForm = { regex :: String {-, admin :: Boolean, domain :: String -} } +type StateSearchUserForm = { regex :: String {- , admin :: Boolean -} } +type StateSearchDomainForm = { domain :: String } type State = { addUserForm :: StateAddUserForm , searchUserForm :: StateSearchUserForm + , searchDomainForm :: StateSearchDomainForm , current_tab :: Tab , matching_users :: Array UserPublic + , matching_domains :: Array String , orphan_domains :: Array String } @@ -120,22 +133,30 @@ component = initialState :: Input -> State initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "" } - , searchUserForm: { regex: "" {-, admin: false, domain: "" -} } + , searchUserForm: { regex: "" {- , admin: false -} } + , searchDomainForm: { domain: "" } , matching_users: [] + , matching_domains: [] , orphan_domains: [] , current_tab: Home } render :: forall m. State -> H.ComponentHTML Action () m -render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains } +render { addUserForm, searchUserForm, searchDomainForm + , matching_users, matching_domains + , current_tab, orphan_domains } = Web.section_small [ fancy_tab_bar , case current_tab of Home -> Web.h3 "Select an action" - Search -> Web.columns_ + 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 ] ] + 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 ] + ] Add -> Web.columns_ [ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ] OrphanDomains -> HH.div_ @@ -147,7 +168,8 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain fancy_tab_bar = Web.fancy_tabs [ Web.tab_entry (is_tab_active Home) "Home" (ChangeTab Home) - , Web.tab_entry (is_tab_active Search) "Search" (ChangeTab Search) + , 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) ] @@ -157,19 +179,24 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain 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) ] - up x = HandleAddUserInput <<< x render_adduser_form = HH.form [ HE.onSubmit PreventSubmit ] - [ Web.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login - , Web.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin) - , Web.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email - , Web.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass + [ Web.box_input "login" "User login" "login" (ActionOnAddUserForm <<< ADDUSER_INP_login) addUserForm.login + , Web.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (ActionOnAddUserForm ADDUSER_toggle_admin) + , Web.box_input "email" "User email" "email" (ActionOnAddUserForm <<< ADDUSER_INP_email) addUserForm.email + , Web.box_password "password" "User password" "password" (ActionOnAddUserForm <<< ADDUSER_INP_pass) addUserForm.pass , Web.btn "Send" AddUserAttempt ] @@ -180,14 +207,21 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain Following input accepts any regex. This is used to search for a user based on their login, full name or email address. """ - , Web.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex + , Web.box_input "regex" "Regex" "regex" (ActionOnSearchUserForm <<< SEARCHUSER_INP_regex) searchUserForm.regex --, Web.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin) - -- (HandleAddUserInput SEARCHUSER_toggle_admin) - --, Web.box_input "domain" "Domain owned" "blah.netlib.re." - -- (up SEARCHUSER_INP_domain) searchUserForm.domain + -- (ActionOnSearchUserForm <<< SEARCHUSER_toggle_admin) , Web.btn "Send" SearchUserAttempt ] + render_searchdomain_form = + HH.form + [ HE.onSubmit PreventSubmit ] + [ Web.p "Following input accepts any regex to search for a domain." + , Web.box_input "domain" "Domain owned" "blah.netlib.re." + (ActionOnSearchDomainForm <<< SEARCHDOMAIN_INP_domain) searchDomainForm.domain + , Web.btn "Send" SearchDomainAttempt + ] + handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction = case _ of Initialize -> do @@ -198,7 +232,8 @@ handleAction = case _ of Nothing -> pure unit Just current_tab -> case current_tab of "Home" -> handleAction $ ChangeTab Home - "Search" -> handleAction $ ChangeTab Search + "SearchUser" -> handleAction $ ChangeTab SearchUser + "SearchDomain" -> handleAction $ ChangeTab SearchDomain "Add" -> handleAction $ ChangeTab Add "OrphanDomains" -> handleAction $ ChangeTab OrphanDomains _ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab @@ -207,14 +242,21 @@ handleAction = case _ of state <- H.get H.raise $ StoreState state - HandleAddUserInput adduserinp -> do + 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 } } - SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex = 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 } } + + ActionOnSearchDomainForm searchdomaininp -> do + case searchdomaininp of + SEARCHDOMAIN_INP_domain v -> H.modify_ _ { searchDomainForm { domain = v } } PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev @@ -262,7 +304,8 @@ handleAction = case _ of sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window _ <- case current_tab of Home -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home" sessionstorage - Search -> H.liftEffect $ Storage.setItem "current-ada-tab" "Search" 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 H.modify_ _ { current_tab = current_tab } @@ -270,13 +313,19 @@ handleAction = case _ of SearchUserAttempt -> do { searchUserForm } <- H.get let regex = searchUserForm.regex - -- domain = searchUserForm.domain - -- admin = searchUserForm.admin ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 } H.raise $ MessageToSend ab 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 $ MessageToSend ab + H.modify_ _ { matching_domains = [] } + not_empty_string :: String -> Maybe String not_empty_string "" = Nothing not_empty_string v = Just v @@ -312,3 +361,7 @@ handleQuery = case _ of GotOrphanDomainList domains a -> do H.modify_ _ { orphan_domains = domains } pure (Just a) + + GotFoundDomains domains a -> do + H.modify_ _ { matching_domains = domains } + pure (Just a)