From 24770b75d6ee6a11f3a82d51b5a970600e702e66 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 15 Nov 2024 19:27:51 +0100 Subject: [PATCH] Various minor modifications. --- src/App/Container.purs | 16 +++++++++++----- src/App/Message/AuthenticationDaemon.purs | 7 +++++++ src/App/Page/Home.purs | 3 ++- src/App/Page/Registration.purs | 10 +++++++--- src/CSSClasses.purs | 6 ++++++ 5 files changed, 33 insertions(+), 9 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index a48f6eb..ac36161 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -291,7 +291,7 @@ render state reconnection_bar = if (state.are_we_connected_to_authd && state.are_we_connected_to_dnsmanagerd) then HH.div_ [] - else Bulma.btn_ (C.is_large <> C.is_danger) "You are disconnected. Click here to reconnect." Reconnection + else Bulma.btn_ (C.is_large <> C.is_danger) "You have been disconnected. Click here to reconnect." Reconnection render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_auth_WS = HH.slot _ws_auth unit WS.component (Tuple "ws://127.0.0.1:8080" "authd") AuthenticationDaemonEvent @@ -326,7 +326,7 @@ render state 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) + , Bulma.btn_ (C.is_large <> C.margin_top 3 <> C.is_info) "Home page" (Routing Home) ] render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad @@ -566,7 +566,7 @@ handleAction = case _ of WS.WSJustClosed -> do H.modify_ _ { are_we_connected_to_dnsmanagerd = false } H.liftEffect scrollToTop - handleAction $ Log $ ErrorLog "You just got disconnected from authd." + -- handleAction $ Log $ ErrorLog "You just got disconnected from authd." WS.Log message -> handleAction $ Log message WS.KeepAlive -> handleAction $ KeepAlive $ Left unit @@ -643,7 +643,12 @@ handleAction = case _ of handleAction $ AddNotif $ BadNotification "Sorry, you must be authenticated to perform this action." (AuthD.GotErrorAlreadyUsedLogin _) -> do handleAction $ Log $ ErrorLog "received a GotErrorAlreadyUsedLogin message." - handleAction $ AddNotif $ BadNotification "Sorry, your login is already taken." + handleAction $ AddNotif $ BadNotification "Sorry, this login is already used." + H.liftEffect scrollToTop + (AuthD.GotErrorEmailAddressAlreadyUsed _) -> do + handleAction $ Log $ ErrorLog "received a GotErrorEmailAddressAlreadyUsed message." + handleAction $ AddNotif $ BadNotification "Sorry, this email address is already used." + H.liftEffect scrollToTop (AuthD.GotErrorUserNotFound _) -> do handleAction $ Log $ ErrorLog "received a GotErrorUserNotFound message." handleAction $ AddNotif $ BadNotification "User hasn't been found." @@ -730,6 +735,7 @@ handleAction = case _ of Reconnection -> do H.tell _ws_auth unit WS.Connect H.tell _ws_dns unit WS.Connect + H.modify_ _ { notif = NoNotification } Disconnection -> do handleAction $ Routing Home @@ -756,7 +762,7 @@ handleAction = case _ of WS.WSJustClosed -> do H.modify_ _ { are_we_connected_to_dnsmanagerd = false } H.liftEffect scrollToTop - handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd." + -- handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd." WS.Log message -> handleAction $ Log message WS.KeepAlive -> handleAction $ KeepAlive $ Right unit diff --git a/src/App/Message/AuthenticationDaemon.purs b/src/App/Message/AuthenticationDaemon.purs index 56319f9..1a183f6 100644 --- a/src/App/Message/AuthenticationDaemon.purs +++ b/src/App/Message/AuthenticationDaemon.purs @@ -353,6 +353,11 @@ type ErrorEmailAddressNotValidated = {} codecGotErrorEmailAddressNotValidated :: CA.JsonCodec ErrorEmailAddressNotValidated codecGotErrorEmailAddressNotValidated = CA.object "ErrorEmailAddressNotValidated" (CAR.record {}) +{- 37 -} +type ErrorEmailAddressAlreadyUsed = {} +codecGotErrorEmailAddressAlreadyUsed :: CA.JsonCodec ErrorEmailAddressAlreadyUsed +codecGotErrorEmailAddressAlreadyUsed = CA.object "ErrorEmailAddressAlreadyUsed" (CAR.record {}) + {- 250 -} -- type KeepAlive = { } codecGotKeepAlive ∷ CA.JsonCodec KeepAlive @@ -409,6 +414,7 @@ data AnswerMessage | GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34 | GotErrorPasswordTooLong ErrorPasswordTooLong -- 35 | GotErrorEmailAddressNotValidated ErrorEmailAddressNotValidated -- 36 + | GotErrorEmailAddressAlreadyUsed ErrorEmailAddressAlreadyUsed -- 37 | GotKeepAlive KeepAlive -- 250 encode ∷ RequestMessage -> Tuple UInt String @@ -473,6 +479,7 @@ decode number string 34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey 35 -> error_management codecGotErrorPasswordTooLong GotErrorPasswordTooLong 36 -> error_management codecGotErrorEmailAddressNotValidated GotErrorEmailAddressNotValidated + 37 -> error_management codecGotErrorEmailAddressAlreadyUsed GotErrorEmailAddressAlreadyUsed 250 -> error_management codecGotKeepAlive GotKeepAlive _ -> Left UnknownNumber where diff --git a/src/App/Page/Home.purs b/src/App/Page/Home.purs index af1b5d6..d35e684 100644 --- a/src/App/Page/Home.purs +++ b/src/App/Page/Home.purs @@ -51,7 +51,8 @@ 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. """ - , Bulma.outside_link (C.button <> C.is_info) url_linuxfr "Cliquez ici pour en savoir plus." + , HH.p [ HP.classes (C.margin_top 3) ] + [ 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 37b4f77..4ac2030 100644 --- a/src/App/Page/Registration.purs +++ b/src/App/Page/Registration.purs @@ -11,6 +11,7 @@ import Data.Either (Either(..)) import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH +import Halogen.HTML.Properties as HP import Halogen.HTML.Events as HE import Web.Event.Event as Event import Web.Event.Event (Event) @@ -18,6 +19,7 @@ import Web.Event.Event (Event) import App.Text.Explanations as Explanations import Bulma as Bulma +import CSSClasses as C import Data.String as S import App.Type.Email as Email @@ -144,9 +146,11 @@ render { registrationForm } _, Right _ -> [] legal_mentions = [ Explanations.legal_notice - , Bulma.checkbox - [HH.text "I have read and accept the terms of service and privacy policy."] - LegalCheckboxToggle + , HH.div [HP.classes (C.margin_top 3 <> C.margin_bottom 3)] + [ Bulma.checkbox + [HH.span [HP.classes (C.margin_left 3)] [HH.text "I have read and accept the terms of service and privacy policy."]] + LegalCheckboxToggle + ] ] validation_btn = [ Bulma.btn_validation ] diff --git a/src/CSSClasses.purs b/src/CSSClasses.purs index 0b6c144..900df8c 100644 --- a/src/CSSClasses.purs +++ b/src/CSSClasses.purs @@ -4,9 +4,15 @@ import Prelude (show, ($), (<>)) import Halogen.HTML as HH +margin_top :: Int -> Array HH.ClassName +margin_top size = [HH.ClassName $ "mt-" <> show size] + margin_left :: Int -> Array HH.ClassName margin_left size = [HH.ClassName $ "ml-" <> show size] +margin_bottom :: Int -> Array HH.ClassName +margin_bottom size = [HH.ClassName $ "mb-" <> show size] + is :: Int -> Array HH.ClassName is size = [HH.ClassName $ "is-" <> show size]