Admin: ask for orphan domain list.
parent
fdc6e0ec62
commit
2a430d1ec1
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue