provide-beta

TODO.md

@@ -0,0 +1,43 @@
+# Code structure
+
+- split `App.Zone` to improve compilation times
+- split the Bulma module in two: the actual Bulma-related code and the general style of the website
+- modules should have specific API
+- *maybe* have a module with the entire state and a single function handling all state modifications on received message
+
+# Features
+
+- display a message when the email isn't provided (happens when the account was migrated from dnsmanager v1)
+- zone-wise indications to help people configure their zone for specific uses (web, mail)
+- explanations and static content in general should be written using some kind of templates, not directly in Halogen
+- admin interface: enable administrators to ask for users' info and show zones
+- admin interface: perform a few more administrative operations (*TBD*)
+
+# Tests
+
+- zone-wise tests, such as verifying SPF mechanisms point to available records
+- verify the length of received messages in `App.Message.IPC`
+
+# Display
+
+- user interface: display the email address
+- somewhat better looking welcome page
+- somewhat better looking explanation pages
+- hide logs by default
+- show a big button on disconnection
+- *maybe* notifications should disappear after a few seconds
+- admin interface: basically just rewrite the whole thing, it's a mess
+
+# General note
+
+The code should be reviewed and a decent documentation should be provided.
+
+Right now, the code is still in a somewhat early stage and multiple refactoring should take place.
+For example, modules have a very generic API; they can provide or receive messages from (respectively *to*) authd or dnsmanagerd.
+Instead, modules should have a more specific API and not deal with message encoding at all.
+Furthermore, *maybe* the state of the entire application should be stored in a single module, with a single function handling all state modifications when a message is received, enabling a simpler data management.
+
+# TODO in authd and dnsmanagerd
+
+- disconnect users when they didn't ask for anything in several minutes
+- MIGRATION-related: remove migrated accounts with no connection in over 6 months

makefile.user

@@ -0,0 +1,2 @@
+provide-beta:
+	make serve HTTPD_PORT=35000 HTTPD_ADDR=192.168.122.181

src/App/Container.purs

@@ -178,6 +178,7 @@ data Notification = NoNotification | GoodNotification String | BadNotification S
 -- | the states of both `DomainListInterface` and `AuthenticationDaemonAdmin` modules,
 -- | to avoid many useless network exchanges.
 type State = { token :: Maybe String
+             , user_data :: Maybe (Tuple (Maybe Email.Email) (Maybe Email.Email))
              , current_page :: Page
              , store_DomainListInterface_state :: Maybe DomainListInterface.State
              , store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
@@ -229,6 +230,7 @@ component =
 -- | Initial state is simple: the user is on the home page, nothing else is stored.
 initialState :: forall i. i -> State
 initialState _ = { token: Nothing
+                 , user_data: Nothing
                  , current_page: Home
                  , store_DomainListInterface_state: Nothing
                  , store_AuthenticationDaemonAdmin_state: Nothing
@@ -272,8 +274,8 @@ render state
     render_registration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_registration = HH.slot _ri unit RI.component unit RegistrationInterfaceEvent
     render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_setup = case state.token of
+    render_setup = case state.user_data of
-                     Just token -> HH.slot _setupi unit SetupInterface.component token SetupInterfaceEvent
+                     Just user_data -> HH.slot _setupi unit SetupInterface.component user_data SetupInterfaceEvent
                      Nothing -> Bulma.p "You shouldn't see this page. Please, reconnect."
     render_mail_validation :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent
@@ -302,10 +304,10 @@ render state
     render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ]
 
     render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_auth_WS = HH.slot _ws_auth unit WS.component "ws://127.0.0.1:8080" AuthenticationDaemonEvent
+    render_auth_WS = HH.slot _ws_auth unit WS.component "wss://beta.netlib.re/ws/authd" AuthenticationDaemonEvent
 
     render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "ws://127.0.0.1:8081" DNSManagerDaemonEvent
+    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "wss://beta.netlib.re/ws/dnsmanagerd" DNSManagerDaemonEvent
 
 handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
 handleAction = case _ of
@@ -431,6 +433,14 @@ handleAction = case _ of
       -- Once the user has been deleted, just act like it was just a disconnection.
       handleAction $ Disconnection
 
+    SetupInterface.ChangeEmailAddress email_address  -> do
+      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkModUser { user:       Nothing
+                                                                  , admin:      Nothing
+                                                                  , password:   Nothing
+                                                                  , email:      Just email_address
+                                                                  }
+      H.tell _ws_auth unit (WS.ToSend message)
+
     SetupInterface.ChangePassword pass  -> do
       message <- H.liftEffect $ AuthD.serialize $ AuthD.MkModUser { user:       Nothing
                                                                   , admin:      Nothing
@@ -537,6 +547,11 @@ handleAction = case _ of
             handleAction $ Log $ ErrorLog "TODO: received a GotPermissionCheck message."
           (AuthD.GotPermissionSet _) -> do
             handleAction $ Log $ ErrorLog "Received a GotPermissionSet message."
+          (AuthD.GotErrorEmailAddressNotValidated _) -> do
+            handleAction $ Log $ ErrorLog """
+                Cannot authenticate: your email address hasn't been validated.
+                Please check your email inbox.
+                """
           m@(AuthD.GotPasswordRecovered _) -> do
             handleAction $ Log $ SuccessLog "your new password is now valid."
             handleAction $ DispatchAuthDaemonMessage m
@@ -615,7 +630,8 @@ handleAction = case _ of
           -- The authentication was a success!
           (AuthD.GotToken msg) -> do
             handleAction $ Log $ SuccessLog $ "Authenticated to authd."
-            H.modify_ _ { token = Just msg.token }
+            H.modify_ _ { token = Just msg.token
+                        , user_data = Just (Tuple msg.current_email msg.pending_email) }
             handleAction $ ToggleAuthenticated (Just msg.token)
 
             sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window

src/App/DisplayErrors.purs

@@ -46,6 +46,9 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.VEWeight min max n   -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
 
+      ValidationDNS.VECAAflag min max n  -> Bulma.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
+                                         <> ", current value: " <> show n <> "."
+
       -- SPF dedicated RR
       ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
       ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
@@ -81,6 +84,7 @@ show_error_title v = case v of
   ValidationDNS.VEProtocol _     -> "Invalid Protocol"
   ValidationDNS.VEPort _ _ _     -> "Invalid Port"
   ValidationDNS.VEWeight _ _ _   -> "Invalid Weight"
+  ValidationDNS.VECAAflag _ _ _  -> "Invalid CAA Flag"
 
   -- SPF dedicated RR
   ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
@@ -171,7 +175,7 @@ show_error_title_label v = case v of
 
 show_error_login :: L.Error -> String
 show_error_login = case _ of
-  L.ParsingError {error} -> maybe "" string_error_login error
+  L.ParsingError {error} -> maybe "login is invalid, it should respect the following regex: [a-zA-Z][-_ a-zA-Z0-9']*[a-zA-Z0-9]" string_error_login error
 
 string_error_login :: L.LoginParsingError -> String
 string_error_login = case _ of
@@ -183,7 +187,7 @@ string_error_login = case _ of
 
 show_error_email :: E.Error -> String
 show_error_email = case _ of
-  E.ParsingError {error} -> maybe "" string_error_email error
+  E.ParsingError {error} -> maybe "invalid email address" string_error_email error
 
 string_error_email :: E.EmailParsingError -> String
 string_error_email = case _ of
@@ -195,7 +199,7 @@ string_error_email = case _ of
 
 show_error_password :: P.Error -> String
 show_error_password = case _ of
-  P.ParsingError {error} -> maybe "" string_error_password error
+  P.ParsingError {error} -> maybe "invalid password, it should contain between 15 and 100 characters (ASCII)" string_error_password error
 
 string_error_password :: P.PasswordParsingError -> String
 string_error_password = case _ of

src/App/Message/AuthenticationDaemon.purs

@@ -186,9 +186,13 @@ codecGotError ∷ CA.JsonCodec Error
 codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
 
 {- 1  -}
-type Logged = { uid :: Int, token :: String }
+type Logged = { uid :: Int, token :: String, current_email :: Maybe Email.Email, pending_email :: Maybe Email.Email }
 codecGotToken ∷ CA.JsonCodec Logged
-codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int, "token": CA.string })
+codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int
+                                               , "token": CA.string
+                                               , current_email: CAR.optional Email.codec
+                                               , pending_email: CAR.optional Email.codec
+                                               })
 
 {- 2  -}
 type User = { user :: UserPublic.UserPublic }
