Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

WIP: search for domains.

Browse source
This commit is contained in:
Philippe Pittoli 2025-05-07 04:17:38 +02:00
parent 6785540f9e
commit acf3f92dcd
3 changed files with 95 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/App/Container.purs
View file

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

9
src/App/Message/DNSManagerDaemon.purs
View file

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

113
src/App/Page/Administration.purs
View file

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