From 79f853045040288e19217bcbf8b13297f3f6afe8 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 14 Nov 2024 05:39:22 +0100 Subject: [PATCH] Checkbox + legal terms. --- src/App/Container.purs | 5 +++++ src/App/Page/Registration.purs | 27 +++++++++++++++++++++---- src/App/Text/Explanations.purs | 36 ++++++++++++++++++++++++++++++++++ src/Bulma.purs | 13 ++++++++++-- src/MissingHTMLProperties.purs | 6 ++++++ 5 files changed, 81 insertions(+), 6 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index a0d6edf..964a212 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -719,7 +719,12 @@ handleAction = case _ of Disconnection -> do handleAction $ Routing Home + -- Preserve the state of the connection (authd and dnsmanagerd). + old_state <- H.get H.put $ initialState unit + H.modify_ _ { are_we_connected_to_authd = old_state.are_we_connected_to_authd + , are_we_connected_to_dnsmanagerd = old_state.are_we_connected_to_dnsmanagerd + } handleAction $ ToggleAuthenticated Nothing diff --git a/src/App/Page/Registration.purs b/src/App/Page/Registration.purs index cddb199..436d63d 100644 --- a/src/App/Page/Registration.purs +++ b/src/App/Page/Registration.purs @@ -2,7 +2,7 @@ -- | Registration requires a login, an email address and a password. module App.Page.Registration where -import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between) +import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between, not) import Data.Array as A import Data.ArrayBuffer.Types (ArrayBuffer) @@ -15,6 +15,8 @@ import Halogen.HTML.Events as HE import Web.Event.Event as Event import Web.Event.Event (Event) +import App.Text.Explanations as Explanations + import Bulma as Bulma import Data.String as S @@ -53,6 +55,9 @@ data Action -- | This action is automatically called from `ValidateInputs`. | SendRegistrationRequest + -- | The user clicked on the checkbox. + | LegalCheckboxToggle + -- | The possible errors come from either the login, email or password input. data Error = Login (Array L.Error) @@ -60,7 +65,7 @@ data Error | Password (Array P.Error) -- | The whole registration form is composed of three strings: login, email and password. -type StateRegistrationForm = { login :: String, email :: String, pass :: String } +type StateRegistrationForm = { login :: String, email :: String, pass :: String, checked :: Boolean } -- | State is composed of the registration form, the errors and an indication whether -- | the websocket connection with `authd` is up or not. @@ -71,7 +76,7 @@ type State = initialState :: Input -> State initialState _ = - { registrationForm: { login: "", email: "", pass: "" } + { registrationForm: { login: "", email: "", pass: "", checked: false } , errors: [] } @@ -98,7 +103,7 @@ render { registrationForm } (login_input <> login_error <> email_input <> email_error <> password_input <> password_error <> - validation_btn) + legal_mentions <> validation_btn) login_input = [ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder @@ -136,6 +141,12 @@ render { registrationForm } _, Left errors -> [ Bulma.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ] _, Right _ -> [] + legal_mentions = [ Explanations.legal_mentions + , Bulma.checkbox + [HH.text "I have read and accept the terms of service and privacy policy."] + LegalCheckboxToggle + ] + validation_btn = [ Bulma.btn_validation ] handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit @@ -146,6 +157,14 @@ handleAction = case _ of REG_INP_email v -> H.modify_ _ { registrationForm { email = v } } REG_INP_pass v -> H.modify_ _ { registrationForm { pass = v } } + 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. ValidateInputs ev -> do diff --git a/src/App/Text/Explanations.purs b/src/App/Text/Explanations.purs index 9d17f5f..8a98bd5 100644 --- a/src/App/Text/Explanations.purs +++ b/src/App/Text/Explanations.purs @@ -481,3 +481,39 @@ srv_introduction = , HH.text " could be specified." ] ] + +legal_mentions :: forall w i. HH.HTML w i +legal_mentions = HH.div_ + [ Bulma.h3 "Legal mentions" + , expl' """ + The website editor: Philippe PITTOLI + Address: Remilly-les-Marais, FRANCE + Contact: netlibre AT karchnu.fr + + This website is hosted by Alsace Réseau Neutre. + Website: https://arn-fai.net + Address: Strasbourg, FRANCE + Contact: contact AT arn-fai.net + + This website only collects data that are essential to the provided service. + This includes a login (arbitrary set of characters), an email to contact the owner of the domain, + + None of the collected data will be shared to third parties. + + The personal data collected on this website will be retained for as + long as necessary to fulfill the purposes for which it was collected, + including the management of user accounts. However, please note that + even after the deletion of your account, your data may be retained + for up to 6 months due to technical constraints, such as backups made + for disaster recovery purposes in the event of a hardware failure. This + retention period is necessary to ensure the security and integrity of our + system and to allow for the restoration of data in case of any unforeseen + issues. After this period, all data will be securely deleted. + + You have the right to access, correct and delete your personal + data at any time via this website or by contacting us at the + following email address: netlibre AT karchnu.fr + + This website doesn't use any cookie. + """ + ] diff --git a/src/Bulma.purs b/src/Bulma.purs index 0cb9995..97b7462 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -8,7 +8,7 @@ import Halogen.HTML as HH import DOM.HTML.Indexed as DHI import Halogen.HTML.Properties as HP import Halogen.HTML.Events as HE --- import MissingHTMLProperties as MissingProperties +import MissingHTMLProperties as MissingProperties import CSSClasses as C @@ -16,7 +16,16 @@ import Halogen.HTML.Core (AttrName(..)) -- import Web.Event.Event (type_, Event, EventType(..)) -- import Web.UIEvent.MouseEvent (MouseEvent) -- package web-uievents -outside_link :: forall w i. Array HH.ClassName -> String -> String -> HH.HTML w i +checkbox :: forall w i. Array (HH.HTML w i) -> i -> HH.HTML w i +checkbox content_ action + = HH.label + [ HP.classes C.label ] $ [ HH.input [ HE.onValueInput \ _ -> action, MissingProperties.ty "checkbox" ] ] <> content_ +-- + +outside_link :: forall w i. Array HH.ClassName -> String -> String -> HH.HTML w i outside_link classes url title = HH.a [ HP.classes classes, HP.target "_blank", HP.href url ] [ HH.text title ] columns :: forall (w :: Type) (i :: Type). diff --git a/src/MissingHTMLProperties.purs b/src/MissingHTMLProperties.purs index 5b66a5e..9d0f7b3 100644 --- a/src/MissingHTMLProperties.purs +++ b/src/MissingHTMLProperties.purs @@ -10,3 +10,9 @@ aria_current = HP.attr (AttrName "aria-current") size :: forall r i. Int -> HP.IProp (size :: Int | r) i size = HP.prop (PropName "size") + +-- ty :: forall r i. Int -> HP.IProp (ty :: String | r) i +-- ty = HP.prop (PropName "type") + +ty :: forall r i. String -> HP.IProp r i +ty = HP.attr (AttrName "type")