karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Admin: ask for orphan domain list.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-03-17 03:23:22 +01:00
parent fdc6e0ec62
commit 2a430d1ec1
3 changed files with 72 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/App/Container.purs
View File

@ -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

14
src/App/Message/DNSManagerDaemon.purs
View File

@ -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

64
src/App/Page/Administration.purs
View File

@ -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)