TODO.md

@@ -1,43 +0,0 @@
-# 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

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

src/App/Container.purs

@@ -178,7 +178,6 @@ 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
@@ -230,7 +229,6 @@ 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
@@ -274,8 +272,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.user_data of
-                     Just user_data -> HH.slot _setupi unit SetupInterface.component user_data SetupInterfaceEvent
+    render_setup = case state.token of
+                     Just token -> HH.slot _setupi unit SetupInterface.component token 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
@@ -304,10 +302,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 "wss://beta.netlib.re/ws/authd" AuthenticationDaemonEvent
+    render_auth_WS = HH.slot _ws_auth unit WS.component "ws://127.0.0.1:8080" AuthenticationDaemonEvent
 
     render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "wss://beta.netlib.re/ws/dnsmanagerd" DNSManagerDaemonEvent
+    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "ws://127.0.0.1:8081" DNSManagerDaemonEvent
 
 handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
 handleAction = case _ of
@@ -433,14 +431,6 @@ 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
@@ -547,11 +537,6 @@ 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
@@ -630,8 +615,7 @@ handleAction = case _ of
           -- The authentication was a success!
           (AuthD.GotToken msg) -> do
             handleAction $ Log $ SuccessLog $ "Authenticated to authd."
-            H.modify_ _ { token = Just msg.token
-                        , user_data = Just (Tuple msg.current_email msg.pending_email) }
+            H.modify_ _ { token = Just msg.token }
             handleAction $ ToggleAuthenticated (Just msg.token)
 
             sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window

src/App/DisplayErrors.purs

@@ -46,9 +46,6 @@ 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
@@ -84,7 +81,6 @@ 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"
@@ -175,7 +171,7 @@ show_error_title_label v = case v of
 
 show_error_login :: L.Error -> String
 show_error_login = case _ of
-  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
+  L.ParsingError {error} -> maybe "" string_error_login error
 
 string_error_login :: L.LoginParsingError -> String
 string_error_login = case _ of
@@ -187,7 +183,7 @@ string_error_login = case _ of
 
 show_error_email :: E.Error -> String
 show_error_email = case _ of
-  E.ParsingError {error} -> maybe "invalid email address" string_error_email error
+  E.ParsingError {error} -> maybe "" string_error_email error
 
 string_error_email :: E.EmailParsingError -> String
 string_error_email = case _ of
@@ -199,7 +195,7 @@ string_error_email = case _ of
 
 show_error_password :: P.Error -> String
 show_error_password = case _ of
-  P.ParsingError {error} -> maybe "invalid password, it should contain between 15 and 100 characters (ASCII)" string_error_password error
+  P.ParsingError {error} -> maybe "" string_error_password error
 
 string_error_password :: P.PasswordParsingError -> String
 string_error_password = case _ of

src/App/Message/AuthenticationDaemon.purs

@@ -186,13 +186,9 @@ codecGotError ∷ CA.JsonCodec Error
 codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
 
 {- 1  -}
-type Logged = { uid :: Int, token :: String, current_email :: Maybe Email.Email, pending_email :: Maybe Email.Email }
+type Logged = { uid :: Int, token :: String }
 codecGotToken ∷ CA.JsonCodec Logged
-codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int
-                                               , "token": CA.string
-                                               , current_email: CAR.optional Email.codec
-                                               , pending_email: CAR.optional Email.codec
-                                               })
+codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int, "token": CA.string })
 
 {- 2  -}
 type User = { user :: UserPublic.UserPublic }
@@ -348,11 +344,6 @@ 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
@@ -379,37 +370,36 @@ data RequestMessage
 
 -- All possible answers from the authentication daemon (authd).
 data AnswerMessage
