Administration page now handles administration for both `authd` and `dnsmanagerd`.
parent
1b1c7e80c7
commit
c2e51dc964
|
|
@ -1,17 +1,19 @@
|
|||
{- Administration interface for the authentication daemon.
|
||||
This interface should allow to:
|
||||
- TODO: add, remove, search, validate users
|
||||
- TODO: raise a user to admin
|
||||
{- Administration interface.
|
||||
Allows to:
|
||||
- add, remove, search users
|
||||
- TODO: validate users
|
||||
- TODO: change user password
|
||||
- TODO: show user details (list of owned 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)
|
||||
Is this page should be used to provide `dnsmanager` administration?
|
||||
-}
|
||||
module App.AuthenticationDaemonAdminInterface where
|
||||
module App.AdministrationInterface where
|
||||
|
||||
import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=))
|
||||
|
||||
import Bulma as Bulma
|
||||
|
||||
import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
import Data.Array as A
|
||||
import Effect.Aff.Class (class MonadAff)
|
||||
|
|
@ -60,7 +60,7 @@ import App.RegistrationInterface as RI
|
|||
import App.MailValidationInterface as MVI
|
||||
import App.Log as AppLog
|
||||
import App.WS as WS
|
||||
import App.AuthenticationDaemonAdminInterface as AAI
|
||||
import App.AdministrationInterface as AdminI
|
||||
import App.DomainListInterface as DomainListInterface
|
||||
import App.ZoneInterface as ZoneInterface
|
||||
import App.HomeInterface as HomeInterface
|
||||
|
|
@ -78,10 +78,17 @@ import Web.Storage.Storage as Storage
|
|||
|
||||
import App.LogMessage (LogMessage(..))
|
||||
|
||||
-- | List all pages the application has:
|
||||
-- | Home, Login, Domain list, Zone, `authd` administration.
|
||||
-- | This list will grows in a near future.
|
||||
data Page = Home | Authentication | Registration | MailValidation | DomainList | Zone String | AuthAdmin
|
||||
-- | This list will grow in a near future.
|
||||
-- |
|
||||
-- | TODO:
|
||||
data Page
|
||||
= Home -- | `Home`: presentation of the project.
|
||||
| Authentication -- | `Authentication`: authentication page.
|
||||
| Registration -- | `Registration`: to register new people.
|
||||
| MailValidation -- | `MailValidation`: to validate email addresses (via a token).
|
||||
| DomainList -- | `DomainList`: to list owned domains and to ask for new domains.
|
||||
| Zone String -- | `Zone`: to manage a zone.
|
||||
| Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).
|
||||
|
||||
type Token = String
|
||||
type Login = String
|
||||
|
|
@ -99,15 +106,15 @@ data Action
|
|||
| MailValidationInterfaceEvent MVI.Output
|
||||
|
||||
-- | Handle events from `AuthenticationDaemonAdminComponent`.
|
||||
| AuthenticationDaemonAdminComponentEvent AAI.Output -- Admin interface for authd.
|
||||
| AdministrationEvent AdminI.Output -- Administration interface.
|
||||
|
||||
-- | Handle events from `DomainListComponent`.
|
||||
| DomainListComponentEvent DomainListInterface.Output
|
||||
|
||||
-- | Handle events from `AuthenticationDaemon`.
|
||||
-- | Handle events from `AuthenticationDaemon` (`authd websocket component`).
|
||||
| AuthenticationDaemonEvent WS.Output
|
||||
|
||||
-- | Handle events from `DNSManagerDaemon`.
|
||||
-- | Handle events from `DNSManagerDaemon` (`dnsmanagerd websocket component`).
|
||||
| DNSManagerDaemonEvent WS.Output
|
||||
|
||||
-- | Handle events from `ZoneInterface`.
|
||||
|
|
@ -156,12 +163,12 @@ data Action
|
|||
type State = { token :: Maybe String
|
||||
, current_page :: Page
|
||||
, store_DomainListInterface_state :: Maybe DomainListInterface.State
|
||||
, store_AuthenticationDaemonAdmin_state :: Maybe AAI.State
|
||||
, store_AuthenticationDaemonAdmin_state :: Maybe AdminI.State
|
||||
}
|
||||
|
||||
-- | The list of child components: log, `WS` twice (once for each ws connection),
|
||||
-- | then all the pages (AuthenticationInterface, RegistrationInterface, MailValidationInterface,
|
||||
-- | HomeInterface, DomainListInterface, ZoneInterface and AuthenticationDaemonAdminInterface).
|
||||
-- | HomeInterface, DomainListInterface, ZoneInterface and AdministrationInterface).
|
||||
type ChildSlots =
|
||||
( log :: AppLog.Slot Unit
|
||||
, ho :: HomeInterface.Slot Unit
|
||||
|
|
@ -170,7 +177,7 @@ type ChildSlots =
|
|||
, ai :: AI.Slot Unit
|
||||
, ri :: RI.Slot Unit
|
||||
, mvi :: MVI.Slot Unit
|
||||
, aai :: AAI.Slot Unit
|
||||
, admini :: AdminI.Slot Unit
|
||||
, dli :: DomainListInterface.Slot Unit
|
||||
, zi :: ZoneInterface.Slot Unit
|
||||
)
|
||||
|
|
@ -182,7 +189,7 @@ _ws_dns = Proxy :: Proxy "ws_dns" -- WS with `dnsmanagerd`
|
|||
_ai = Proxy :: Proxy "ai" -- Authentication Interface
|
||||
_ri = Proxy :: Proxy "ri" -- Registration Interface
|
||||
_mvi = Proxy :: Proxy "mvi" -- Mail Validation Interface
|
||||
_aai = Proxy :: Proxy "aai" -- Authd Administration Interface
|
||||
_admini = Proxy :: Proxy "admini" -- Administration Interface
|
||||
_dli = Proxy :: Proxy "dli" -- Domain List
|
||||
_zi = Proxy :: Proxy "zi" -- Zone Interface
|
||||
|
||||
|
|
@ -214,7 +221,7 @@ render state
|
|||
MailValidation -> render_mail_validation
|
||||
DomainList -> render_domainlist_interface
|
||||
Zone domain -> render_zone domain
|
||||
AuthAdmin -> render_authd_admin_interface
|
||||
Administration -> render_authd_admin_interface
|
||||
-- The footer includes logs and both the WS child components.
|
||||
, Bulma.columns_ [ Bulma.column_ [ render_logs ]
|
||||
, Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
|
||||
|
|
@ -234,7 +241,7 @@ render state
|
|||
render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_zone domain = HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent
|
||||
render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_authd_admin_interface = HH.slot _aai unit AAI.component unit AuthenticationDaemonAdminComponentEvent
|
||||
render_authd_admin_interface = HH.slot _admini unit AdminI.component unit AdministrationEvent
|
||||
|
||||
authenticated = case state.token of
|
||||
Nothing -> false
|
||||
|
|
@ -247,7 +254,7 @@ render state
|
|||
render_nav = Nav.netlibre_navbar authenticated admin
|
||||
(Routing Home)
|
||||
(Routing DomainList)
|
||||
(Routing AuthAdmin)
|
||||
(Routing Administration)
|
||||
(Routing Authentication)
|
||||
(Routing Registration)
|
||||
(Routing MailValidation)
|
||||
|
|
@ -280,7 +287,7 @@ handleAction = case _ of
|
|||
DomainList -> H.liftEffect $ Storage.setItem "current-page" "DomainList" sessionstorage
|
||||
Zone zone -> do _ <- H.liftEffect $ Storage.setItem "current-page" "Zone" sessionstorage
|
||||
H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage
|
||||
AuthAdmin -> H.liftEffect $ Storage.setItem "current-page" "AuthAdmin" sessionstorage
|
||||
Administration -> H.liftEffect $ Storage.setItem "current-page" "Administration" sessionstorage
|
||||
H.modify_ _ { current_page = page }
|
||||
|
||||
Log message -> H.tell _log unit $ AppLog.Log message
|
||||
|
|
@ -330,13 +337,13 @@ handleAction = case _ of
|
|||
MVI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
MVI.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
|
||||
AuthenticationDaemonAdminComponentEvent ev -> case ev of
|
||||
AAI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
AAI.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
AAI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
|
||||
AAI.AskState -> do
|
||||
AdministrationEvent ev -> case ev of
|
||||
AdminI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
AdminI.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
AdminI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
|
||||
AdminI.AskState -> do
|
||||
state <- H.get
|
||||
H.tell _aai unit (AAI.ProvideState state.store_AuthenticationDaemonAdmin_state)
|
||||
H.tell _admini unit (AdminI.ProvideState state.store_AuthenticationDaemonAdmin_state)
|
||||
|
||||
ZoneInterfaceEvent ev -> case ev of
|
||||
ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
|
||||
|
|
@ -353,13 +360,14 @@ handleAction = case _ of
|
|||
state <- H.get
|
||||
H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state)
|
||||
|
||||
-- | `authd websocket component` wants to do something.
|
||||
AuthenticationDaemonEvent ev -> case ev of
|
||||
WS.MessageReceived (Tuple _ message) -> do
|
||||
handleAction $ DecodeAuthMessage message
|
||||
|
||||
WS.WSJustConnected -> do
|
||||
H.tell _ai unit AI.ConnectionIsUp
|
||||
H.tell _aai unit AAI.ConnectionIsUp
|
||||
H.tell _admini unit AdminI.ConnectionIsUp
|
||||
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||
token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
|
||||
case token of
|
||||
|
|
@ -370,7 +378,7 @@ handleAction = case _ of
|
|||
|
||||
WS.WSJustClosed -> do
|
||||
H.tell _ai unit AI.ConnectionIsDown
|
||||
H.tell _aai unit AAI.ConnectionIsDown
|
||||
H.tell _admini unit AdminI.ConnectionIsDown
|
||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
WS.KeepAlive -> handleAction $ KeepAlive $ Left unit
|
||||
|
||||
|
|
@ -418,13 +426,13 @@ handleAction = case _ of
|
|||
m@(AuthD.GotMatchingUsers _) -> do
|
||||
{ current_page } <- H.get
|
||||
case current_page of
|
||||
AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m
|
||||
Administration -> handleAction $ DispatchAuthDaemonMessage m
|
||||
_ -> handleAction $ Log $ SimpleLog
|
||||
"[😈] received a GotMatchingUsers message while not on authd admin page."
|
||||
m@(AuthD.GotUserDeleted _) -> do
|
||||
{ current_page } <- H.get
|
||||
case current_page of
|
||||
AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m
|
||||
Administration -> handleAction $ DispatchAuthDaemonMessage m
|
||||
_ -> handleAction $ Log $ SimpleLog
|
||||
"[😈] received a GotUserDeleted message while not on authd admin page."
|
||||
(AuthD.GotErrorMustBeAuthenticated _) -> do
|
||||
|
|
@ -480,7 +488,7 @@ handleAction = case _ of
|
|||
DispatchAuthDaemonMessage message -> do
|
||||
{ current_page } <- H.get
|
||||
case current_page of
|
||||
AuthAdmin -> H.tell _aai unit (AAI.MessageReceived message)
|
||||
Administration -> H.tell _admini unit (AdminI.MessageReceived message)
|
||||
_ -> handleAction $ Log $ SystemLog "unexpected message from authd"
|
||||
pure unit
|
||||
|
||||
|
|
@ -491,7 +499,7 @@ handleAction = case _ of
|
|||
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||
H.liftEffect $ Storage.clear sessionstorage
|
||||
|
||||
-- TODO: depending on the current page, we should provide the received message to different components.
|
||||
-- | `dnsmanagerd websocket component` wants to do something.
|
||||
DNSManagerDaemonEvent ev -> case ev of
|
||||
WS.MessageReceived (Tuple _ message) -> do
|
||||
handleAction $ DecodeDNSMessage message
|
||||
|
|
@ -629,7 +637,7 @@ handleAction = case _ of
|
|||
Just "Registration" -> handleAction $ Routing Registration
|
||||
Just "DomainList" -> handleAction $ Routing DomainList
|
||||
Just "MailValidation" -> handleAction $ Routing MailValidation
|
||||
Just "AuthAdmin" -> handleAction $ Routing AuthAdmin
|
||||
Just "Administration" -> handleAction $ Routing Administration
|
||||
Just "Zone" -> do
|
||||
domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage
|
||||
case domain of
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ import Bulma as Bulma
|
|||
-- | `admin` (is the user an administrator)
|
||||
-- | `actionHome` (the action to get to the home page)
|
||||
-- | `actionDomainList` (the action to get to the domain list page)
|
||||
-- | `actionAuthdAdmin` (the action to get to the administration page)
|
||||
-- | `actionAdmin` (the action to get to the administration page)
|
||||
-- | `_` (not used parameter)
|
||||
-- | `actionLogin` (the action to get to the login page)
|
||||
-- | `actionDisconnection` (the action to disconnect the user)
|
||||
|
|
@ -22,7 +22,7 @@ import Bulma as Bulma
|
|||
-- | TODO: make the "burger" component actually useful. For now, it's empty.
|
||||
netlibre_navbar :: forall w i. Boolean -> Boolean -> i -> i -> i -> i -> i -> i -> i -> HH.HTML w i
|
||||
netlibre_navbar authenticated admin
|
||||
actionHome actionDomainList actionAuthdAdmin
|
||||
actionHome actionDomainList actionAdmin
|
||||
actionLogin actionRegistration actionMailValidation actionDisconnection =
|
||||
main_nav
|
||||
[ nav_brand [ logo, burger_menu ]
|
||||
|
|
@ -68,7 +68,7 @@ netlibre_navbar authenticated admin
|
|||
navbar_end = HH.div [HP.classes C.navbar_end]
|
||||
link_home = nav_button C.is_info "Home" actionHome
|
||||
link_domains = nav_button C.is_info "Domains" actionDomainList
|
||||
link_authd_admin = nav_button C.is_info "Authd Admin" actionAuthdAdmin
|
||||
link_authd_admin = nav_button C.is_info "Admin" actionAdmin
|
||||
nav_button_disconnection = nav_button C.is_danger "Disconnection" actionDisconnection
|
||||
--dropdown title dropdown_elements
|
||||
-- = HH.div [HP.classes (C.navbar_item <> C.has_dropdown <> C.is_hoverable)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue