Various minor modifications.

This commit is contained in:
Philippe Pittoli 2024-11-15 19:27:51 +01:00
parent 914c7be4e4
commit 24770b75d6
5 changed files with 33 additions and 9 deletions

View File

@ -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

View File

@ -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

View File

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

View File

@ -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 ]

View File

@ -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]