-  = GotError                         Error                         -- 0
-  | GotToken                         Logged                        -- 1
-  | GotUser                          User                          -- 2
-  | GotUserAdded                     UserAdded                     -- 3
-  | GotUserEdited                    UserEdited                    -- 4
-  | GotUserValidated                 UserValidated                 -- 5
-  | GotUsersList                     UsersList                     -- 6
-  | GotPermissionCheck               PermissionCheck               -- 7
-  | GotPermissionSet                 PermissionSet                 -- 8
-  | GotPasswordRecoverySent          PasswordRecoverySent          -- 9
-  | GotPasswordRecovered             PasswordRecovered             -- 10
-  | GotMatchingUsers                 MatchingUsers                 -- 11
-  | GotUserDeleted                   UserDeleted                   -- 12
-  | GotErrorMustBeAuthenticated      ErrorMustBeAuthenticated      -- 20
-  | GotErrorAlreadyUsedLogin         ErrorAlreadyUsedLogin         -- 21
-  | GotErrorMailRequired             ErrorMailRequired             -- 22
-  | GotErrorUserNotFound             ErrorUserNotFound             -- 23
-  | GotErrorPasswordTooShort         ErrorPasswordTooShort         -- 24
-  | GotErrorInvalidCredentials       ErrorInvalidCredentials       -- 25
-  | GotErrorRegistrationsClosed      ErrorRegistrationsClosed      -- 26
-  | GotErrorInvalidLoginFormat       ErrorInvalidLoginFormat       -- 27
-  | GotErrorInvalidEmailFormat       ErrorInvalidEmailFormat       -- 28
-  | GotErrorAlreadyUsersInDB         ErrorAlreadyUsersInDB         -- 29
-  | GotErrorReadOnlyProfileKeys      ErrorReadOnlyProfileKeys      -- 30
-  | GotErrorInvalidActivationKey     ErrorInvalidActivationKey     -- 31
-  | GotErrorUserAlreadyValidated     ErrorUserAlreadyValidated     -- 32
-  | GotErrorCannotContactUser        ErrorCannotContactUser        -- 33
-  | GotErrorInvalidRenewKey          ErrorInvalidRenewKey          -- 34
-  | GotErrorPasswordTooLong          ErrorPasswordTooLong          -- 35
-  | GotErrorEmailAddressNotValidated ErrorEmailAddressNotValidated -- 36
-  | GotKeepAlive                     KeepAlive                     -- 250
+  = GotError                     Error                     -- 0
+  | GotToken                     Logged                    -- 1
+  | GotUser                      User                      -- 2
+  | GotUserAdded                 UserAdded                 -- 3
+  | GotUserEdited                UserEdited                -- 4
+  | GotUserValidated             UserValidated             -- 5
+  | GotUsersList                 UsersList                 -- 6
+  | GotPermissionCheck           PermissionCheck           -- 7
+  | GotPermissionSet             PermissionSet             -- 8
+  | GotPasswordRecoverySent      PasswordRecoverySent      -- 9
+  | GotPasswordRecovered         PasswordRecovered         -- 10
+  | GotMatchingUsers             MatchingUsers             -- 11
+  | GotUserDeleted               UserDeleted               -- 12
+  | GotErrorMustBeAuthenticated  ErrorMustBeAuthenticated  -- 20
+  | GotErrorAlreadyUsedLogin     ErrorAlreadyUsedLogin     -- 21
+  | GotErrorMailRequired         ErrorMailRequired         -- 22
+  | GotErrorUserNotFound         ErrorUserNotFound         -- 23
+  | GotErrorPasswordTooShort     ErrorPasswordTooShort     -- 24
+  | GotErrorInvalidCredentials   ErrorInvalidCredentials   -- 25
+  | GotErrorRegistrationsClosed  ErrorRegistrationsClosed  -- 26
+  | GotErrorInvalidLoginFormat   ErrorInvalidLoginFormat   -- 27
+  | GotErrorInvalidEmailFormat   ErrorInvalidEmailFormat   -- 28
+  | GotErrorAlreadyUsersInDB     ErrorAlreadyUsersInDB     -- 29
+  | GotErrorReadOnlyProfileKeys  ErrorReadOnlyProfileKeys  -- 30
+  | GotErrorInvalidActivationKey ErrorInvalidActivationKey -- 31
+  | GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
+  | GotErrorCannotContactUser    ErrorCannotContactUser    -- 33
+  | GotErrorInvalidRenewKey      ErrorInvalidRenewKey      -- 34
+  | GotErrorPasswordTooLong      ErrorPasswordTooLong      -- 35
+  | GotKeepAlive                 KeepAlive                 -- 250
 
 encode ∷ RequestMessage -> Tuple UInt String
 encode m = case m of
