From dc7ee7d250ef6044083054865a927ad902b0076e Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 10 Feb 2024 18:11:11 +0100 Subject: [PATCH] WIP: validation for the email address at registration. --- src/App/AuthenticationInterface.purs | 1 - src/App/RegistrationInterface.purs | 96 +++++++++++-------- .../{Validation.purs => Validation/DNS.purs} | 28 +++--- src/App/Validation/Email.purs | 46 +++++++++ src/App/ZoneInterface.purs | 17 ++-- 5 files changed, 122 insertions(+), 66 deletions(-) rename src/App/{Validation.purs => Validation/DNS.purs} (91%) create mode 100644 src/App/Validation/Email.purs diff --git a/src/App/AuthenticationInterface.purs b/src/App/AuthenticationInterface.purs index afdb89e..b039311 100644 --- a/src/App/AuthenticationInterface.purs +++ b/src/App/AuthenticationInterface.purs @@ -4,7 +4,6 @@ module App.AuthenticationInterface where import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>)) - import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..)) diff --git a/src/App/RegistrationInterface.purs b/src/App/RegistrationInterface.purs index 75d59e9..23a6a0e 100644 --- a/src/App/RegistrationInterface.purs +++ b/src/App/RegistrationInterface.purs @@ -4,6 +4,7 @@ module App.RegistrationInterface where import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>)) +import Data.Array as A import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Maybe (Maybe(..)) import Effect.Aff.Class (class MonadAff) @@ -20,23 +21,17 @@ import App.Email as Email import App.LogMessage import App.Messages.AuthenticationDaemon as AuthD --- | The component can inform the parent (`App.Container`) that the authentication is complete, --- | and share both the uid and token. The token is useful to authenticate the user to the --- | dnsmanager daemon. --- | --- | Also, the component can send a message to a websocket and log messages. --- | --- | TODO: authentication is performed in `App.Container`. +--import App.Validation.Login (login, Error(..)) as L +--import App.Validation.Email (email, Error(..)) as E +--import App.Validation.Password (password, Error(..)) as P + data Output = MessageToSend ArrayBuffer | Log LogMessage --- | The component's parent provides received messages. --- | --- | Also, the component is informed when the connection went up or down. +-- | The component is informed when the connection went up or down. data Query a - = MessageReceived AuthD.AnswerMessage a - | ConnectionIsDown a + = ConnectionIsDown a | ConnectionIsUp a type Slot = H.Slot Query Output @@ -52,10 +47,16 @@ data Action = HandleRegisterInput RegisterInput | RegisterAttempt Event +--data Error +-- | Login L.Error +-- | Email E.Error +-- | Password P.Error + type StateRegistrationForm = { login :: String, email :: String, pass :: String } type State = { registrationForm :: StateRegistrationForm + --, errors :: Array Error , wsUp :: Boolean } @@ -73,6 +74,7 @@ component = initialState :: Input -> State initialState _ = { registrationForm: { login: "", email: "", pass: "" } + --, errors: [] , wsUp: true } @@ -86,7 +88,7 @@ render { wsUp, registrationForm } where b e = Bulma.column_ [ Bulma.box e ] - registration_form = [ Bulma.h3 "Register!" , render_register_form ] + registration_form = [ Bulma.h3 "Register!", render_register_form ] should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true)) @@ -125,39 +127,49 @@ handleAction = case _ of RegisterAttempt ev -> do H.liftEffect $ Event.preventDefault ev - { registrationForm } <- H.get - let login = registrationForm.login - email = registrationForm.email - pass = registrationForm.pass + H.raise $ Log $ UnableToSend "TODO: validation first!" - case login, email, pass of - "", _, _ -> - H.raise $ Log $ UnableToSend "Write your login!" - - _, "", _ -> - H.raise $ Log $ UnableToSend "Write your email!" - - _, _, "" -> - H.raise $ Log $ UnableToSend "Write your password!" - - _, _, _ -> do - message <- H.liftEffect $ AuthD.serialize $ - AuthD.MkRegister { login: login - , email: Just (Email.Email email) - , password: pass } - H.raise $ MessageToSend message - H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")" +-- { registrationForm } <- H.get +-- let login = registrationForm.login +-- email = registrationForm.email +-- pass = registrationForm.pass +-- +-- case login, email, pass of +-- "", _, _ -> +-- H.raise $ Log $ UnableToSend "Write your login!" +-- +-- _, "", _ -> +-- H.raise $ Log $ UnableToSend "Write your email!" +-- +-- _, _, "" -> +-- H.raise $ Log $ UnableToSend "Write your password!" +-- +-- _, _, _ -> do +-- -- TODO: handle validation +-- case L.login login, E.email email, P.password pass of +-- Left errors, _, _ -> H.raise $ Log $ UnableToSend $ show_error errors +-- _, Left errors, _ -> H.raise $ Log $ UnableToSend $ show_error errors +-- _, _, Left errors -> H.raise $ Log $ UnableToSend $ show_error errors +-- +-- Right l, Right e, Right p -> do +-- message <- H.liftEffect $ AuthD.serialize $ +-- AuthD.MkRegister { login: login +-- , email: Just (Email.Email email) +-- , password: pass } +-- H.raise $ MessageToSend message +-- H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")" +-- where +-- collect_errors +-- +-- show_errors :: Array Error -> String +-- show_errors array = A.concat $ map show_error array +-- show_error = case _ of +-- Login _ -> "Error with the Login" +-- Email _ -> "Error with the Email" +-- Password _ -> "Error with the Password" handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of - -- For now, no message actually needs to be handled here. - -- Error messages are simply logged (see the code in the Container component). - MessageReceived message _ -> do - case message of - _ -> do - H.raise $ Log $ SimpleLog $ "[😈] Message not handled in the `RegistrationInterface` module." - pure Nothing - ConnectionIsDown a -> do H.modify_ _ { wsUp = false } pure (Just a) diff --git a/src/App/Validation.purs b/src/App/Validation/DNS.purs similarity index 91% rename from src/App/Validation.purs rename to src/App/Validation/DNS.purs index 26ab3f2..0a2836a 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation/DNS.purs @@ -1,4 +1,4 @@ -module App.Validation where +module App.Validation.DNS where import Prelude (apply, between, bind, map, pure, ($), (-), (<)) @@ -32,7 +32,7 @@ import GenericParser.RFC5234 as RFC5234 -- | -- | Maybe the code will change again in the future, but for now it will be enough. -data ValidationError +data Error = UNKNOWN | VEIPv4 (G.Error IPAddress.IPv4Error) | VEIPv6 (G.Error IPAddress.IPv6Error) @@ -48,7 +48,7 @@ data ValidationError | VEPort Int Int Int | VEWeight Int Int Int -type AVErrors = Array ValidationError +type AVErrors = Array Error -- | Current default values. min_ttl :: Int @@ -161,31 +161,31 @@ txt_parser = do pos <- G.current_position -- | `parse` allows to run any parser based on `GenericParser` and provide a validation error. -- | The actual validation error contains the parser's error including the position. -parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> ValidationError) -> V AVErrors v +parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V AVErrors v parse (G.Parser p) str c = case p { string: str, position: 0 } of Left x -> invalid $ [c x] Right x -> pure x.result validationA :: ResourceRecord -> V AVErrors ResourceRecord validationA form = ado - name <- parse DomainParser.sub_eof form.name VEName - ttl <- is_between min_ttl max_ttl form.ttl VETTL - target <- parse IPAddress.ipv4 form.target VEIPv4 + name <- parse DomainParser.sub_eof form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse IPAddress.ipv4 form.target VEIPv4 in toRR_basic form.rrid form.readonly "A" name ttl target validationAAAA :: ResourceRecord -> V AVErrors ResourceRecord validationAAAA form = ado name <- parse DomainParser.sub_eof form.name VEName - ttl <- is_between min_ttl max_ttl form.ttl VETTL + ttl <- is_between min_ttl max_ttl form.ttl VETTL -- use read_input to get unaltered input (the IPv6 parser expands the input) target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 in toRR_basic form.rrid form.readonly "AAAA" name ttl target validationTXT :: ResourceRecord -> V AVErrors ResourceRecord validationTXT form = ado - name <- parse DomainParser.sub_eof form.name VEName - ttl <- is_between min_ttl max_ttl form.ttl VETTL - target <- parse txt_parser form.target VETXT + name <- parse DomainParser.sub_eof form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse txt_parser form.target VETXT in toRR_basic form.rrid form.readonly "TXT" name ttl target validationCNAME :: ResourceRecord -> V AVErrors ResourceRecord @@ -197,8 +197,8 @@ validationCNAME form = ado validationNS :: ResourceRecord -> V AVErrors ResourceRecord validationNS form = ado - name <- parse DomainParser.sub_eof form.name VEName - ttl <- is_between min_ttl max_ttl form.ttl VETTL + name <- parse DomainParser.sub_eof form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL target <- parse DomainParser.sub_eof form.target VENS in toRR_basic form.rrid form.readonly "NS" name ttl target @@ -210,7 +210,7 @@ protocol_parser = do pos <- G.current_position G.string "tcp" <|> G.string "udp" <|> G.Parser \_ -> G.failureError pos (Just InvalidProtocol) -is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> ValidationError) -> V AVErrors Int +is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V AVErrors Int is_between min max n ve = if between min max n then pure n else invalid [ve min max n] diff --git a/src/App/Validation/Email.purs b/src/App/Validation/Email.purs new file mode 100644 index 0000000..6eea5c4 --- /dev/null +++ b/src/App/Validation/Email.purs @@ -0,0 +1,46 @@ +module App.Validation.Email where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.Validation.Semigroup (V, invalid, toEither) + +import GenericParser.RFC5322 as RFC5322 +import GenericParser.SomeParsers as SomeParsers +import GenericParser.Parser as G + +data EmailParsingError + = CannotParse + | CannotEntirelyParse + | Size Int Int Int + +data Error + = ParsingError (G.Error EmailParsingError) + +min_email_size :: Int +min_email_size = 20 +max_email_size :: Int +max_email_size = 100 + +parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v +parse (G.Parser p) str c = case p { string: str, position: 0 } of + Left x -> invalid $ [c x] + Right x -> pure x.result + +parse_full_email :: G.Parser EmailParsingError String +parse_full_email = do + email_address <- RFC5322.address <|> G.Parser \i -> G.failureError i.position (Just CannotParse) + _ <- SomeParsers.eof <|> G.Parser \i -> G.failureError i.position (Just CannotEntirelyParse) + pos <- G.current_position + if pos < min_email_size || pos > max_email_size + then G.Parser \i -> G.failureError i.position (Just $ Size min_email_size max_email_size pos) + else pure email_address + +parserEmail :: String -> V (Array Error) String +parserEmail str = parse parse_full_email str ParsingError + +-- | TODO +email :: String -> Either (Array Error) String +email s = toEither $ parserEmail s diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index f2eaeb4..68dc0b3 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -43,9 +43,8 @@ import App.ResourceRecord (ResourceRecord) import App.LogMessage (LogMessage(..)) import App.Messages.DNSManagerDaemon as DNSManager -import App.Validation as Validation +import App.Validation.DNS as Validation import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser --- import GenericParser.DomainParser as DomainParser import GenericParser.IPAddress as IPAddress type RRId = Int @@ -172,11 +171,11 @@ type State = -- | All resource records. , _resources :: Array ResourceRecord - --, _local_errors :: Hash.HashMap RRId (Array Validation.ValidationError) + --, _local_errors :: Hash.HashMap RRId (Array Validation.Error) -- Unique RR form. , _currentRR :: ResourceRecord - , _currentRR_errors :: Array Validation.ValidationError + , _currentRR_errors :: Array Validation.Error } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -691,7 +690,7 @@ render_soa (Just soa) = Bulma.box [ Bulma.zone_rr_title "Start Of Authority (SOA -- | Render all Resource Records. render_resources :: forall w - -- . Hash.HashMap RRId (Array Validation.ValidationError) + -- . Hash.HashMap RRId (Array Validation.Error) . Array (ResourceRecord) -> HH.HTML w Action render_resources [] @@ -811,7 +810,7 @@ loopE f a = case (A.head a) of Nothing -> pure unit Just xs -> loopE f xs -error_to_paragraph :: forall w. Validation.ValidationError -> HH.HTML w Action +error_to_paragraph :: forall w. Validation.Error -> HH.HTML w Action error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) (case v of Validation.UNKNOWN -> Bulma.p "An internal error happened." @@ -836,7 +835,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) where default_error = Bulma.p "No actual error reported." -- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry. -show_error_title :: Validation.ValidationError -> String +show_error_title :: Validation.Error -> String show_error_title v = case v of Validation.UNKNOWN -> "Unknown" Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" @@ -883,14 +882,14 @@ show_error_ip6 e = case e of """ IPAddress.IP6TooManyChunks -> Bulma.p "The IPv6 representation is erroneous. It should contains only up to 8 groups of hexadecimal characters." - IPAddress.IP6UnrelevantShortRepresentation -> + IPAddress.IP6IrrelevantShortRepresentation -> Bulma.p "IPv6 address have been unnecessarily shortened (with two ':')." show_error_ip4 :: forall w. IPAddress.IPv4Error -> HH.HTML w Action show_error_ip4 e = case e of IPAddress.IP4NumberTooBig n -> Bulma.p $ "IPv4 address contains a number too big (should be between 0 and 255). Current entered number: " <> show n - IPAddress.IP4UnrelevantShortRepresentation -> + IPAddress.IP4IrrelevantShortRepresentation -> Bulma.p "IPv4 address have been unnecessarily shortened (with two '.')." show_error_txt :: forall w. Validation.TXTError -> HH.HTML w Action