Legal notice and automatic scroll when changing page.

caa
Philippe Pittoli 2024-11-15 01:22:22 +01:00
parent db2f64cc80
commit e7867bf80f
5 changed files with 34 additions and 15 deletions

View File

@ -78,6 +78,8 @@ import App.Page.Zone as ZoneInterface
import App.Page.Home as HomeInterface
import App.Page.Navigation as NavigationInterface
import App.Text.Explanations as Explanations
import Web.HTML (window) as HTML
import Web.HTML.Window (sessionStorage) as Window
import Web.Storage.Storage as Storage
@ -276,12 +278,15 @@ render state
Zone domain -> render_zone domain
Setup -> render_setup
Administration -> render_authd_admin_interface
LegalNotice -> render_legal_notice
-- The footer includes logs and both the WS child components.
, Bulma.hr
, Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails 😅)", render_logs ]
, Bulma.column_ [ Bulma.level [ render_auth_WS, render_dnsmanager_WS ] [] ] ]
, Bulma.column_ [ Bulma.level [render_auth_WS, render_dnsmanager_WS, legal_notice_btn] [] ]
]
]
where
legal_notice_btn = Bulma.btn_ [] "Legal notice" (Routing LegalNotice)
reconnection_bar :: forall w. HH.HTML w Action
reconnection_bar =
if (state.are_we_connected_to_authd && state.are_we_connected_to_dnsmanagerd)
@ -318,6 +323,12 @@ render state
render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_authd_admin_interface = HH.slot _admini unit AdminInterface.component unit AdministrationEvent
render_legal_notice :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_legal_notice
= Bulma.section_small [ Explanations.legal_notice
, Bulma.btn_ C.is_large "Home page" (Routing Home)
]
render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_nav = HH.slot _nav unit NavigationInterface.component unit NavigationInterfaceEvent
@ -357,6 +368,7 @@ handleAction = case _ of
-- Each time the user change load a new page, the counter gets reset
-- since it proves they are still active.
H.modify_ _ { keepalive_counter = 0 }
H.liftEffect scrollToTop
-- Store the current page we are on and restore it when we reload.
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
H.liftEffect $ Storage.setItem "current-page" (case page of
@ -916,6 +928,7 @@ handleAction = case _ of
Just "MailValidation" -> handleAction $ Routing MailValidation
Just "Setup" -> handleAction $ Routing Setup
Just "Administration" -> handleAction $ Routing Administration
Just "LegalNotice" -> handleAction $ Routing LegalNotice
Just "Zone" -> do
domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage
case domain of

View File

@ -51,8 +51,7 @@ render _ = HH.div_
Les comptes migrés sont conservés 6 mois, puis supprimés si aucune connexion n'est faite,
afin de purger un certain nombre de vieux comptes de robots.
"""
, HH.a [HP.classes (C.button <> C.is_info), HP.href url_linuxfr]
[ HH.text "Cliquez ici pour en savoir plus." ]
, Bulma.outside_link (C.button <> C.is_info) url_linuxfr "Cliquez ici pour en savoir plus."
]
, Bulma.section_small
[ Bulma.h1 "Welcome to netlib.re"

View File

@ -26,6 +26,8 @@ import App.Message.AuthenticationDaemon as AuthD
import App.DisplayErrors (show_error_login, show_error_email, show_error_password)
import Scroll (scrollToTop)
import App.Validation.Login as L
import App.Validation.Email as E
import App.Validation.Password as P
@ -141,7 +143,7 @@ render { registrationForm }
_, Left errors -> [ Bulma.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ]
_, Right _ -> []
legal_mentions = [ Explanations.legal_mentions
legal_mentions = [ Explanations.legal_notice
, Bulma.checkbox
[HH.text "I have read and accept the terms of service and privacy policy."]
LegalCheckboxToggle
@ -160,10 +162,6 @@ handleAction = case _ of
LegalCheckboxToggle -> do
{ registrationForm } <- H.get
H.modify_ _ { registrationForm { checked = not registrationForm.checked } }
state <- H.get
if state.registrationForm.checked
then H.raise $ Log $ SystemLog "HE DID THE THING."
else H.raise $ Log $ SystemLog "Oh noes, you have to accept this stuff! :("
-- Validate inputs (login, email, password) then send the request
-- (via SendRegistrationRequest) or log errors.
@ -174,18 +172,26 @@ handleAction = case _ of
let login = registrationForm.login
email = registrationForm.email
pass = registrationForm.pass
check = registrationForm.checked
case login, email, pass of
"", _, _ ->
case login, email, pass, check of
"", _, _, _ -> do
H.raise $ Log $ UnableToSend "Please, write your login."
H.liftEffect scrollToTop
_, "", _ ->
_, "", _, _ -> do
H.raise $ Log $ UnableToSend "Please, write your email."
H.liftEffect scrollToTop
_, _, "" ->
_, _, "", _ -> do
H.raise $ Log $ UnableToSend "Please, write your password."
H.liftEffect scrollToTop
_, _, _ -> do
_, _, _, false -> do
H.raise $ Log $ UnableToSend "Please, accept the terms of service."
H.liftEffect scrollToTop
_, _, _, _ -> do
case L.login login, E.email email, P.password pass of
Left errors, _, _ -> H.raise $ Log $ UnableToSend $ show_error $ Login errors
_, Left errors, _ -> H.raise $ Log $ UnableToSend $ show_error $ Email errors

View File

@ -482,8 +482,8 @@ srv_introduction =
]
]
legal_mentions :: forall w i. HH.HTML w i
legal_mentions = HH.div_
legal_notice :: forall w i. HH.HTML w i
legal_notice = HH.div_
[ Bulma.h3 "Legal Notice"
, Bulma.strong "Website Hosting"

View File

@ -15,6 +15,7 @@ data Page
| Zone String -- | `Zone`: to manage a zone.
| Setup -- | `Setup`: user account administration page
| Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).
| LegalNotice -- | `LegalNotice`: to learn about the website host, user agreements, etc.
derive instance genericPage :: Generic Page _