@@ -443,37 +433,36 @@ data DecodeError
 decode :: Int -> String -> Either DecodeError AnswerMessage
 decode number string
   = case number of
-    0   -> error_management codecGotError                         GotError
-    1   -> error_management codecGotToken                         GotToken
-    2   -> error_management codecGotUser                          GotUser
-    3   -> error_management codecGotUserAdded                     GotUserAdded
-    4   -> error_management codecGotUserEdited                    GotUserEdited
-    5   -> error_management codecGotUserValidated                 GotUserValidated
-    6   -> error_management codecGotUsersList                     GotUsersList
-    7   -> error_management codecGotPermissionCheck               GotPermissionCheck
-    8   -> error_management codecGotPermissionSet                 GotPermissionSet
-    9   -> error_management codecGotPasswordRecoverySent          GotPasswordRecoverySent
-    10  -> error_management codecGotPasswordRecovered             GotPasswordRecovered
-    11  -> error_management codecGotMatchingUsers                 GotMatchingUsers
-    12  -> error_management codecGotUserDeleted                   GotUserDeleted
-    20  -> error_management codecGotErrorMustBeAuthenticated      GotErrorMustBeAuthenticated
-    21  -> error_management codecGotErrorAlreadyUsedLogin         GotErrorAlreadyUsedLogin
-    22  -> error_management codecGotErrorMailRequired             GotErrorMailRequired
-    23  -> error_management codecGotErrorUserNotFound             GotErrorUserNotFound
-    24  -> error_management codecGotErrorPasswordTooShort         GotErrorPasswordTooShort
-    25  -> error_management codecGotErrorInvalidCredentials       GotErrorInvalidCredentials
-    26  -> error_management codecGotErrorRegistrationsClosed      GotErrorRegistrationsClosed
-    27  -> error_management codecGotErrorInvalidLoginFormat       GotErrorInvalidLoginFormat
-    28  -> error_management codecGotErrorInvalidEmailFormat       GotErrorInvalidEmailFormat
-    29  -> error_management codecGotErrorAlreadyUsersInDB         GotErrorAlreadyUsersInDB
-    30  -> error_management codecGotErrorReadOnlyProfileKeys      GotErrorReadOnlyProfileKeys
-    31  -> error_management codecGotErrorInvalidActivationKey     GotErrorInvalidActivationKey
-    32  -> error_management codecGotErrorUserAlreadyValidated     GotErrorUserAlreadyValidated
-    33  -> error_management codecGotErrorCannotContactUser        GotErrorCannotContactUser
-    34  -> error_management codecGotErrorInvalidRenewKey          GotErrorInvalidRenewKey
-    35  -> error_management codecGotErrorPasswordTooLong          GotErrorPasswordTooLong
-    36  -> error_management codecGotErrorEmailAddressNotValidated GotErrorEmailAddressNotValidated
-    250 -> error_management codecGotKeepAlive                     GotKeepAlive
+    0   -> error_management codecGotError                     GotError
+    1   -> error_management codecGotToken                     GotToken
+    2   -> error_management codecGotUser                      GotUser
+    3   -> error_management codecGotUserAdded                 GotUserAdded
+    4   -> error_management codecGotUserEdited                GotUserEdited
+    5   -> error_management codecGotUserValidated             GotUserValidated
+    6   -> error_management codecGotUsersList                 GotUsersList
+    7   -> error_management codecGotPermissionCheck           GotPermissionCheck
+    8   -> error_management codecGotPermissionSet             GotPermissionSet
+    9   -> error_management codecGotPasswordRecoverySent      GotPasswordRecoverySent
+    10  -> error_management codecGotPasswordRecovered         GotPasswordRecovered
+    11  -> error_management codecGotMatchingUsers             GotMatchingUsers
+    12  -> error_management codecGotUserDeleted               GotUserDeleted
+    20  -> error_management codecGotErrorMustBeAuthenticated  GotErrorMustBeAuthenticated
+    21  -> error_management codecGotErrorAlreadyUsedLogin     GotErrorAlreadyUsedLogin
+    22  -> error_management codecGotErrorMailRequired         GotErrorMailRequired
+    23  -> error_management codecGotErrorUserNotFound         GotErrorUserNotFound
+    24  -> error_management codecGotErrorPasswordTooShort     GotErrorPasswordTooShort
+    25  -> error_management codecGotErrorInvalidCredentials   GotErrorInvalidCredentials
+    26  -> error_management codecGotErrorRegistrationsClosed  GotErrorRegistrationsClosed
+    27  -> error_management codecGotErrorInvalidLoginFormat   GotErrorInvalidLoginFormat
+    28  -> error_management codecGotErrorInvalidEmailFormat   GotErrorInvalidEmailFormat
+    29  -> error_management codecGotErrorAlreadyUsersInDB     GotErrorAlreadyUsersInDB
+    30  -> error_management codecGotErrorReadOnlyProfileKeys  GotErrorReadOnlyProfileKeys
+    31  -> error_management codecGotErrorInvalidActivationKey GotErrorInvalidActivationKey
+    32  -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
+    33  -> error_management codecGotErrorCannotContactUser    GotErrorCannotContactUser
+    34  -> error_management codecGotErrorInvalidRenewKey      GotErrorInvalidRenewKey
+    35  -> error_management codecGotErrorPasswordTooLong      GotErrorPasswordTooLong
+    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_on_authentication_page pass of
+        case L.login login, P.password pass of
           Left errors, _ -> H.modify_ _ { errors = [ Login    errors ] }
           _, Left errors -> H.modify_ _ { errors = [ Password errors ] }