@@ -344,6 +348,11 @@ type ErrorPasswordTooLong = {}
 codecGotErrorPasswordTooLong :: CA.JsonCodec ErrorPasswordTooLong
 codecGotErrorPasswordTooLong = CA.object "ErrorPasswordTooLong" (CAR.record {})
 
+{- 36 -}
+type ErrorEmailAddressNotValidated = {}
+codecGotErrorEmailAddressNotValidated :: CA.JsonCodec ErrorEmailAddressNotValidated
+codecGotErrorEmailAddressNotValidated = CA.object "ErrorEmailAddressNotValidated" (CAR.record {})
+
 {- 250 -}
 -- type KeepAlive = { }
 codecGotKeepAlive ∷ CA.JsonCodec KeepAlive
@@ -370,36 +379,37 @@ data RequestMessage
 
 -- All possible answers from the authentication daemon (authd).
 data AnswerMessage
-  = GotError                     Error                     -- 0
+  = GotError                         Error                         -- 0
-  | GotToken                     Logged                    -- 1
+  | GotToken                         Logged                        -- 1
-  | GotUser                      User                      -- 2
+  | GotUser                          User                          -- 2
-  | GotUserAdded                 UserAdded                 -- 3
+  | GotUserAdded                     UserAdded                     -- 3
-  | GotUserEdited                UserEdited                -- 4
+  | GotUserEdited                    UserEdited                    -- 4
-  | GotUserValidated             UserValidated             -- 5
+  | GotUserValidated                 UserValidated                 -- 5
-  | GotUsersList                 UsersList                 -- 6
+  | GotUsersList                     UsersList                     -- 6
-  | GotPermissionCheck           PermissionCheck           -- 7
+  | GotPermissionCheck               PermissionCheck               -- 7
-  | GotPermissionSet             PermissionSet             -- 8
+  | GotPermissionSet                 PermissionSet                 -- 8
-  | GotPasswordRecoverySent      PasswordRecoverySent      -- 9
+  | GotPasswordRecoverySent          PasswordRecoverySent          -- 9
-  | GotPasswordRecovered         PasswordRecovered         -- 10
+  | GotPasswordRecovered             PasswordRecovered             -- 10
-  | GotMatchingUsers             MatchingUsers             -- 11
+  | GotMatchingUsers                 MatchingUsers                 -- 11
-  | GotUserDeleted               UserDeleted               -- 12
+  | GotUserDeleted                   UserDeleted                   -- 12
-  | GotErrorMustBeAuthenticated  ErrorMustBeAuthenticated  -- 20
+  | GotErrorMustBeAuthenticated      ErrorMustBeAuthenticated      -- 20
-  | GotErrorAlreadyUsedLogin     ErrorAlreadyUsedLogin     -- 21
+  | GotErrorAlreadyUsedLogin         ErrorAlreadyUsedLogin         -- 21
-  | GotErrorMailRequired         ErrorMailRequired         -- 22
+  | GotErrorMailRequired             ErrorMailRequired             -- 22
-  | GotErrorUserNotFound         ErrorUserNotFound         -- 23
+  | GotErrorUserNotFound             ErrorUserNotFound             -- 23
-  | GotErrorPasswordTooShort     ErrorPasswordTooShort     -- 24
+  | GotErrorPasswordTooShort         ErrorPasswordTooShort         -- 24
-  | GotErrorInvalidCredentials   ErrorInvalidCredentials   -- 25
+  | GotErrorInvalidCredentials       ErrorInvalidCredentials       -- 25
-  | GotErrorRegistrationsClosed  ErrorRegistrationsClosed  -- 26
+  | GotErrorRegistrationsClosed      ErrorRegistrationsClosed      -- 26
-  | GotErrorInvalidLoginFormat   ErrorInvalidLoginFormat   -- 27
+  | GotErrorInvalidLoginFormat       ErrorInvalidLoginFormat       -- 27
-  | GotErrorInvalidEmailFormat   ErrorInvalidEmailFormat   -- 28
+  | GotErrorInvalidEmailFormat       ErrorInvalidEmailFormat       -- 28
-  | GotErrorAlreadyUsersInDB     ErrorAlreadyUsersInDB     -- 29
+  | GotErrorAlreadyUsersInDB         ErrorAlreadyUsersInDB         -- 29
-  | GotErrorReadOnlyProfileKeys  ErrorReadOnlyProfileKeys  -- 30
+  | GotErrorReadOnlyProfileKeys      ErrorReadOnlyProfileKeys      -- 30
-  | GotErrorInvalidActivationKey ErrorInvalidActivationKey -- 31
+  | GotErrorInvalidActivationKey     ErrorInvalidActivationKey     -- 31
-  | GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
+  | GotErrorUserAlreadyValidated     ErrorUserAlreadyValidated     -- 32
-  | GotErrorCannotContactUser    ErrorCannotContactUser    -- 33
+  | GotErrorCannotContactUser        ErrorCannotContactUser        -- 33
-  | GotErrorInvalidRenewKey      ErrorInvalidRenewKey      -- 34
+  | GotErrorInvalidRenewKey          ErrorInvalidRenewKey          -- 34
-  | GotErrorPasswordTooLong      ErrorPasswordTooLong      -- 35
+  | GotErrorPasswordTooLong          ErrorPasswordTooLong          -- 35
-  | GotKeepAlive                 KeepAlive                 -- 250
+  | GotErrorEmailAddressNotValidated ErrorEmailAddressNotValidated -- 36
+  | GotKeepAlive                     KeepAlive                     -- 250
 
 encode ∷ RequestMessage -> Tuple UInt String
 encode m = case m of
