diff --git a/src/App/Container.purs b/src/App/Container.purs index d2660d9..a48f6eb 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -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 diff --git a/src/App/Page/Home.purs b/src/App/Page/Home.purs index bc7ad4b..af1b5d6 100644 --- a/src/App/Page/Home.purs +++ b/src/App/Page/Home.purs @@ -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" diff --git a/src/App/Page/Registration.purs b/src/App/Page/Registration.purs index 436d63d..37b4f77 100644 --- a/src/App/Page/Registration.purs +++ b/src/App/Page/Registration.purs @@ -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 diff --git a/src/App/Text/Explanations.purs b/src/App/Text/Explanations.purs index 506df72..ec9d1f7 100644 --- a/src/App/Text/Explanations.purs +++ b/src/App/Text/Explanations.purs @@ -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" diff --git a/src/App/Type/Pages.purs b/src/App/Type/Pages.purs index d79fbaf..bd41de8 100644 --- a/src/App/Type/Pages.purs +++ b/src/App/Type/Pages.purs @@ -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 _