-          _, _           -> do H.modify_ _ { errors = [] }
-                               H.raise $ AuthenticateToAuthd (Tuple login pass)
+          _, _            -> do H.modify_ _ { errors = [] }
+                                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, between)
+import Prelude (Unit, bind, discard, ($), (<<<), (<>), map)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
@@ -17,7 +17,6 @@ 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
@@ -95,48 +94,17 @@ render { registrationForm }
 
     render_register_form = HH.form
       [ HE.onSubmit ValidateInputs ]
-      (login_input    <> login_error    <>
-       email_input    <> email_error    <>
-       password_input <> password_error <>
-       validation_btn)
-
-    login_input
-      = [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
-            (HandleRegisterInput <<< REG_INP_login)      -- action
-            registrationForm.login                       -- value
-        ]
-
-    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 ]
+      [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
+          (HandleRegisterInput <<< REG_INP_login)      -- action
+          registrationForm.login                       -- value
+      , Bulma.box_input "emailREGISTER" "Email" "email@example.com"    -- title, placeholder
+          (HandleRegisterInput <<< REG_INP_email)      -- action
+          registrationForm.email                       -- value
+      , Bulma.box_password "passwordREGISTER" "Password" "password"       -- title, placeholder
+          (HandleRegisterInput <<< REG_INP_pass)       -- action
+          registrationForm.pass                        -- value
+      , 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,7 +5,6 @@ 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)
@@ -16,20 +15,15 @@ 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.
@@ -38,7 +32,7 @@ data Query a
 
 type Slot = H.Slot Query Output
 
-type Input = Tuple (Maybe Email.Email) (Maybe Email.Email)
+type Input = String
 
 data AuthenticationInput
   = AUTH_INP_login String
@@ -49,14 +43,9 @@ data NewPasswordInput
   | NEWPASS_INP_confirmation String
 
 data Action
-  = HandleNewPassword NewPasswordInput  -- user input
-  | ChangePasswordAttempt Event         -- validation
-  | SendChangePasswordMessage           -- sends the message
-
-  | HandleNewEmail String               -- user input
-  | ChangeEmailAttempt Event            -- validation
-  | SendChangeEmailAddressMessage       -- sends the message
-
+  = HandleNewPassword NewPasswordInput
+  | ChangePasswordAttempt Event
+  | SendChangePasswordMessage
   | CancelModal
   | DeleteAccountPopup
   | DeleteAccount
@@ -68,10 +57,9 @@ data Modal
   | DeleteAccountModal
 
 type State =
-  { newPasswordForm       :: StateNewPasswordForm
-  , new_email_address     :: String
-  , emails                :: Tuple (Maybe Email.Email) (Maybe Email.Email)
-  , modal                 :: Modal
+  { newPasswordForm :: StateNewPasswordForm
+  , token           :: String
+  , modal           :: Modal
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -86,22 +74,18 @@ component =
     }
 
 initialState :: Input -> State
-initialState emails =
+initialState token =
   { newPasswordForm: { password: "", confirmation: "" }
-  , new_email_address: ""
-  , emails
+  , token
   , modal: NoModal
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { modal, newPasswordForm, new_email_address, emails } =
+render { modal, newPasswordForm } =
   Bulma.section_small
-    [ render_emails emails
-    , Bulma.hr
-    , case modal of
+    [ case modal of
         DeleteAccountModal -> render_delete_account_modal
-        NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change email address", render_new_email_form ]
-                                  , b [ Bulma.h3 "Change password", render_new_password_form ]
+        NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change password", render_new_password_form ]
                                   , b [ Bulma.h3 "Delete account", render_delete_account ]
                                   ]
     ]
@@ -109,24 +93,7 @@ render { modal, newPasswordForm, new_email_address, emails } =
   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"
@@ -153,9 +120,6 @@ 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
@@ -164,17 +128,6 @@ 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
 
@@ -189,11 +142,6 @@ 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,6 +8,8 @@
 -- | **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.
@@ -28,7 +30,6 @@ 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
@@ -107,9 +108,6 @@ 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.
@@ -171,8 +169,6 @@ 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
@@ -229,6 +225,20 @@ 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 _
@@ -292,7 +302,6 @@ 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 =
@@ -386,7 +395,6 @@ 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)
@@ -418,7 +426,7 @@ render state
           ] <> case state.rr_modal of
                  UpdateRRModal ->
                    if A.elem state._currentRR.rrtype ["A", "AAAA"]
-                   then [ Bulma.field_entry ("token" <> state._currentRR.rrtype) "Token"
+                   then [ Bulma.labeled_field ("token" <> state._currentRR.rrtype) "Token"
                             (Bulma.p $ fromMaybe "❌​" state._currentRR.token)
                         ]
                    else []
@@ -450,27 +458,6 @@ 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]
@@ -696,7 +683,6 @@ 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" ""
@@ -714,7 +700,6 @@ 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 }
@@ -852,11 +837,6 @@ 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                                            }
@@ -1028,7 +1008,6 @@ 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)
@@ -1040,7 +1019,6 @@ 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"
@@ -1049,7 +1027,6 @@ 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"]
@@ -1110,19 +1087,6 @@ 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 ]
@@ -1260,11 +1224,10 @@ render_new_records _
           , Bulma.btn   "SRV" (CreateNewRRModal SRV)
           ] []
       , Bulma.hr
-      , Bulma.h1 "Special records about certifications and the mail system"
+      , Bulma.h1 "Special records about the mail system"
       -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
       , Bulma.level [
-            Bulma.btn "CAA"   (CreateNewRRModal CAA)
-          , Bulma.btn "SPF"   (CreateNewRRModal SPF)
+            Bulma.btn "SPF"   (CreateNewRRModal SPF)
           , Bulma.btn "DKIM"  (CreateNewRRModal DKIM)
           , Bulma.btn "DMARC" (CreateNewRRModal DMARC)
           ] []
@@ -1307,14 +1270,6 @@ 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,26 +259,6 @@ 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,7 +14,6 @@ data AcceptedRRTypes
   | CNAME
   | NS
   | MX
-  | CAA
   | SRV
   | SPF
   | DKIM