@@ -433,36 +443,37 @@ data DecodeError
 decode :: Int -> String -> Either DecodeError AnswerMessage
 decode number string
   = case number of
-    0   -> error_management codecGotError                     GotError
+    0   -> error_management codecGotError                         GotError
-    1   -> error_management codecGotToken                     GotToken
+    1   -> error_management codecGotToken                         GotToken
-    2   -> error_management codecGotUser                      GotUser
+    2   -> error_management codecGotUser                          GotUser
-    3   -> error_management codecGotUserAdded                 GotUserAdded
+    3   -> error_management codecGotUserAdded                     GotUserAdded
-    4   -> error_management codecGotUserEdited                GotUserEdited
+    4   -> error_management codecGotUserEdited                    GotUserEdited
-    5   -> error_management codecGotUserValidated             GotUserValidated
+    5   -> error_management codecGotUserValidated                 GotUserValidated
-    6   -> error_management codecGotUsersList                 GotUsersList
+    6   -> error_management codecGotUsersList                     GotUsersList
-    7   -> error_management codecGotPermissionCheck           GotPermissionCheck
+    7   -> error_management codecGotPermissionCheck               GotPermissionCheck
-    8   -> error_management codecGotPermissionSet             GotPermissionSet
+    8   -> error_management codecGotPermissionSet                 GotPermissionSet
-    9   -> error_management codecGotPasswordRecoverySent      GotPasswordRecoverySent
+    9   -> error_management codecGotPasswordRecoverySent          GotPasswordRecoverySent
-    10  -> error_management codecGotPasswordRecovered         GotPasswordRecovered
+    10  -> error_management codecGotPasswordRecovered             GotPasswordRecovered
-    11  -> error_management codecGotMatchingUsers             GotMatchingUsers
+    11  -> error_management codecGotMatchingUsers                 GotMatchingUsers
-    12  -> error_management codecGotUserDeleted               GotUserDeleted
+    12  -> error_management codecGotUserDeleted                   GotUserDeleted
-    20  -> error_management codecGotErrorMustBeAuthenticated  GotErrorMustBeAuthenticated
+    20  -> error_management codecGotErrorMustBeAuthenticated      GotErrorMustBeAuthenticated
-    21  -> error_management codecGotErrorAlreadyUsedLogin     GotErrorAlreadyUsedLogin
+    21  -> error_management codecGotErrorAlreadyUsedLogin         GotErrorAlreadyUsedLogin
-    22  -> error_management codecGotErrorMailRequired         GotErrorMailRequired
+    22  -> error_management codecGotErrorMailRequired             GotErrorMailRequired
-    23  -> error_management codecGotErrorUserNotFound         GotErrorUserNotFound
+    23  -> error_management codecGotErrorUserNotFound             GotErrorUserNotFound
-    24  -> error_management codecGotErrorPasswordTooShort     GotErrorPasswordTooShort
+    24  -> error_management codecGotErrorPasswordTooShort         GotErrorPasswordTooShort
-    25  -> error_management codecGotErrorInvalidCredentials   GotErrorInvalidCredentials
+    25  -> error_management codecGotErrorInvalidCredentials       GotErrorInvalidCredentials
-    26  -> error_management codecGotErrorRegistrationsClosed  GotErrorRegistrationsClosed
+    26  -> error_management codecGotErrorRegistrationsClosed      GotErrorRegistrationsClosed
-    27  -> error_management codecGotErrorInvalidLoginFormat   GotErrorInvalidLoginFormat
+    27  -> error_management codecGotErrorInvalidLoginFormat       GotErrorInvalidLoginFormat
-    28  -> error_management codecGotErrorInvalidEmailFormat   GotErrorInvalidEmailFormat
+    28  -> error_management codecGotErrorInvalidEmailFormat       GotErrorInvalidEmailFormat
-    29  -> error_management codecGotErrorAlreadyUsersInDB     GotErrorAlreadyUsersInDB
+    29  -> error_management codecGotErrorAlreadyUsersInDB         GotErrorAlreadyUsersInDB
-    30  -> error_management codecGotErrorReadOnlyProfileKeys  GotErrorReadOnlyProfileKeys
+    30  -> error_management codecGotErrorReadOnlyProfileKeys      GotErrorReadOnlyProfileKeys
-    31  -> error_management codecGotErrorInvalidActivationKey GotErrorInvalidActivationKey
+    31  -> error_management codecGotErrorInvalidActivationKey     GotErrorInvalidActivationKey
-    32  -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
+    32  -> error_management codecGotErrorUserAlreadyValidated     GotErrorUserAlreadyValidated
-    33  -> error_management codecGotErrorCannotContactUser    GotErrorCannotContactUser
+    33  -> error_management codecGotErrorCannotContactUser        GotErrorCannotContactUser
-    34  -> error_management codecGotErrorInvalidRenewKey      GotErrorInvalidRenewKey
+    34  -> error_management codecGotErrorInvalidRenewKey          GotErrorInvalidRenewKey
-    35  -> error_management codecGotErrorPasswordTooLong      GotErrorPasswordTooLong
+    35  -> error_management codecGotErrorPasswordTooLong          GotErrorPasswordTooLong
-    250 -> error_management codecGotKeepAlive                 GotKeepAlive
+    36  -> error_management codecGotErrorEmailAddressNotValidated GotErrorEmailAddressNotValidated
+    250 -> error_management codecGotKeepAlive                     GotKeepAlive
     _  -> Left UnknownNumber
   where
     -- Signature is required since the compiler's guess is wrong.

src/App/Page/Authentication.purs

@@ -298,11 +298,11 @@ handleAction = case _ of
         H.raise $ Log $ UnableToSend "Write your password!"
 
       _, _ -> do
-        case L.login login, P.password pass of
+        case L.login login, P.password_on_authentication_page pass of
           Left errors, _ -> H.modify_ _ { errors = [ Login    errors ] }
           _, Left errors -> H.modify_ _ { errors = [ Password errors ] }
-          _, _            -> do H.modify_ _ { errors = [] }
+          _, _           -> do H.modify_ _ { errors = [] }
-                                H.raise $ AuthenticateToAuthd (Tuple login pass)
+                               H.raise $ AuthenticateToAuthd (Tuple login pass)
         H.raise $ Log $ SystemLog $ "authenticate (login: " <> login <> ")"
 
   PasswordRecoveryAttempt ev -> do

src/App/Page/Registration.purs

@@ -2,7 +2,7 @@
 -- | Registration requires a login, an email address and a password.
 module App.Page.Registration where
 
