Display the login. Can be improved.
This commit is contained in:
parent
95be116d07
commit
c0a1d2000f
@ -182,6 +182,7 @@ type State = { token :: Maybe String
|
|||||||
, store_DomainListInterface_state :: Maybe DomainListInterface.State
|
, store_DomainListInterface_state :: Maybe DomainListInterface.State
|
||||||
, store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
|
, store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
|
||||||
, notif :: Notification
|
, notif :: Notification
|
||||||
|
, login :: Maybe String
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | 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),
|
||||||
@ -232,6 +233,7 @@ initialState _ = { token: Nothing
|
|||||||
, store_DomainListInterface_state: Nothing
|
, store_DomainListInterface_state: Nothing
|
||||||
, store_AuthenticationDaemonAdmin_state: Nothing
|
, store_AuthenticationDaemonAdmin_state: Nothing
|
||||||
, notif: NoNotification
|
, notif: NoNotification
|
||||||
|
, login: Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
|
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
|
||||||
@ -239,10 +241,8 @@ render state
|
|||||||
= HH.div_ $
|
= HH.div_ $
|
||||||
[ render_header
|
[ render_header
|
||||||
, render_nav
|
, render_nav
|
||||||
, case state.notif of
|
, Bulma.columns_ [ Bulma.column_ [ render_login ]
|
||||||
NoNotification -> HH.div_ []
|
, Bulma.column_ [ render_notifications ] ]
|
||||||
GoodNotification v -> Bulma.box [Bulma.notification_success v CloseNotif]
|
|
||||||
BadNotification v -> Bulma.box [Bulma.notification_danger v CloseNotif]
|
|
||||||
, case state.current_page of
|
, case state.current_page of
|
||||||
Home -> render_home
|
Home -> render_home
|
||||||
Authentication -> render_auth_form
|
Authentication -> render_auth_form
|
||||||
@ -258,6 +258,13 @@ render state
|
|||||||
, Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
|
, Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
render_notifications =
|
||||||
|
case state.notif of
|
||||||
|
NoNotification -> HH.div_ []
|
||||||
|
GoodNotification v -> Bulma.box [Bulma.notification_success v CloseNotif]
|
||||||
|
BadNotification v -> Bulma.box [Bulma.notification_danger v CloseNotif]
|
||||||
|
|
||||||
|
render_login = maybe (Bulma.p "") (\l -> Bulma.box [ Bulma.p $ "You are connected as: " <> l]) state.login
|
||||||
|
|
||||||
render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||||
render_home = HH.slot_ _ho unit HomeInterface.component unit
|
render_home = HH.slot_ _ho unit HomeInterface.component unit
|
||||||
@ -396,6 +403,7 @@ handleAction = case _ of
|
|||||||
|
|
||||||
AI.AuthenticateToAuthd v -> handleAction $ AuthenticateToAuthd (Right v)
|
AI.AuthenticateToAuthd v -> handleAction $ AuthenticateToAuthd (Right v)
|
||||||
AI.Log message -> handleAction $ Log message
|
AI.Log message -> handleAction $ Log message
|
||||||
|
AI.UserLogin login -> H.modify_ _ { login = Just login }
|
||||||
|
|
||||||
RegistrationInterfaceEvent ev -> case ev of
|
RegistrationInterfaceEvent ev -> case ev of
|
||||||
RI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
RI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||||
|
@ -52,6 +52,7 @@ data Output
|
|||||||
= MessageToSend ArrayBuffer
|
= MessageToSend ArrayBuffer
|
||||||
| AuthenticateToAuthd (Tuple Login Password)
|
| AuthenticateToAuthd (Tuple Login Password)
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
|
| UserLogin String
|
||||||
| PasswordRecovery Login PasswordRecoveryToken Password
|
| PasswordRecovery Login PasswordRecoveryToken Password
|
||||||
| AskPasswordRecovery (Either Email Login)
|
| AskPasswordRecovery (Either Email Login)
|
||||||
|
|
||||||
@ -305,6 +306,7 @@ handleAction = case _ of
|
|||||||
{ authenticationForm } <- H.get
|
{ authenticationForm } <- H.get
|
||||||
let { login, pass } = authenticationForm
|
let { login, pass } = authenticationForm
|
||||||
|
|
||||||
|
H.raise $ UserLogin login
|
||||||
case login, pass of
|
case login, pass of
|
||||||
"" , _ ->
|
"" , _ ->
|
||||||
H.raise $ Log $ UnableToSend "Write your login!"
|
H.raise $ Log $ UnableToSend "Write your login!"
|
||||||
|
@ -632,6 +632,7 @@ handleAction = case _ of
|
|||||||
AddRR t newrr -> do
|
AddRR t newrr -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.raise $ Log $ SystemLog $ "Add new " <> show t
|
H.raise $ Log $ SystemLog $ "Add new " <> show t
|
||||||
|
H.modify_ _ { _zonefile = Nothing }
|
||||||
message <- H.liftEffect
|
message <- H.liftEffect
|
||||||
$ DNSManager.serialize
|
$ DNSManager.serialize
|
||||||
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
|
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
|
||||||
@ -665,6 +666,7 @@ handleAction = case _ of
|
|||||||
SaveRR rr -> do
|
SaveRR rr -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.raise $ Log $ SystemLog $ "Updating RR " <> show rr.rrid
|
H.raise $ Log $ SystemLog $ "Updating RR " <> show rr.rrid
|
||||||
|
H.modify_ _ { _zonefile = Nothing }
|
||||||
message <- H.liftEffect
|
message <- H.liftEffect
|
||||||
$ DNSManager.serialize
|
$ DNSManager.serialize
|
||||||
$ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
|
$ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
|
||||||
@ -673,6 +675,7 @@ handleAction = case _ of
|
|||||||
RemoveRR rr_id -> do
|
RemoveRR rr_id -> do
|
||||||
{ _domain } <- H.get
|
{ _domain } <- H.get
|
||||||
H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
|
H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
|
||||||
|
H.modify_ _ { _zonefile = Nothing }
|
||||||
-- Send a removal message.
|
-- Send a removal message.
|
||||||
message <- H.liftEffect
|
message <- H.liftEffect
|
||||||
$ DNSManager.serialize
|
$ DNSManager.serialize
|
||||||
|
Loading…
Reference in New Issue
Block a user