src/App/Type/CAA.purs

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

src/App/Type/ResourceRecord.purs

@@ -10,7 +10,6 @@ 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
@@ -47,7 +46,8 @@ type ResourceRecord
 
     , dkim :: Maybe DKIM.DKIM
     , dmarc :: Maybe DMARC.DMARC
-    , caa :: Maybe CAA.CAA
+
+    -- TODO: DMARC specific entries.
     }
 
 codec :: JsonCodec ResourceRecord
@@ -87,7 +87,6 @@ codec = CA.object "ResourceRecord"
 
     , dkim:       CAR.optional DKIM.codec
     , dmarc:      CAR.optional DMARC.codec
-    , caa:        CAR.optional CAA.codec
     })
 
 type Mechanism
@@ -230,7 +229,6 @@ emptyRR
 
     , dkim:         Nothing
     , dmarc:        Nothing
-    , caa:          Nothing
     }
 
 data Qualifier = Pass | Neutral | SoftFail | HardFail

src/App/Validation/DNS.purs

@@ -21,7 +21,6 @@ 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.
@@ -56,8 +55,6 @@ 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)
@@ -329,20 +326,6 @@ 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
@@ -351,7 +334,6 @@ 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,15 +32,12 @@ 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
-  _ <- (alpha <|> digit) G.<:> \_ -> CannotParse
-  _ <- 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)
+  _ <- G.many1 (alpha <|> digit) G.<:> \_ -> CannotParse
+  _ <- SomeParsers.eof           G.<:> \_ -> CannotEntirelyParse
   pos <- G.current_position
-  case between min_login_size max_login_size pos, last_char_correct of
-    false, _     -> G.errorParser (Just $ Size min_login_size max_login_size pos)
-    true, false  -> G.errorParser (Just $ CannotParse)
-    _, _         -> pure input.string
+  if between min_login_size max_login_size pos
+  then pure input.string
+  else G.errorParser (Just $ Size min_login_size max_login_size pos)
 
 login :: String -> Either (Array Error) String
 login s = toEither $ parse login_parser s ParsingError

src/App/Validation/Password.purs

@@ -21,15 +21,10 @@ data Error
   = ParsingError (G.Error PasswordParsingError)
 
 min_password_size :: Int
-min_password_size = 15
+min_password_size = 2
 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]
@@ -37,28 +32,12 @@ 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.char ' ') G.<:> \_ -> CannotParse
-  _ <- SomeParsers.eof                G.<:> \_ -> CannotEntirelyParse
+  l <- G.many1 vchar <|> 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 between min_password_size max_password_size pos
-  then 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)
+  if pos < min_password_size || pos > max_password_size
+  then G.Parser \i -> G.failureError i.position (Just $ Size min_password_size max_password_size pos)
+  else pure $ CU.fromCharArray l
 
 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,7 +2,6 @@
 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
@@ -137,17 +136,6 @@ 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"  ]
@@ -302,56 +290,46 @@ render_input password id placeholder action value cond
         false -> []
         true -> [ HP.type_ HP.InputPassword ]
 
--- | Bulma's `field`, which contains an array of `Halogen.HTML` entries.
--- | 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)]
+div_field :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+div_field = HH.div [HP.classes (C.field <> C.is_horizontal)]
 
--- | 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
-  = field_entry id title $ render_input ispassword id placeholder action value cond
+  = div_field
+      [ 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
-  = field_entry id title $ HH.button
-      [ HE.onClick \_ -> action
-      , HP.classes $ C.button <> C.is_small <> C.is_info
-      , HP.id id
-      ] [ HH.text button_text ]
+  = div_field
+      [ div_field_label id title
+      , div_field_content $ HH.button
+          [ HE.onClick \_ -> action
+          , HP.classes $ C.button <> C.is_small <> C.is_info
+          , 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
@@ -551,19 +529,18 @@ 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
-  = field_entry id title $ selection action values selected
+  = div_field
+      [ 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
-  = field_entry id title $ 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)
+  = div_field
+      [ div_field_label id title
+      , div_field_content $ selection' action values 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.