WIP: validation for the email address at registration.
parent
329d84e6f9
commit
dc7ee7d250
|
|
@ -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(..))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue