Administration page: can search for domains and see users' zones.
This commit is contained in:
parent
acf3f92dcd
commit
35ff1d1347
4 changed files with 85 additions and 50 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 "" ]
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue