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