-import Prelude (Unit, bind, discard, ($), (<<<), (<>), map)
+import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
@@ -17,6 +17,7 @@ import Web.Event.Event (Event)
 
 import Bulma as Bulma
 
+import Data.String as S
 import App.Type.Email as Email
 import App.Type.LogMessage
 import App.Message.AuthenticationDaemon as AuthD
@@ -94,17 +95,48 @@ render { registrationForm }
 
     render_register_form = HH.form
       [ HE.onSubmit ValidateInputs ]
-      [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
+      (login_input    <> login_error    <>
-          (HandleRegisterInput <<< REG_INP_login)      -- action
+       email_input    <> email_error    <>
-          registrationForm.login                       -- value
+       password_input <> password_error <>
-      , Bulma.box_input "emailREGISTER" "Email" "email@example.com"    -- title, placeholder
+       validation_btn)
-          (HandleRegisterInput <<< REG_INP_email)      -- action
+
-          registrationForm.email                       -- value
+    login_input
-      , Bulma.box_password "passwordREGISTER" "Password" "password"       -- title, placeholder
+      = [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
-          (HandleRegisterInput <<< REG_INP_pass)       -- action
+            (HandleRegisterInput <<< REG_INP_login)      -- action
-          registrationForm.pass                        -- value
+            registrationForm.login                       -- value
-      , Bulma.btn_validation
+        ]
-      ]
+
+    login_error
+      = case between 0 1 (S.length registrationForm.login), L.login registrationForm.login of
+          true, _        -> []
+          _, Left errors -> [ Bulma.error_box "loginREGISTER" "Login error" (show_error $ Login errors) ]
+          _, Right _     -> []
+
+    email_input
+      = [ Bulma.box_input "emailREGISTER" "Email" "email@example.com"    -- title, placeholder
+            (HandleRegisterInput <<< REG_INP_email)      -- action
+            registrationForm.email                       -- value
+        ]
+
+    email_error
+      = case between 0 5 (S.length registrationForm.email), E.email registrationForm.email of
+          true, _        -> []
+          _, Left errors -> [ Bulma.error_box "emailREGISTER" "Email error" (show_error $ Email errors) ]
+          _, Right _     -> []
+
+    password_input
+      = [ Bulma.box_password "passwordREGISTER" "Password" "password"       -- title, placeholder
+            (HandleRegisterInput <<< REG_INP_pass)       -- action
+            registrationForm.pass                        -- value
+        ]
+
+    password_error
+      = case between 0 15 (S.length registrationForm.pass), P.password registrationForm.pass of
+          true, _        -> []
+          _, Left errors -> [ Bulma.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ]
+          _, Right _     -> []
+
+    validation_btn = [ Bulma.btn_validation ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of

src/App/Page/Setup.purs

@@ -5,6 +5,7 @@ module App.Page.Setup where
 import Prelude (Unit, bind, discard, pure, ($), (<<<), (==), (<>), show, map)
 
 import Data.Array as A
+import Data.Tuple (Tuple(..))
 import Data.Maybe (Maybe(..), maybe)
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
@@ -15,15 +16,20 @@ import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
 import Bulma as Bulma
+import CSSClasses as C
 
+import App.Type.Email as Email
+import App.Validation.Email as E
 import App.Validation.Password as P
 
 import App.Type.LogMessage
 import App.Message.AuthenticationDaemon as AuthD
+import App.DisplayErrors (show_error_email)
 
 data Output
   = Log LogMessage
   | ChangePassword String
+  | ChangeEmailAddress Email.Email
   | DeleteUserAccount
 
 -- | The component's parent provides received messages.
@@ -32,7 +38,7 @@ data Query a
 
 type Slot = H.Slot Query Output
 
-type Input = String
+type Input = Tuple (Maybe Email.Email) (Maybe Email.Email)
 
 data AuthenticationInput
   = AUTH_INP_login String
@@ -43,9 +49,14 @@ data NewPasswordInput
   | NEWPASS_INP_confirmation String
 
 data Action
-  = HandleNewPassword NewPasswordInput
+  = HandleNewPassword NewPasswordInput  -- user input
-  | ChangePasswordAttempt Event
+  | ChangePasswordAttempt Event         -- validation
-  | SendChangePasswordMessage
+  | SendChangePasswordMessage           -- sends the message
+
+  | HandleNewEmail String               -- user input
+  | ChangeEmailAttempt Event            -- validation
+  | SendChangeEmailAddressMessage       -- sends the message
+
   | CancelModal
   | DeleteAccountPopup
   | DeleteAccount
@@ -57,9 +68,10 @@ data Modal
   | DeleteAccountModal
 
 type State =
-  { newPasswordForm :: StateNewPasswordForm
+  { newPasswordForm       :: StateNewPasswordForm
-  , token           :: String
+  , new_email_address     :: String
-  , modal           :: Modal
+  , emails                :: Tuple (Maybe Email.Email) (Maybe Email.Email)
+  , modal                 :: Modal
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -74,18 +86,22 @@ component =
     }
 
 initialState :: Input -> State
-initialState token =
+initialState emails =
   { newPasswordForm: { password: "", confirmation: "" }
-  , token
+  , new_email_address: ""
+  , emails
   , modal: NoModal
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { modal, newPasswordForm } =
+render { modal, newPasswordForm, new_email_address, emails } =
   Bulma.section_small
-    [ case modal of
+    [ render_emails emails
+    , Bulma.hr
+    , case modal of
         DeleteAccountModal -> render_delete_account_modal
-        NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change password", render_new_password_form ]
+        NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change email address", render_new_email_form ]
+                                  , b [ Bulma.h3 "Change password", render_new_password_form ]
                                   , b [ Bulma.h3 "Delete account", render_delete_account ]
                                   ]
     ]
@@ -93,7 +109,24 @@ render { modal, newPasswordForm } =
   where
   b e = Bulma.column_ e
 
+  render_emails (Tuple current pending) = HH.div [] $ render_current current <> render_pending pending
+    where
+    render_current (Just (Email.Email e)) = [ Bulma.p $ "Current email address: " ] <>
+                                            [ Bulma.btn_ro (C.is_small <> C.is_warning) e]
+    render_current Nothing                = [ Bulma.p   "You do not currently have a validated email address!" ]
+
+    render_pending (Just (Email.Email e)) = [ Bulma.p $ "Pending email address: " ] <>
+                                            [ Bulma.btn_ro (C.is_small <> C.is_warning) e]
+    render_pending Nothing                = []
+
   render_delete_account = Bulma.alert_btn "Delete my account" DeleteAccountPopup
+
+  render_new_email_form = HH.form
+    [ HE.onSubmit ChangeEmailAttempt ]
+    [ Bulma.box_input "emailAddress" "New email address" "foo@bar.com" HandleNewEmail new_email_address
+    , Bulma.btn_validation
+    ]
+
   render_new_password_form = HH.form
     [ HE.onSubmit ChangePasswordAttempt ]
     [ Bulma.box_password "passwordNEWPASS" "New Password" "password"
@@ -120,6 +153,9 @@ handleAction = case _ of
       NEWPASS_INP_password     v -> H.modify_ _ { newPasswordForm { password = v } }
       NEWPASS_INP_confirmation v -> H.modify_ _ { newPasswordForm { confirmation = v } }
 
+  HandleNewEmail email_address -> do
+    H.modify_ _ { new_email_address = email_address }
+
   CancelModal -> do
     H.modify_ _ { modal = NoModal }
   DeleteAccountPopup -> do
@@ -128,6 +164,17 @@ handleAction = case _ of
     H.raise $ DeleteUserAccount
     handleAction $ CancelModal
 
+  ChangeEmailAttempt ev -> do
+    H.liftEffect $ Event.preventDefault ev
+
+    { new_email_address } <- H.get
+    case new_email_address of
+      "" -> H.raise $ Log $ UnableToSend "Write your new email address!"
+      email_address -> do
+        case E.email email_address of
+          Left errors -> H.raise $ Log $ UnableToSend $ A.fold $ map show_error_email errors
+          Right _     -> handleAction SendChangeEmailAddressMessage
+
   ChangePasswordAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
 
@@ -142,6 +189,11 @@ handleAction = case _ of
                Right _     -> handleAction SendChangePasswordMessage
         else H.raise $ Log $ UnableToSend "Confirmation differs from password"
 
+  SendChangeEmailAddressMessage -> do
+    state <- H.get
+    H.raise $ Log $ SystemLog "Changing the email address"
+    H.raise $ ChangeEmailAddress (Email.Email state.new_email_address)
+
   SendChangePasswordMessage -> do
     state <- H.get
     H.raise $ Log $ SystemLog "Changing the password"

src/App/Page/Zone.purs

@@ -8,8 +8,6 @@
 -- | **WIP**: Display relevant information for each record type in the (add/mod) modal.
 -- | This includes explaining use cases and displaying an appropriate interface for the task at hand.
 -- |
--- | TODO: CAA records.
--- |
 -- | TODO: display errors not only for a record but for the whole zone.
 -- | A DNS zone is bound by a set of rules, the whole zone must be consistent.
 -- | For example, a CNAME `target` has to point to the `name` of an existing record.
@@ -30,6 +28,7 @@ import Web.HTML.Window (sessionStorage) as Window
 import Web.Storage.Storage as Storage
 
 import App.Validation.Email as Email
+import App.Type.CAA as CAA
 
 import Data.Eq (class Eq)
 import Data.Array as A
@@ -108,6 +107,9 @@ data Field
   | Field_SPF_modifiers  (Array RR.Modifier)
   | Field_SPF_q          RR.Qualifier
 
+  | Field_CAA_flag  String
+  | Field_CAA_value String
+
 -- | Steps to create a new RR:
 -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
 -- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
@@ -169,6 +171,8 @@ data Action
   -- | Ask `dnsmanagerd` for the generated zone file.
   | AskZoneFile
 
+  | CAA_tag Int
+
   | SPF_Mechanism_q Int
   | SPF_Mechanism_t Int
   | SPF_Mechanism_v String
@@ -225,20 +229,6 @@ data RRModal
   | UpdateRRModal
   | RemoveRRModal RRId
 
-string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
-string_to_acceptedtype str = case str of
-  "A"     -> Just     A
-  "AAAA"  -> Just  AAAA
-  "TXT"   -> Just   TXT
-  "CNAME" -> Just CNAME
-  "NS"    -> Just    NS
-  "MX"    -> Just    MX
-  "SRV"   -> Just   SRV
-  "SPF"   -> Just   SPF
-  "DKIM"  -> Just  DKIM
-  "DMARC" -> Just DMARC
-  _       -> Nothing
-
 data Tab = Zone | TheBasics | TokenExplanation
 derive instance eqTab :: Eq Tab
 derive instance genericTab :: Generic Tab _
@@ -302,6 +292,7 @@ default_empty_rr :: ResourceRecord
 default_empty_rr = default_rr_A
 
 default_qualifier_str = "hard_fail" :: String
+default_caa = { flag: 0, tag: CAA.Issue, value: "" } :: CAA.CAA
 
 initialState :: Input -> State
 initialState domain =
@@ -395,6 +386,7 @@ render state
       "CNAME" -> template (modal_content_simple CNAME) (foot_content CNAME)
       "NS"    -> template (modal_content_simple NS)    (foot_content NS)
       "MX"    -> template modal_content_mx     (foot_content MX)
+      "CAA"   -> template modal_content_caa    (foot_content CAA)
       "SRV"   -> template modal_content_srv    (foot_content SRV)
       "SPF"   -> template modal_content_spf    (foot_content SPF)
       "DKIM"  -> template modal_content_dkim   (foot_content DKIM)
@@ -426,7 +418,7 @@ render state
           ] <> case state.rr_modal of
                  UpdateRRModal ->
                    if A.elem state._currentRR.rrtype ["A", "AAAA"]
-                   then [ Bulma.labeled_field ("token" <> state._currentRR.rrtype) "Token"
+                   then [ Bulma.field_entry ("token" <> state._currentRR.rrtype) "Token"
                             (Bulma.p $ fromMaybe "❌​" state._currentRR.token)
                         ]
                    else []
@@ -458,6 +450,27 @@ render state
               (updateForm Field_Priority)
               (maybe "" show state._currentRR.priority)
           ]
+        modal_content_caa :: Array (HH.HTML w Action)
+        modal_content_caa =
+          [ render_errors
+          , Bulma.div_content [] [Bulma.explanation Explanations.caa_introduction]
+          , Bulma.input_with_side_text "domainCAA" "Name" "www"
+              (updateForm Field_Domain)
+              state._currentRR.name
+              display_domain_side
+          , Bulma.box_input ("ttlCAA") "TTL" "600"
+              (updateForm Field_TTL)
+              (show state._currentRR.ttl)
+          , Bulma.hr
+          , Bulma.box_input ("flagCAA") "Flag" ""
+              (updateForm Field_CAA_flag)
+              (show (fromMaybe default_caa state._currentRR.caa).flag)
+          , Bulma.selection_field'' "tagCAA" "Tag" CAA_tag (A.zip CAA.tags_txt CAA.tags_raw)
+            CAA.Issue
+            (Just (fromMaybe default_caa state._currentRR.caa).tag)
+          , Bulma.box_input "valueCAA" "Value" "" (updateForm Field_CAA_value)
+            (fromMaybe default_caa state._currentRR.caa).value
+          ]
         modal_content_srv :: Array (HH.HTML w Action)
         modal_content_srv =
           [ Bulma.div_content [] [Bulma.explanation Explanations.srv_introduction]
@@ -683,6 +696,7 @@ handleAction = case _ of
         default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
         default_rr_NS    = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." }
         default_rr_MX    = emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
+        default_rr_CAA   = emptyRR { rrtype = "CAA", name = "", caa = Just default_caa }
         default_rr_SRV   = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
                                    , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
         default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
@@ -700,6 +714,7 @@ handleAction = case _ of
       CNAME -> H.modify_ _ { _currentRR = default_rr_CNAME }
       NS    -> H.modify_ _ { _currentRR = default_rr_NS }
       MX    -> H.modify_ _ { _currentRR = default_rr_MX }
+      CAA   -> H.modify_ _ { _currentRR = default_rr_CAA }
       SRV   -> H.modify_ _ { _currentRR = default_rr_SRV }
       SPF   -> H.modify_ _ { _currentRR = default_rr_SPF }
       DKIM  -> H.modify_ _ { _currentRR = default_rr_DKIM }
@@ -837,6 +852,11 @@ handleAction = case _ of
       $ DNSManager.MkAskGeneratedZoneFile { domain: state._domain }
     H.raise $ MessageToSend message
 
+  CAA_tag         v -> do
+    state <- H.get
+    let new_caa = (fromMaybe default_caa state._currentRR.caa) { tag = fromMaybe CAA.Issue $ CAA.tags A.!! v }
+    H.modify_ _ { _currentRR { caa = Just new_caa } }
+
   SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass"     id $ qualifier_types A.!! v }
   SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a"        id $ mechanism_types A.!! v }
   SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v                                            }
@@ -1008,6 +1028,7 @@ render_resources records
          (rr_box tag_soa       bg_color_ro Bulma.soa_table_header       table_content        all_soa_rr)
       <> (rr_box tag_basic     []          Bulma.simple_table_header    table_content_w_seps all_basic_rr)
       <> (rr_box tag_mx        []          Bulma.mx_table_header        table_content        all_mx_rr)
+      <> (rr_box tag_caa       []          Bulma.caa_table_header       table_content        all_caa_rr)
       <> (rr_box tag_srv       []          Bulma.srv_table_header       table_content        all_srv_rr)
       <> (rr_box tag_spf       []          Bulma.spf_table_header       table_content        all_spf_rr)
       <> (rr_box tag_dkim      []          Bulma.dkim_table_header      table_content        all_dkim_rr)
@@ -1019,6 +1040,7 @@ render_resources records
   all_XX_rr str   = A.filter (\rr -> rr.rrtype == str) records
   all_soa_rr      = all_XX_rr "SOA"
   all_mx_rr       = all_XX_rr "MX"
+  all_caa_rr      = all_XX_rr "CAA"
   all_srv_rr      = all_XX_rr "SRV"
   all_spf_rr      = all_XX_rr "SPF"
   all_dkim_rr     = all_XX_rr "DKIM"
@@ -1027,6 +1049,7 @@ render_resources records
   tag_soa      = tags [tag_ro "SOA", tag_ro "read only"]
   tag_basic    = tags [tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"]
   tag_mx       = tags [tag "MX"]
+  tag_caa      = tags [tag "CAA"]
   tag_srv      = tags [tag "SRV"]
   tag_spf      = tags [tag "SPF"]
   tag_dkim     = tags [tag "DKIM"]
@@ -1087,6 +1110,19 @@ render_resources records
           then HH.td_ [ Bulma.btn_readonly ]
           else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
+      "CAA"  ->
+        [ HH.td_ [ Bulma.p rr.name ]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        ] <> case rr.caa of
+          Just caa ->
+            [ HH.td_ [ Bulma.p $ show caa.flag ]
+            , HH.td_ [ Bulma.p $ show caa.tag ]
+            , HH.td_ [ Bulma.p caa.value ]
+            , if rr.readonly
+              then HH.td_ [ Bulma.btn_readonly ]
+              else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+            ]
+          Nothing -> [Bulma.p "Problem: there is no CAA data." ]
       "SPF"  ->
         [ HH.td_ [ Bulma.p rr.name ]
         , HH.td_ [ Bulma.p $ show rr.ttl ]
@@ -1224,10 +1260,11 @@ render_new_records _
           , Bulma.btn   "SRV" (CreateNewRRModal SRV)
           ] []
       , Bulma.hr
-      , Bulma.h1 "Special records about the mail system"
+      , Bulma.h1 "Special records about certifications and the mail system"
       -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
       , Bulma.level [
-            Bulma.btn "SPF"   (CreateNewRRModal SPF)
+            Bulma.btn "CAA"   (CreateNewRRModal CAA)
+          , Bulma.btn "SPF"   (CreateNewRRModal SPF)
           , Bulma.btn "DKIM"  (CreateNewRRModal DKIM)
           , Bulma.btn "DMARC" (CreateNewRRModal DMARC)
           ] []
@@ -1270,6 +1307,14 @@ update_field rr updated_field = case updated_field of
   Field_SPF_modifiers val    -> rr { modifiers  = Just val }
   Field_SPF_q val            -> rr { q          = Just val }
 
+  Field_CAA_flag val ->
+    let new_caa = (fromMaybe default_caa rr.caa) { flag = fromMaybe 0 $ fromString val }
+    in rr { caa = Just new_caa }
+
+  Field_CAA_value val ->
+    let new_caa = (fromMaybe default_caa rr.caa) { value = val }
+    in rr { caa = Just new_caa }
+
 attach_id :: forall a. Int -> Array a -> Array (Tuple Int a)
 attach_id _ []  = []
 attach_id i arr = case A.head arr of

src/App/Text/Explanations.purs

@@ -259,6 +259,26 @@ ns_introduction =
   , Bulma.notification_danger' "🚨 Advice for beginners: do not use this resource record."
   ]
 
+caa_introduction :: forall w i. Array (HH.HTML w i)
+caa_introduction =
+  [ Bulma.p """
+    The CAA record enables to specify a certification authority that is authorized to issue certificates for the domain.
+    The idea is to reduce the risk of unintended certificate mis-issue.
+    """
+  , Bulma.p """
+    Certification authorities (CA) may issue certificates for any domain.
+    Thus, any CA may provide certificates for a domain (let's say google.com) to any hacker that can now impersonate the domain.
+    The CAA record allows to say what is the authorized CA for the domain, preventing this kind of attacks.
+    """
+  -- , HH.p []
+  --   [ HH.text "🚨 "
+  --   , HH.u_ [HH.text "Advice for beginners"]
+  --   , HH.text ":"
+  --   , HH.text """
+  --     """
+  --   ]
+  ]
+
 dkim_introduction :: forall w i. Array (HH.HTML w i)
 dkim_introduction =
   [ Bulma.p """

src/App/Type/AcceptedRRTypes.purs

@@ -14,6 +14,7 @@ data AcceptedRRTypes
   | CNAME
   | NS
   | MX
+  | CAA
   | SRV
   | SPF
   | DKIM

src/App/Type/CAA.purs

@@ -0,0 +1,57 @@
+-- | The Certification Authority Authorization (CAA) record is described in RFC8859.
+-- | The CAA record allows to specify Certification Authorities (CAs) authorized to issue certificates.
+module App.Type.CAA where
+
+import Prelude
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+
+import App.Type.GenericSerialization (generic_serialization)
+import Data.Maybe (Maybe(..))
+
+import Data.Codec.Argonaut (JsonCodec)
+import Data.Codec.Argonaut as CA
+import Data.Codec.Argonaut.Record as CAR
+
+-- | Flag: integer from 0 to 255.
+type CAA = { flag :: Int, tag :: Tag, value :: String }
+
+emptyCAARR :: CAA
+emptyCAARR = { flag: 0, tag: Issue, value: "" }
+
+codec :: JsonCodec CAA
+codec = CA.object "CAA" (CAR.record { flag: CA.int, tag: codecTag, value: CA.string })
+
+data Tag = Issue | IssueWild | IOdef | ContactEmail | ContactPhone
+
+tags :: Array Tag
+tags = [Issue, IssueWild, IOdef, ContactEmail, ContactPhone]
+
+tags_raw :: Array String
+tags_raw = map show tags
+
+tags_txt :: Array String
+tags_txt
+  = [ "Issue"
+    , "Issue for wildcard certificate requests"
+    , "Incident object description exchange format"
+    , "Contact email"
+    , "Contact phone"
+    ]
+
+-- | Codec for just encoding a single value of type `ReportOccasion`.
+codecTag :: CA.JsonCodec Tag
+codecTag = CA.prismaticCodec "Tag" str_to_tag generic_serialization CA.string
+
+str_to_tag :: String -> Maybe Tag
+str_to_tag = case _ of
+  "issue"        -> Just Issue
+  "issuewild"    -> Just IssueWild
+  "iodef"        -> Just IOdef
+  "contactemail" -> Just ContactEmail
+  "contactphone" -> Just ContactPhone
+  _ -> Nothing
+
+derive instance genericTag :: Generic Tag _
+instance showTag :: Show Tag where
+  show = genericShow

src/App/Type/DomainInfo.purs

@@ -1,8 +1,6 @@
 module App.Type.DomainInfo where
 
-import Prelude ((<>), map, bind, pure)
+import Data.Maybe (Maybe(..))
-
-import Data.Maybe (Maybe(..), maybe)
 
 import Data.Codec.Argonaut (JsonCodec)
 import Data.Codec.Argonaut as CA

src/App/Type/ResourceRecord.purs

@@ -10,6 +10,7 @@ import Data.Codec.Argonaut.Record as CAR
 
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
+import App.Type.CAA as CAA
 
 type ResourceRecord
   = { rrtype   :: String
@@ -46,8 +47,7 @@ type ResourceRecord
 
     , dkim :: Maybe DKIM.DKIM
     , dmarc :: Maybe DMARC.DMARC
-
+    , caa :: Maybe CAA.CAA
-    -- TODO: DMARC specific entries.
     }
 
 codec :: JsonCodec ResourceRecord
@@ -87,6 +87,7 @@ codec = CA.object "ResourceRecord"
 
     , dkim:       CAR.optional DKIM.codec
     , dmarc:      CAR.optional DMARC.codec
+    , caa:        CAR.optional CAA.codec
     })
 
 type Mechanism
@@ -229,6 +230,7 @@ emptyRR
 
     , dkim:         Nothing
     , dmarc:        Nothing
+    , caa:          Nothing
     }
 
 data Qualifier = Pass | Neutral | SoftFail | HardFail

src/App/Validation/DNS.purs

@@ -21,6 +21,7 @@ import GenericParser.RFC5234 as RFC5234
 
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
+import App.Type.CAA as CAA
 
 -- | **History:**
 -- | The module once used dedicated types for each type of RR.
@@ -55,6 +56,8 @@ data Error
   | VEDMARCpct Int Int Int
   | VEDMARCri  Int Int Int
 
+  | VECAAflag  Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
+
   -- SPF
   | VESPFMechanismName (G.Error DomainParser.DomainError)
   | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
@@ -326,6 +329,20 @@ validationDMARC form =
                , name = name, ttl = ttl, target = "" -- `target` is discarded!
                , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
 
+validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationCAA form =
+  let caa = fromMaybe CAA.emptyCAARR form.caa
+  in ado
+    name     <- parse DomainParser.sub_eof form.name  VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl   VETTL
+    flag     <- is_between 0 255           caa.flag   VECAAflag
+    -- TODO: verify the `value` field.
+    -- No need to validate the target, actually, it will be completely discarded.
+    -- The different specific entries replace `target` completely.
+    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
+               , name = name, ttl = ttl, target = "" -- `target` is discarded!
+               , caa = Just $ caa { flag = flag } }
+
 validation :: ResourceRecord -> Either (Array Error) ResourceRecord
 validation entry = case entry.rrtype of
   "A"     -> toEither $ validationA     entry
@@ -334,6 +351,7 @@ validation entry = case entry.rrtype of
   "CNAME" -> toEither $ validationCNAME entry
   "NS"    -> toEither $ validationNS    entry
   "MX"    -> toEither $ validationMX    entry
+  "CAA"   -> toEither $ validationCAA   entry
   "SRV"   -> toEither $ validationSRV   entry
   "SPF"   -> toEither $ validationSPF   entry
   "DKIM"  -> toEither $ validationDKIM  entry

src/App/Validation/Login.purs

@@ -32,12 +32,15 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
 login_parser :: G.Parser LoginParsingError String
 login_parser = do
   input <- G.current_input
-  _ <- G.many1 (alpha <|> digit) G.<:> \_ -> CannotParse
+  _ <- (alpha <|> digit) G.<:> \_ -> CannotParse
-  _ <- SomeParsers.eof           G.<:> \_ -> CannotEntirelyParse
+  _ <- G.many1 (alpha <|> digit <|> G.char ' ' <|> G.char '_' <|> G.char '\'' <|> G.char '-') G.<:> \_ -> CannotParse
+  _ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse
+  let last_char_correct = G.parse_last_char input.string (alpha <|> digit)
   pos <- G.current_position
-  if between min_login_size max_login_size pos
+  case between min_login_size max_login_size pos, last_char_correct of
-  then pure input.string
+    false, _     -> G.errorParser (Just $ Size min_login_size max_login_size pos)
-  else G.errorParser (Just $ Size min_login_size max_login_size pos)
+    true, false  -> G.errorParser (Just $ CannotParse)
+    _, _         -> pure input.string
 
 login :: String -> Either (Array Error) String
 login s = toEither $ parse login_parser s ParsingError

src/App/Validation/Password.purs

@@ -21,10 +21,15 @@ data Error
   = ParsingError (G.Error PasswordParsingError)
 
 min_password_size :: Int
-min_password_size = 2
+min_password_size = 15
 max_password_size :: Int
 max_password_size = 100
 
+min_password_size_auth :: Int
+min_password_size_auth = 0
+max_password_size_auth :: Int
+max_password_size_auth = 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]
@@ -32,12 +37,28 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
 
 password_parser :: G.Parser PasswordParsingError String
 password_parser = do
-  l <- G.many1 vchar <|> G.Parser \i -> G.failureError i.position (Just CannotParse)
+  l <- G.many1 (vchar <|> G.char ' ') G.<:> \_ -> CannotParse
-  _ <- SomeParsers.eof <|> G.Parser \i -> G.failureError i.position (Just CannotEntirelyParse)
+  _ <- SomeParsers.eof                G.<:> \_ -> CannotEntirelyParse
   pos <- G.current_position
-  if pos < min_password_size || pos > max_password_size
+  if between min_password_size max_password_size pos
-  then G.Parser \i -> G.failureError i.position (Just $ Size min_password_size max_password_size pos)
+  then pure $ CU.fromCharArray l
-  else pure $ CU.fromCharArray l
+  else G.Parser \i -> G.failureError i.position (Just $ Size min_password_size max_password_size pos)
+
+-- The only change actually is the size of the accepted password.
+password_auth_parser :: G.Parser PasswordParsingError String
+password_auth_parser = do
+  l <- G.many1 (vchar <|> G.char ' ') G.<:> \_ -> CannotParse
+  _ <- SomeParsers.eof                G.<:> \_ -> CannotEntirelyParse
+  pos <- G.current_position
+  if between min_password_size_auth max_password_size_auth pos
+  then pure $ CU.fromCharArray l
+  else G.Parser \i -> G.failureError i.position (Just $ Size min_password_size_auth max_password_size_auth pos)
 
 password :: String -> Either (Array Error) String
 password s = toEither $ parse password_parser s ParsingError
+
+-- | The password on the authentication page is a little different because
+-- | migrated accounts may not follow the rules for new clients as seen on the
+-- | registration page.
+password_on_authentication_page :: String -> Either (Array Error) String
+password_on_authentication_page s = toEither $ parse password_auth_parser s ParsingError

src/Bulma.purs

@@ -2,6 +2,7 @@
 module Bulma where
 import Prelude
 
+import Data.Maybe (Maybe, fromMaybe)
 import Data.Tuple (Tuple, fst, snd)
 import Halogen.HTML as HH
 import DOM.HTML.Indexed as DHI
@@ -136,6 +137,17 @@ mx_table_header
                        ]
               ]
 
+caa_table_header :: forall w i. HH.HTML w i
+caa_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
+                       , HH.th_ [ HH.text "TTL"   ]
+                       , HH.th_ [ HH.text "Flag" ]
+                       , HH.th_ [ HH.text "Tag" ]
+                       , HH.th_ [ HH.text "Value" ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
 srv_table_header :: forall w i. HH.HTML w i
 srv_table_header
   = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
@@ -290,46 +302,56 @@ render_input password id placeholder action value cond
         false -> []
         true -> [ HP.type_ HP.InputPassword ]
 
-div_field :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+-- | Bulma's `field`, which contains an array of `Halogen.HTML` entries.
-div_field = HH.div [HP.classes (C.field <> C.is_horizontal)]
+-- | Two entries are expected: a field label (`div_field_label`) and a field content (`div_field_content`).
+div_field :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+div_field classes = HH.div [HP.classes (C.field <> C.is_horizontal <> classes)]
 
+-- | Field label (id and title) for a Bulma `field`.
 div_field_label :: forall w i. String -> String -> HH.HTML w i
 div_field_label id title = HH.div [HP.classes (C.field_label <> C.normal)]
                                   [HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
 
+-- | Any `Halogen.HTML` data in Bulma `field-body > field > control` divs.
 div_field_content :: forall w i. HH.HTML w i -> HH.HTML w i
 div_field_content content
   = HH.div [ HP.classes C.field_body ]
            [ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]
 
+-- | Basic field entry with a title and a field content.
+field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
+field_entry id title entry
+  = div_field []
+      [ div_field_label id title
+      , div_field_content entry
+      ]
+
+-- | Error field entry with a title and a field content.
+error_field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
+error_field_entry id title entry
+  = div_field C.has_background_danger_light
+      [ div_field_label id title
+      , div_field_content entry
+      ]
+
+error_box :: forall w i. String -> String -> String -> HH.HTML w i
+error_box id title value = error_field_entry id title $ notification_danger' value
+
 field_inner :: forall w i.
   Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
 field_inner ispassword cond id title placeholder action value
-  = div_field
+  = field_entry id title $ render_input ispassword id placeholder action value cond
-      [ div_field_label id title
-      , div_field_content $ render_input ispassword id placeholder action value cond
-      ]
 
 div_field_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
 div_field_ classes = HH.div [ HP.classes (C.field <> classes) ]
 
 btn_labeled :: forall w i. String -> String -> String -> i -> HH.HTML w i
 btn_labeled id title button_text action
-  = div_field
+  = field_entry id title $ HH.button
-      [ div_field_label id title
+      [ HE.onClick \_ -> action
-      , div_field_content $ HH.button
+      , HP.classes $ C.button <> C.is_small <> C.is_info
-          [ HE.onClick \_ -> action
+      , HP.id id
-          , HP.classes $ C.button <> C.is_small <> C.is_info
+      ] [ HH.text button_text ]
-          , HP.id id
-          ] [ HH.text button_text ]
-      ]
-
-labeled_field :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
-labeled_field id title content
-  = div_field
-      [ div_field_label id title
-      , div_field_content content
-      ]
 
 box_input_ :: forall w i.
   (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
@@ -529,18 +551,19 @@ selection action values selected = HH.div [HP.classes $ C.select <> C.is_normal]
 
 selection_field :: forall w i. String -> String -> (Int -> i) -> Array String -> String -> HH.HTML w i
 selection_field id title action values selected
-  = div_field
+  = field_entry id title $ selection action values selected
-      [ div_field_label id title
-      , div_field_content $ selection action values selected
-      ]
 
 selection_field' :: forall w i.
   String -> String -> (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
 selection_field' id title action values selected
-  = div_field
+  = field_entry id title $ selection' action values selected
-      [ div_field_label id title
+
-      , div_field_content $ selection' action values selected
+selection_field'' :: forall w i t. Show t =>
-      ]
+  String -> String -> (Int -> i) -> Array (Tuple String String) -> t -> Maybe t -> HH.HTML w i
+selection_field'' id title action values default_value selected
+  = field_entry id title $ selection' action values selected_value
+  where
+  selected_value = (show $ fromMaybe default_value selected)
 
 -- | selection': as `selection` but takes an array of tuple as values.
 -- | First value in the tuple is what to display, the second one is what to match on.