From 2a430d1ec18e0883298dd887760c7e1b5afcd3dc Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 17 Mar 2024 03:23:22 +0100 Subject: [PATCH] Admin: ask for orphan domain list. --- src/App/Container.purs | 7 ++- src/App/Message/DNSManagerDaemon.purs | 14 ++++++ src/App/Page/Administration.purs | 64 ++++++++++++++++++++++----- 3 files changed, 72 insertions(+), 13 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index b94a740..cf8c4ce 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -412,7 +412,9 @@ 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) - + AdminInterface.GetOrphanDomains -> do + message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {} + H.tell _ws_dns unit (WS.ToSend message) ZoneInterfaceEvent ev -> case ev of ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) @@ -680,6 +682,9 @@ handleAction = case _ of handleAction $ Log $ ErrorLog $ "Invalid resource record: " <> A.intercalate ", " response.errors (DNSManager.MkSuccess _) -> do handleAction $ Log $ SuccessLog $ "(generic) Success!" + DNSManager.MkOrphanDomainList response -> do + handleAction $ Log $ SuccessLog "Received orphan domain list." + H.tell _admini unit (AdminInterface.GotOrphanDomainList 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 8653013..924e3fb 100644 --- a/src/App/Message/DNSManagerDaemon.purs +++ b/src/App/Message/DNSManagerDaemon.purs @@ -39,6 +39,11 @@ type DeleteUser = { user_id :: Maybe Int } codecDeleteUser ∷ CA.JsonCodec DeleteUser codecDeleteUser = CA.object "DeleteUser" (CAR.record { user_id: CAR.optional CA.int }) +{- 6 -} +type GetOrphanDomains = { } +codecGetOrphanDomains ∷ CA.JsonCodec GetOrphanDomains +codecGetOrphanDomains = CA.object "GetOrphanDomains" (CAR.record { }) + {- 7 -} type Maintenance = { subject :: MaintenanceSubject.MaintenanceSubject , int :: Maybe Int @@ -245,6 +250,11 @@ type GeneratedZoneFile = { domain :: String, zonefile :: String } codecGeneratedZoneFile ∷ CA.JsonCodec GeneratedZoneFile codecGeneratedZoneFile = CA.object "GeneratedZoneFile" (CAR.record { domain: CA.string, zonefile: CA.string }) +{- 24 -} +type OrphanDomainList = { domains :: Array String } +codecOrphanDomainList ∷ CA.JsonCodec OrphanDomainList +codecOrphanDomainList = CA.object "OrphanDomainList" (CAR.record { domains: CA.array CA.string }) + {- 50 -} type UnknownUser = { } codecUnknownUser ∷ CA.JsonCodec UnknownUser @@ -270,6 +280,7 @@ codecInsufficientRights = CA.object "InsufficientRights" (CAR.record { }) data RequestMessage = MkLogin Login -- 0 | MkDeleteUser DeleteUser -- 1 + | MkGetOrphanDomains GetOrphanDomains -- 6 | MkMaintenance Maintenance -- 7 | MkNewDomain NewDomain -- 9 | MkDeleteDomain DeleteDomain -- 10 @@ -312,6 +323,7 @@ data AnswerMessage | MkRRUpdated RRUpdated -- 21 | MkRRReadOnly RRReadOnly -- 22 | MkGeneratedZoneFile GeneratedZoneFile -- 23 + | MkOrphanDomainList OrphanDomainList -- 24 | MkUnknownUser UnknownUser -- 50 | MkNoOwnership NoOwnership -- 51 | MkInsufficientRights InsufficientRights -- 52 @@ -321,6 +333,7 @@ encode ∷ RequestMessage -> Tuple UInt String encode m = case m of (MkLogin request) -> get_tuple 0 codecLogin request (MkDeleteUser request) -> get_tuple 1 codecDeleteUser request + (MkGetOrphanDomains request) -> get_tuple 6 codecGetOrphanDomains request (MkMaintenance request) -> get_tuple 7 codecMaintenance request (MkNewDomain request) -> get_tuple 9 codecNewDomain request (MkDeleteDomain request) -> get_tuple 10 codecDeleteDomain request @@ -372,6 +385,7 @@ decode number string 21 -> error_management codecRRUpdated MkRRUpdated 22 -> error_management codecRRReadOnly MkRRReadOnly 23 -> error_management codecGeneratedZoneFile MkGeneratedZoneFile + 24 -> error_management codecOrphanDomainList MkOrphanDomainList 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 9097ca6..3622f9a 100644 --- a/src/App/Page/Administration.purs +++ b/src/App/Page/Administration.purs @@ -47,11 +47,16 @@ data Output | AskState | StoreState State | DeleteUserAccount Int + | GetOrphanDomains + + --| DeleteDomain String + --| RequestDomain String data Query a = MessageReceived AuthD.AnswerMessage a | ConnectionIsDown a | ConnectionIsUp a + | GotOrphanDomainList (Array String) a | ProvideState (Maybe State) a type Slot = H.Slot Query Output @@ -76,6 +81,11 @@ data Action | ShowUser Int | RemoveUser Int + -- Domains. + | ShowOrphanDomains + | RemoveDomain String + | ShowDomain String + -- | Change the displayed tab. | ChangeTab Tab @@ -84,7 +94,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 | Search | Add +data Tab = Home | Search | Add | OrphanDomains derive instance eqTab :: Eq Tab type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String } @@ -96,6 +106,7 @@ type State = , current_tab :: Tab , wsUp :: Boolean , matching_users :: Array UserPublic + , orphan_domains :: Array String } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -115,12 +126,13 @@ initialState :: Input -> State initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "" } , searchUserForm: { regex: "" {-, admin: false, domain: "" -} } , matching_users: [] + , orphan_domains: [] , current_tab: Home , wsUp: true } render :: forall m. State -> H.ComponentHTML Action () m -render { addUserForm, searchUserForm, matching_users, current_tab, wsUp } +render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains, wsUp } = Bulma.section_small [ fancy_tab_bar , case current_tab of @@ -131,13 +143,18 @@ render { addUserForm, searchUserForm, matching_users, current_tab, wsUp } ] Add -> Bulma.columns_ [ Bulma.column (C.is 5) [Bulma.article (Bulma.p "Add a new user") render_adduser_form] ] + OrphanDomains -> HH.div_ + [ Bulma.btn_ (C.is_small) "Get orphan domains" ShowOrphanDomains + , show_orphan_domains + ] ] where fancy_tab_bar = Bulma.fancy_tabs - [ Bulma.tab_entry (is_tab_active Home) "Home" (ChangeTab Home) - , Bulma.tab_entry (is_tab_active Search) "Search" (ChangeTab Search) - , Bulma.tab_entry (is_tab_active Add) "Add" (ChangeTab Add) + [ Bulma.tab_entry (is_tab_active Home) "Home" (ChangeTab Home) + , Bulma.tab_entry (is_tab_active Search) "Search" (ChangeTab Search) + , Bulma.tab_entry (is_tab_active Add) "Add" (ChangeTab Add) + , Bulma.tab_entry (is_tab_active OrphanDomains) "OrphanDomains" (ChangeTab OrphanDomains) ] is_tab_active tab = current_tab == tab @@ -145,6 +162,10 @@ render { addUserForm, searchUserForm, matching_users, current_tab, wsUp } user_card user = HH.li_ [ Bulma.btn_delete (RemoveUser user.uid) , Bulma.btn_ (C.is_small) user.login (ShowUser user.uid) ] + show_orphan_domains = Bulma.box [ HH.ul_ $ map domain_entry orphan_domains ] + domain_entry domain = HH.li_ [ Bulma.btn_delete (RemoveDomain domain) + , Bulma.btn_ (C.is_small) domain (ShowDomain domain) + ] up x = HandleAddUserInput <<< x active = (if wsUp then (HP.enabled true) else (HP.disabled true)) @@ -182,10 +203,11 @@ handleAction = case _ of case old_tab of Nothing -> H.raise $ Log $ ErrorLog "We hadn't changed tab before reload apparently." Just current_tab -> case current_tab of - "Home" -> handleAction $ ChangeTab Home - "Search" -> handleAction $ ChangeTab Search - "Add" -> handleAction $ ChangeTab Add - _ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab + "Home" -> handleAction $ ChangeTab Home + "Search" -> handleAction $ ChangeTab Search + "Add" -> handleAction $ ChangeTab Add + "OrphanDomains" -> handleAction $ ChangeTab OrphanDomains + _ -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab Finalize -> do state <- H.get @@ -205,10 +227,22 @@ handleAction = case _ of ShowUser uid -> do H.raise $ Log $ SystemLog $ "Show a user details (uid: " <> show uid <> ")" + ShowOrphanDomains -> do + H.raise $ Log $ SystemLog $ "Get orphan domains" + H.raise $ GetOrphanDomains + RemoveUser 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 + + ShowDomain domain -> do + H.raise $ Log $ SystemLog $ "TODO: show domain " <> domain + -- H.raise $ RequestDomain domain + AddUserAttempt -> do { addUserForm } <- H.get let login = addUserForm.login @@ -233,9 +267,10 @@ handleAction = case _ of -- 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 - Search -> H.liftEffect $ Storage.setItem "current-ada-tab" "Search" sessionstorage - Add -> H.liftEffect $ Storage.setItem "current-ada-tab" "Add" sessionstorage + Home -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home" sessionstorage + Search -> H.liftEffect $ Storage.setItem "current-ada-tab" "Search" 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 } SearchUserAttempt -> do @@ -288,3 +323,8 @@ handleQuery = case _ of ConnectionIsUp a -> do H.modify_ _ { wsUp = true } pure (Just a) + + GotOrphanDomainList domains a -> do + H.raise $ Log $ SuccessLog "Got orphan domain list!" + H.modify_ _ { orphan_domains = domains } + pure (Just a)