Registration: validation works.

src/App/RegistrationInterface.purs

@@ -2,11 +2,12 @@
 -- | Registration requires a login, an email address and a password.
 module App.RegistrationInterface where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>))
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), map, show)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), maybe)
+import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
@@ -21,9 +22,9 @@ import App.Email as Email
 import App.LogMessage
 import App.Messages.AuthenticationDaemon as AuthD
 
---import App.Validation.Login (login, Error(..)) as L
+import App.Validation.Login as L
---import App.Validation.Email (email, Error(..)) as E
+import App.Validation.Email as E
---import App.Validation.Password (password, Error(..)) as P
+import App.Validation.Password as P
 
 data Output
   = MessageToSend ArrayBuffer
@@ -44,19 +45,29 @@ data RegisterInput
   | REG_INP_pass String
 
 data Action
+  -- | Simply get the inputs from the form.
   = HandleRegisterInput RegisterInput
-  | RegisterAttempt Event
+  -- | Validate inputs (login, email, password) then send the request
+  -- | (via `SendRegistrationRequest`) or log errors.
+  | ValidateInputs Event
+  -- | Send the registration request to `dnsmanagerd`.
+  -- | This action is automatically called from `ValidateInputs`.
+  | SendRegistrationRequest
 
---data Error
+-- | The possible errors come from either the login, email or password input.
---  | Login    L.Error
+data Error
---  | Email    E.Error
+  = Login    (Array L.Error)
---  | Password P.Error
+  | Email    (Array E.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 }
 
+-- | State is composed of the registration form, the errors and an indication whether
+-- | the websocket connection with `authd` is up or not.
 type State =
   { registrationForm :: StateRegistrationForm
-  --, errors           :: Array Error
+  , errors           :: Array Error
   , wsUp             :: Boolean
   }
 
@@ -74,7 +85,7 @@ component =
 initialState :: Input -> State
 initialState _ =
   { registrationForm: { login: "", email: "", pass: "" }
-  --, errors: []
+  , errors: []
   , wsUp: true
   }
 
@@ -93,7 +104,7 @@ render { wsUp, registrationForm }
     should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
 
     render_register_form = HH.form
-      [ HE.onSubmit RegisterAttempt ]
+      [ HE.onSubmit ValidateInputs ]
       [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
           (HandleRegisterInput <<< REG_INP_login)      -- action
           registrationForm.login                       -- value
@@ -124,49 +135,85 @@ handleAction = case _ of
       REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
       REG_INP_pass  v -> H.modify_ _ { registrationForm { pass  = v } }
 
-  RegisterAttempt ev -> do
+  -- Validate inputs (login, email, password) then send the request
+  -- (via SendRegistrationRequest) or log errors.
+  ValidateInputs ev -> do
     H.liftEffect $ Event.preventDefault ev
 
-    H.raise $ Log $ UnableToSend "TODO: validation first!"
+    { registrationForm } <- H.get
+    let login = registrationForm.login
+        email = registrationForm.email
+        pass  = registrationForm.pass
 
---    { registrationForm } <- H.get
+    case login, email, pass of
---    let login = registrationForm.login
+      "", _, _ ->
---        email = registrationForm.email
+        H.raise $ Log $ UnableToSend "Write your login!"
---        pass  = registrationForm.pass
+
---
+      _, "", _ ->
---    case login, email, pass of
+        H.raise $ Log $ UnableToSend "Write your email!"
---      "", _, _ ->
+
---        H.raise $ Log $ UnableToSend "Write your login!"
+      _, _, "" ->
---
+        H.raise $ Log $ UnableToSend "Write your password!"
---      _, "", _ ->
+
---        H.raise $ Log $ UnableToSend "Write your email!"
+      _, _, _ -> do
---
+        case L.login login, E.email email, P.password pass of
---      _, _, "" ->
+          Left errors, _, _         -> H.raise $ Log $ UnableToSend $ show_error $ Login errors
---        H.raise $ Log $ UnableToSend "Write your password!"
+          _, Left errors, _         -> H.raise $ Log $ UnableToSend $ show_error $ Email errors
---
+          _, _, Left errors         -> H.raise $ Log $ UnableToSend $ show_error $ Password errors
---      _, _, _ -> do
+          Right _, Right _, Right _ -> handleAction $ SendRegistrationRequest
---        -- TODO: handle validation
+
---        case L.login login, E.email email, P.password pass of
+  SendRegistrationRequest -> do
---          Left errors, _, _         -> H.raise $ Log $ UnableToSend $ show_error errors
+    { registrationForm } <- H.get
---          _, Left errors, _         -> H.raise $ Log $ UnableToSend $ show_error errors
+    let { login, email, pass } = registrationForm
---          _, _, Left errors         -> H.raise $ Log $ UnableToSend $ show_error errors
+    message <- H.liftEffect $ AuthD.serialize $
---
+      AuthD.MkRegister { login, email: Just (Email.Email email), password: pass }
---          Right l, Right e, Right p -> do
+    H.raise $ MessageToSend message
---            message <- H.liftEffect $ AuthD.serialize $
+    H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")"
---              AuthD.MkRegister { login: login
+
---                               , email: Just (Email.Email email)
+show_error :: Error -> String
---                               , password: pass }
+show_error = case _ of
---            H.raise $ MessageToSend message
+  Login    arr -> "Error with the Login: "    <> (A.fold $ map show_error_login arr)
---            H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")"
+  Email    arr -> "Error with the Email: "    <> (A.fold $ map show_error_email arr)
---  where
+  Password arr -> "Error with the Password: " <> (A.fold $ map show_error_password arr)
---  collect_errors 
+
---
+show_error_login :: L.Error -> String
---  show_errors :: Array Error -> String
+show_error_login = case _ of
---  show_errors array = A.concat $ map show_error array
+  L.ParsingError {error, position} ->
---  show_error = case _ of
+    "position " <> show position <> " " <> maybe "" string_error_login error
---    Login _ -> "Error with the Login"
+
---    Email _ -> "Error with the Email"
+string_error_login :: L.LoginParsingError -> String
---    Password _ -> "Error with the Password"
+string_error_login = case _ of
+  L.CannotParse         -> "cannot parse the login"
+  L.CannotEntirelyParse -> "cannot entirely parse the login"
+  L.Size min max n      -> "login size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
+
+show_error_email :: E.Error -> String
+show_error_email = case _ of
+  E.ParsingError {error, position} ->
+    "position " <> show position <> " " <> maybe "" string_error_email error
+
+string_error_email :: E.EmailParsingError -> String
+string_error_email = case _ of
+  E.CannotParse         -> "cannot parse the email"
+  E.CannotEntirelyParse -> "cannot entirely parse the email"
+  E.Size min max n      -> "email size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
+
+show_error_password :: P.Error -> String
+show_error_password = case _ of
+  P.ParsingError {error, position} ->
+    "position " <> show position <> " " <> maybe "" string_error_password error
+
+string_error_password :: P.PasswordParsingError -> String
+string_error_password = case _ of
+  P.CannotParse         -> "cannot parse the password"
+  P.CannotEntirelyParse -> "cannot entirely parse the password"
+  P.Size min max n      -> "password size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of

src/App/Validation/Login.purs

@@ -21,7 +21,7 @@ data Error
   = ParsingError (G.Error LoginParsingError)
 
 min_login_size :: Int
-min_login_size = 1
+min_login_size = 2
 max_login_size :: Int
 max_login_size = 50