Checkbox + legal terms.

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
 

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

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.
+          """
+  ]

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_
+-- <label class="checkbox">
+--   <input type="checkbox" />
+--   I agree to the <a href="#">terms and conditions</a>
+-- </label>
+
+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).

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")