DMARC explanations. Still perfectible.

src/App/Container.purs

@@ -93,8 +93,10 @@ type Password = String
 type LogInfo = Tuple Login Password
 
 data Action
+  = Initialize
+
   -- | Handle events from `AuthenticationInterface`.
-  = AuthenticationInterfaceEvent  AI.Output
+  | AuthenticationInterfaceEvent  AI.Output
 
   -- | Handle events from `RegistrationInterface`.
   | RegistrationInterfaceEvent    RI.Output
@@ -162,6 +164,14 @@ data Action
   -- | Currently, this handles the navigation bar.
   | ToggleAuthenticated (Maybe Token)
 
+  -- | Add a main notification, at the top of the page.
+  | AddNotif Notification
+
+  -- | Close the main notification, at the top of the page.
+  | CloseNotif
+
+data Notification = NoNotification | GoodNotification String | BadNotification String
+
 -- | The component's state is composed of:
 -- | a potential authentication token,
 -- | the current page,
@@ -171,6 +181,8 @@ type State = { token :: Maybe String
              , current_page :: Page
              , store_DomainListInterface_state :: Maybe DomainListInterface.State
              , store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
+             , notif :: Notification
+             , login :: Maybe String
              }
 
 -- | The list of child components: log, `WS` twice (once for each ws connection),
@@ -209,7 +221,9 @@ component =
   H.mkComponent
     { initialState
     , render
-    , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
+    , eval: H.mkEval $ H.defaultEval { initialize = Just Initialize
+                                     , handleAction = handleAction
+                                     }
     }
 
 -- | Initial state is simple: the user is on the home page, nothing else is stored.
@@ -218,6 +232,8 @@ initialState _ = { token: Nothing
                  , current_page: Home
                  , store_DomainListInterface_state: Nothing
                  , store_AuthenticationDaemonAdmin_state: Nothing
+                 , notif: NoNotification
+                 , login: Nothing
                  }
 
 render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
@@ -225,6 +241,7 @@ render state
   = HH.div_ $
     [ render_header
     , render_nav
+    , render_notifications
     , case state.current_page of
         Home           -> render_home
         Authentication -> render_auth_form
@@ -236,10 +253,15 @@ render state
         Administration -> render_authd_admin_interface
     -- The footer includes logs and both the WS child components.
     , Bulma.hr
-    , Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails! 😅)", render_logs ]
+    , Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails 😅)", render_logs ]
                      , Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
     ]
   where
+    render_notifications =
+      case state.notif of
+        NoNotification -> HH.div_ []
+        GoodNotification v -> Bulma.box [Bulma.notification_success v CloseNotif]
+        BadNotification  v -> Bulma.box [Bulma.notification_danger  v CloseNotif]
 
     render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_home = HH.slot_ _ho unit HomeInterface.component unit
@@ -252,7 +274,7 @@ render state
     render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     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. Reconnect!"
+                     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
     render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
@@ -287,22 +309,39 @@ render state
 
 handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
 handleAction = case _ of
+  Initialize -> do
+    handleAction $ Log $ SystemLog "Hello, welcome to this application. 🥳"
+    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
+    case token of
+      Nothing -> revert_old_page
+      Just _ -> pure unit -- Authentication will happen when web sockets are up!
+
+    login_name <- H.liftEffect $ Storage.getItem "user-login" sessionstorage
+    case login_name of
+      Nothing -> pure unit
+      Just name -> do H.modify_ _ { login = Just name }
+                      H.tell _nav unit $ NavigationInterface.TellLogin (Just name)
+
   Routing page -> do
     -- Store the current page we are on and restore it when we reload.
     sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    H.liftEffect $ Storage.setItem "current-page" (case page of
+      Zone _ -> "Zone"
+      _      -> show page) sessionstorage
+
     _ <- case page of
-      Home           -> H.liftEffect $ Storage.setItem "current-page" "Home"           sessionstorage
+      Zone zone  -> H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage
-      Authentication -> H.liftEffect $ Storage.setItem "current-page" "Authentication" sessionstorage
+      _          -> pure unit
-      Registration   -> H.liftEffect $ Storage.setItem "current-page" "Registration"   sessionstorage
+
-      MailValidation -> H.liftEffect $ Storage.setItem "current-page" "MailValidation" sessionstorage
-      DomainList     -> H.liftEffect $ Storage.setItem "current-page" "DomainList"     sessionstorage
-      Zone zone      -> do _ <- H.liftEffect $ Storage.setItem "current-page" "Zone"   sessionstorage
-                           H.liftEffect $ Storage.setItem      "current-zone" zone     sessionstorage
-      Setup          -> H.liftEffect $ Storage.setItem "current-page" "Setup"          sessionstorage
-      Administration -> H.liftEffect $ Storage.setItem "current-page" "Administration" sessionstorage
     H.modify_ _ { current_page = page }
 
-  Log message -> H.tell _log unit $ AppLog.Log message
+  Log message -> do
+    _ <- case message of
+           UnableToSend err -> handleAction $ AddNotif $ BadNotification err
+           ErrorLog     err -> handleAction $ AddNotif $ BadNotification err
+           _ -> pure unit
+    H.tell _log unit $ AppLog.Log message
 
   ToggleAuthenticated maybe_token -> case maybe_token of
     Nothing -> H.tell _nav unit $ NavigationInterface.ToggleLogged false
@@ -318,7 +357,7 @@ handleAction = case _ of
 
   AuthenticateToAuthd v -> case v of
     Left token -> do
-      handleAction $ Log $ SystemLog "Authenticate to authd with a token!"
+      handleAction $ Log $ SystemLog "Authenticate to authd with a token."
       message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAuthByToken { token }
       H.tell _ws_auth unit (WS.ToSend message)
     Right (Tuple login password) -> do
@@ -335,13 +374,13 @@ handleAction = case _ of
         sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
         token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
         case token of
-          Nothing -> handleAction $ Log $ ErrorLog "no token!"
+          Nothing -> pure unit
           Just t -> do
             H.modify_ _ { token = Just t }
             handleAction AuthenticateToDNSManager
 
   NavigationInterfaceEvent ev -> case ev of
-    NavigationInterface.Log message -> H.tell _log unit (AppLog.Log message)
+    NavigationInterface.Log message -> handleAction $ Log message
     NavigationInterface.Routing page -> handleAction $ Routing page
     NavigationInterface.Disconnection -> handleAction $ Disconnection
 
@@ -350,11 +389,11 @@ handleAction = case _ of
     AI.AskPasswordRecovery e -> case e of
       Left  email -> do
         message <- H.liftEffect $ AuthD.serialize $
-          AuthD.MkAskPasswordRecovery { user: Nothing, email: Just (Email.Email email) }
+          AuthD.MkAskPasswordRecovery { login: Nothing, email: Just (Email.Email email) }
         H.tell _ws_auth unit (WS.ToSend message)
       Right login -> do
         message <- H.liftEffect $ AuthD.serialize $
-          AuthD.MkAskPasswordRecovery { user: (Just login), email: Nothing }
+          AuthD.MkAskPasswordRecovery { login: (Just login), email: Nothing }
         H.tell _ws_auth unit (WS.ToSend message)
     AI.PasswordRecovery login token pass -> do
       message <- H.liftEffect $ AuthD.serialize $ AuthD.MkPasswordRecovery
@@ -364,15 +403,20 @@ handleAction = case _ of
       H.tell _ws_auth unit (WS.ToSend message)
 
     AI.AuthenticateToAuthd v  -> handleAction $ AuthenticateToAuthd (Right v)
-    AI.Log message            -> H.tell _log unit (AppLog.Log message)
+    AI.Log message            -> handleAction $ Log message
+    AI.UserLogin login        -> do
+      sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+      _ <- H.liftEffect $ Storage.setItem "user-login" login sessionstorage
+      H.modify_ _ { login = Just login }
+      H.tell _nav unit $ NavigationInterface.TellLogin (Just login)
 
   RegistrationInterfaceEvent ev -> case ev of
     RI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
-    RI.Log message            -> H.tell _log unit (AppLog.Log message)
+    RI.Log message            -> handleAction $ Log message
 
   MailValidationInterfaceEvent ev -> case ev of
     MVI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
-    MVI.Log message            -> H.tell _log unit (AppLog.Log message)
+    MVI.Log message            -> handleAction $ Log message
 
   SetupInterfaceEvent ev -> case ev of
     SetupInterface.DeleteUserAccount -> do
@@ -395,11 +439,11 @@ handleAction = case _ of
                                                                   }
       H.tell _ws_auth unit (WS.ToSend message)
 
-    SetupInterface.Log message          -> H.tell _log unit (AppLog.Log message)
+    SetupInterface.Log message -> handleAction $ Log message
 
   AdministrationEvent ev -> case ev of
     AdminInterface.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
-    AdminInterface.Log message           -> H.tell _log unit (AppLog.Log message)
+    AdminInterface.Log message           -> handleAction $ Log message
     AdminInterface.StoreState s          -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
     AdminInterface.AskState              -> do
       state <- H.get
@@ -418,11 +462,11 @@ handleAction = case _ of
 
   ZoneInterfaceEvent ev -> case ev of
     ZoneInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
-    ZoneInterface.Log message            -> H.tell _log unit (AppLog.Log message)
+    ZoneInterface.Log message            -> handleAction $ Log message
 
   DomainListComponentEvent ev -> case ev of
     DomainListInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
-    DomainListInterface.Log message            -> H.tell _log unit (AppLog.Log message)
+    DomainListInterface.Log message            -> handleAction $ Log message
     DomainListInterface.StoreState s           -> H.modify_ _ { store_DomainListInterface_state = Just s }
     DomainListInterface.ChangePageZoneInterface domain -> do
       handleAction $ Routing $ Zone domain
@@ -433,25 +477,20 @@ handleAction = case _ of
 
   -- | `authd websocket component` wants to do something.
   AuthenticationDaemonEvent ev -> case ev of
-    WS.MessageReceived (Tuple _ message) -> do
+    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message
-      handleAction $ DecodeAuthMessage message
 
     WS.WSJustConnected -> do
-      H.tell _ai unit AI.ConnectionIsUp
-      H.tell _admini unit AdminInterface.ConnectionIsUp
       sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
       token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
       case token of
-        Nothing -> handleAction $ Log $ ErrorLog "no token!"
+        Nothing -> pure unit
         Just t -> do
           handleAction $ Log $ SystemLog "Let's authenticate to authd"
           handleAction $ AuthenticateToAuthd (Left t)
 
-    WS.WSJustClosed -> do
+    WS.WSJustClosed -> handleAction $ Log $ ErrorLog "You just got disconnected from authd."
-      H.tell _ai unit AI.ConnectionIsDown
+    WS.Log message  -> handleAction $ Log message
-      H.tell _admini unit AdminInterface.ConnectionIsDown
+    WS.KeepAlive    -> handleAction $ KeepAlive $ Left unit
-    WS.Log message -> H.tell _log unit (AppLog.Log message)
-    WS.KeepAlive   -> handleAction $ KeepAlive $ Left unit
 
   DecodeAuthMessage message -> do
     receivedMessage <- H.liftEffect $ AuthD.deserialize message
@@ -479,24 +518,29 @@ handleAction = case _ of
             { current_page } <- H.get
             case current_page of
               Registration -> do
-                handleAction $ Log $ SuccessLog """
+                let successlog = """
-          You are now registered, copy the token we sent you by email to finish your registration.
+                    You are now registered. Please verify your email address with the token we sent you.
                 """
+                handleAction $ Log $ SuccessLog successlog
+                handleAction $ AddNotif $ GoodNotification successlog
                 handleAction $ Routing MailValidation
               _ -> handleAction $ DispatchAuthDaemonMessage m
           (AuthD.GotUserEdited u) -> do
-            handleAction $ Log $ SuccessLog $ "User (" <> show u.uid <> ") was modified!"
+            handleAction $ Log $ SuccessLog $ "User (" <> show u.uid <> ") was modified."
           (AuthD.GotUserValidated _) -> do
-            handleAction $ Log $ SuccessLog "User got validated! You can now log in!"
+            handleAction $ Log $ SuccessLog "User got validated. You can now log in."
             handleAction $ Routing Authentication
+            handleAction $ AddNotif $ GoodNotification "User got validated. You can now log in."
           (AuthD.GotUsersList _) -> do
             handleAction $ Log $ ErrorLog "TODO: received a GotUsersList message."
           (AuthD.GotPermissionCheck _) -> do
             handleAction $ Log $ ErrorLog "TODO: received a GotPermissionCheck message."
           (AuthD.GotPermissionSet _) -> do
             handleAction $ Log $ ErrorLog "Received a GotPermissionSet message."
-          (AuthD.GotPasswordRecovered _) -> do
+          m@(AuthD.GotPasswordRecovered _) -> do
-            handleAction $ Log $ SuccessLog "your new password is now valid!"
+            handleAction $ Log $ SuccessLog "your new password is now valid."
+            handleAction $ DispatchAuthDaemonMessage m
+            handleAction $ AddNotif $ GoodNotification "Your new password is now valid."
           m@(AuthD.GotMatchingUsers _) -> do
             { current_page } <- H.get
             case current_page of
@@ -507,49 +551,67 @@ handleAction = case _ of
             { current_page } <- H.get
             case current_page of
               Administration -> handleAction $ DispatchAuthDaemonMessage m
-              _ -> handleAction $ Log $ ErrorLog
+              _ -> pure unit
-                "received a GotUserDeleted message while not on authd admin page."
           (AuthD.GotErrorMustBeAuthenticated _) -> do
             handleAction $ Log $ ErrorLog "received a GotErrorMustBeAuthenticated message."
+            handleAction $ AddNotif $ BadNotification "Sorry, you must be authenticated to perform this action."
           (AuthD.GotErrorAlreadyUsedLogin _) -> do
             handleAction $ Log $ ErrorLog "received a GotErrorAlreadyUsedLogin message."
+            handleAction $ AddNotif $ BadNotification "Sorry, your login is already taken."
           (AuthD.GotErrorUserNotFound _) -> do
             handleAction $ Log $ ErrorLog "received a GotErrorUserNotFound message."
+            handleAction $ AddNotif $ BadNotification "User hasn't been found."
 
           -- The authentication failed.
           (AuthD.GotError errmsg) -> do
             handleAction $ Log $ ErrorLog $ " generic error message: "
               <> maybe "server didn't tell why" (\v -> v) errmsg.reason
-          (AuthD.GotPasswordRecoverySent _) -> do
+            handleAction $ AddNotif $ BadNotification $ "Sorry, authd sent an error message. "
-            handleAction $ Log $ SuccessLog $ "Password recovery: email sent!"
+              <> maybe "The server didn't tell why." (\v -> "Message was: " <> v) errmsg.reason
+          m@(AuthD.GotPasswordRecoverySent _) -> do
+            handleAction $ Log $ SuccessLog $ "Password recovery: email sent."
+            handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
+            handleAction $ DispatchAuthDaemonMessage m
           (AuthD.GotErrorPasswordTooShort _) -> do
             handleAction $ Log $ ErrorLog "Password too short!"
+            handleAction $ AddNotif $ BadNotification "The server told that your password is too short."
           (AuthD.GotErrorMailRequired _) -> do
             handleAction $ Log $ ErrorLog "Email required!"
+            handleAction $ AddNotif $ BadNotification "An email is required."
           (AuthD.GotErrorInvalidCredentials _) -> do
             handleAction $ Log $ ErrorLog "Invalid credentials!"
             handleAction $ ToggleAuthenticated Nothing
+            handleAction $ AddNotif $ BadNotification "Invalid credentials!"
           (AuthD.GotErrorRegistrationsClosed _) -> do
-            handleAction $ Log $ ErrorLog "Registration closed! Try another time or contact an administrator."
+            handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator."
+            handleAction $ AddNotif $ BadNotification "Registration are closed at the moment."
           (AuthD.GotErrorInvalidLoginFormat _) -> do
             handleAction $ Log $ ErrorLog "Invalid login format!"
+            handleAction $ AddNotif $ BadNotification "Invalid login format."
           (AuthD.GotErrorInvalidEmailFormat _) -> do
             handleAction $ Log $ ErrorLog "Invalid email format!"
+            handleAction $ AddNotif $ BadNotification "Invalid email format."
           (AuthD.GotErrorAlreadyUsersInDB _) -> do
-            handleAction $ Log $ ErrorLog "Login already taken!"
+            handleAction $ Log $ ErrorLog "GotErrorAlreadyUsersInDB"
+            handleAction $ AddNotif $ BadNotification "Login already taken!"
           (AuthD.GotErrorReadOnlyProfileKeys _) -> do
             handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys!"
+            handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys!"
           (AuthD.GotErrorInvalidActivationKey _) -> do
             handleAction $ Log $ ErrorLog "Invalid activation key!"
+            handleAction $ AddNotif $ BadNotification "Invalid activation key!"
           (AuthD.GotErrorUserAlreadyValidated _) -> do
             handleAction $ Log $ ErrorLog "User already validated!"
+            handleAction $ AddNotif $ BadNotification "User already validated!"
           (AuthD.GotErrorCannotContactUser _) -> do
             handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid."
+            handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid."
           (AuthD.GotErrorInvalidRenewKey _) -> do
             handleAction $ Log $ ErrorLog "Invalid renew key!"
+            handleAction $ AddNotif $ BadNotification "Invalid renew key!"
           -- The authentication was a success!
           (AuthD.GotToken msg) -> do
-            handleAction $ Log $ SuccessLog $ "Authenticated to authd!"
+            handleAction $ Log $ SuccessLog $ "Authenticated to authd."
             H.modify_ _ { token = Just msg.token }
             handleAction $ ToggleAuthenticated (Just msg.token)
 
@@ -557,39 +619,42 @@ handleAction = case _ of
             _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
 
             handleAction AuthenticateToDNSManager
-          (AuthD.GotKeepAlive _) -> do
+          (AuthD.GotKeepAlive _) -> pure unit
-            -- handleAction $ Log $ SystemLog $ "KeepAlive!"
-            pure unit
     pure unit
 
   -- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
   DispatchAuthDaemonMessage message -> do
     { current_page } <- H.get
     case current_page of
+      Authentication -> H.tell _ai unit (AI.MessageReceived message)
       Administration -> H.tell _admini unit (AdminInterface.MessageReceived message)
       _              -> handleAction $ Log $ SystemLog "unexpected message from authd"
     pure unit
 
+  AddNotif n -> do
+    H.modify_ _ { notif = n }
+
+  CloseNotif -> do
+    H.modify_ _ { notif = NoNotification }
+
   Disconnection -> do
+    handleAction $ Routing Home
+
     H.put $ initialState unit
 
+    handleAction $ ToggleAuthenticated Nothing
+
     -- Remove all stored session data.
     sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
     H.liftEffect $ Storage.clear sessionstorage
 
-    handleAction $ Routing Home
-
   -- | `dnsmanagerd websocket component` wants to do something.
   DNSManagerDaemonEvent ev -> case ev of
-    WS.MessageReceived (Tuple _ message) -> do
+    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeDNSMessage message
-      handleAction $ DecodeDNSMessage message
+    WS.WSJustConnected -> handleAction AuthenticateToDNSManager
-    WS.WSJustConnected -> do
+    WS.WSJustClosed    -> handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
-      handleAction $ Log $ SystemLog "Connection with dnsmanagerd was closed, let's re-authenticate"
+    WS.Log message     -> handleAction $ Log message
-      handleAction AuthenticateToDNSManager
+    WS.KeepAlive       -> handleAction $ KeepAlive $ Right unit
-      H.tell _dli unit DomainListInterface.ConnectionIsUp
-    WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
-    WS.Log message -> H.tell _log unit (AppLog.Log message)
-    WS.KeepAlive   -> handleAction $ KeepAlive $ Right unit
 
   -- | `DecodeDNSMessage`: decode a received `dnsmanagerd` message, then transfer it to `DispatchDNSMessage`.
   DecodeDNSMessage message -> do
@@ -612,22 +677,28 @@ handleAction = case _ of
         case received_msg of
           (DNSManager.MkDomainNotFound _) -> do
             handleAction $ Log $ ErrorLog $ "DomainNotFound"
+            handleAction $ AddNotif $ BadNotification $ "The domain doesn't exist."
           (DNSManager.MkRRNotFound _) -> do
             handleAction $ Log $ ErrorLog $ "RRNotFound"
+            handleAction $ AddNotif $ BadNotification $ "The resource record doesn't exist."
           (DNSManager.MkInvalidZone _) -> do
             handleAction $ Log $ ErrorLog $ "InvalidZone"
+            handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid."
           (DNSManager.MkDomainChanged _) -> do
             handleAction $ Log $ ErrorLog $ "DomainChanged"
           (DNSManager.MkUnknownZone _) -> do
             handleAction $ Log $ ErrorLog $ "UnknownZone"
+            handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
           (DNSManager.MkDomainList _) -> do
             handleAction $ Log $ ErrorLog $ "MkDomainList"
           (DNSManager.MkUnknownUser _) -> do
             handleAction $ Log $ ErrorLog $ "MkUnknownUser"
           (DNSManager.MkNoOwnership _) -> do
             handleAction $ Log $ ErrorLog $ "MkNoOwnership"
+            handleAction $ AddNotif $ BadNotification $ "You don't own this domain."
           (DNSManager.MkInsufficientRights _) -> do
             handleAction $ Log $ ErrorLog $ "You do not have sufficient rights."
+            handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights."
           -- The authentication failed.
           (DNSManager.MkError errmsg) -> do
             handleAction $ Log $ ErrorLog $ "reason is: " <> errmsg.reason
@@ -642,24 +713,29 @@ handleAction = case _ of
             handleAction $ ToggleAuthenticated Nothing
           (DNSManager.MkDomainAlreadyExists _) -> do
             handleAction $ Log $ ErrorLog $ "The domain already exists."
+            handleAction $ AddNotif $ BadNotification $ "The domain already exists."
           m@(DNSManager.MkUnacceptableDomain _) -> do
             handleAction $ Log $ ErrorLog $ "Domain not acceptable (see accepted domain list)."
             handleAction $ DispatchDNSMessage m
           m@(DNSManager.MkAcceptedDomains _) -> do
-            handleAction $ Log $ SuccessLog $ "Received the list of accepted domains!"
+            handleAction $ Log $ SuccessLog $ "Received the list of accepted domains."
             handleAction $ DispatchDNSMessage m
-          m@(DNSManager.MkLogged _) -> do
+          m@(DNSManager.MkLogged logged_message) -> do
-            handleAction $ Log $ SuccessLog $ "Authenticated to dnsmanagerd!"
+            handleAction $ Log $ SuccessLog $ "Authenticated to dnsmanagerd."
+            H.tell _nav unit $ NavigationInterface.ToggleAdmin logged_message.admin
+            handleAction $ AddNotif $ GoodNotification "You are now authenticated."
             handleAction $ DispatchDNSMessage m
           m@(DNSManager.MkDomainAdded response) -> do
             handleAction $ Log $ SuccessLog $ "Domain added: " <> response.domain
+            handleAction $ AddNotif $ GoodNotification $ "You have just registered the domain \""
+              <> response.domain <> "\". 🥳 You can now manage it (click on its button)."
             handleAction $ DispatchDNSMessage m
           (DNSManager.MkRRReadOnly response) -> do
             handleAction $ Log $ ErrorLog $ "Trying to modify a read-only resource! "
                                         <> "domain: " <> response.domain
                                         <> "resource rrid: " <> show response.rr.rrid
           m@(DNSManager.MkRRUpdated _) -> do
-            handleAction $ Log $ SuccessLog $ "Resource updated!"
+            handleAction $ Log $ SuccessLog $ "Resource updated."
             handleAction $ DispatchDNSMessage m
           m@(DNSManager.MkRRAdded response) -> do
             handleAction $ Log $ SuccessLog $ "Resource Record added: " <> response.rr.rrtype
@@ -668,20 +744,25 @@ handleAction = case _ of
             handleAction $ Log $ SuccessLog $ "Received zonefile for " <> response.domain
             handleAction $ DispatchDNSMessage m
           (DNSManager.MkInvalidDomainName _) -> do
-            handleAction $ Log $ ErrorLog $ "The domain is not valid!"
+            handleAction $ Log $ ErrorLog $ "The domain is not valid."
+            handleAction $ AddNotif $ BadNotification $ "Invalid domain name."
           m@(DNSManager.MkDomainDeleted response) -> do
-            handleAction $ Log $ SuccessLog $ "The domain '" <> response.domain <> "' has been deleted!"
+            let successlog = "The domain \"" <> response.domain <> "\" has been deleted."
+            handleAction $ Log $ SuccessLog successlog
+            handleAction $ AddNotif $ GoodNotification successlog
             handleAction $ DispatchDNSMessage m
           m@(DNSManager.MkRRDeleted response) -> do
-            handleAction $ Log $ SuccessLog $ "RR (rrid: '" <> show response.rrid <> "') has been deleted!"
+            handleAction $ Log $ SuccessLog $ "RR (rrid: \"" <> show response.rrid <> "\") has been deleted."
             handleAction $ DispatchDNSMessage m
           m@(DNSManager.MkZone _) -> do
-            handleAction $ Log $ SuccessLog $ "Zone received!"
+            handleAction $ Log $ SuccessLog $ "Zone received."
             handleAction $ DispatchDNSMessage m
           (DNSManager.MkInvalidRR response) -> do
-            handleAction $ Log $ ErrorLog $ "Invalid resource record: " <> A.intercalate ", " response.errors
+            let errorlog = "Invalid resource record: " <> A.intercalate ", " response.errors
+            handleAction $ Log $ ErrorLog errorlog
+            handleAction $ AddNotif $ BadNotification errorlog
           (DNSManager.MkSuccess _) -> do
-            handleAction $ Log $ SuccessLog $ "(generic) Success!"
+            handleAction $ Log $ SuccessLog $ "(generic) Success."
           DNSManager.MkOrphanDomainList response -> do
             handleAction $ Log $ SuccessLog "Received orphan domain list."
             H.tell _admini unit (AdminInterface.GotOrphanDomainList response.domains)

src/App/DisplayErrors.purs

@@ -8,9 +8,13 @@ import Data.Maybe (Maybe(..), maybe)
 import Halogen.HTML as HH
 
 import App.Validation.DNS as ValidationDNS
+import App.Validation.Login as L
+import App.Validation.Email as E
+import App.Validation.Password as P
 import App.Validation.Label as ValidationLabel
 import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
 import GenericParser.IPAddress as IPAddress
+
 import Bulma as Bulma
 
 error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
@@ -20,8 +24,15 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.VEIPv4     err       -> maybe default_error show_error_ip4 err.error
       ValidationDNS.VEIPv6     err       -> maybe default_error show_error_ip6 err.error
       ValidationDNS.VEName     err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VETTL min max n      -> Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max
+      ValidationDNS.VETTL min max n ->
-                                         <> ", current value: " <> show n <> "."
+        Bulma.p $ "TTL should have a value between "
+          <> show min <> " and " <> show max <> ", current value: " <> show n <> "."
+      ValidationDNS.VEDMARCpct min max n ->
+        Bulma.p $ "DMARC sample rate should have a value between "
+          <> show min <> " and " <> show max <> ", current value: " <> show n <> "."
+      ValidationDNS.VEDMARCri  min max n ->
+        Bulma.p $ "DMARC report interval should have a value between "
+          <> show min <> " and " <> show max <> ", current value: " <> show n <> "."
       ValidationDNS.VETXT      err       -> maybe default_error show_error_txt err.error
       ValidationDNS.VECNAME    err       -> maybe default_error show_error_domain err.error
       ValidationDNS.VENS       err       -> maybe default_error show_error_domain err.error
@@ -29,7 +40,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.VEPriority min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
       ValidationDNS.VESRV      err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VEProtocol err       -> maybe default_error show_error_protocol err.error
+      ValidationDNS.VEProtocol err       -> maybe protocol_error show_error_protocol err.error
       ValidationDNS.VEPort min max n     -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
       ValidationDNS.VEWeight min max n   -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
@@ -44,6 +55,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.DKIMInvalidKeySize min max -> show_error_key_sizes min max
   )
   where default_error = Bulma.p ""
+        protocol_error = Bulma.p "Accepted protocols are: tcp, udp. You need more? Contact us."
 
 show_error_key_sizes :: forall w i. Int -> Int -> HH.HTML w i
 show_error_key_sizes min max
@@ -53,28 +65,30 @@ show_error_key_sizes min max
 -- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry.
 show_error_title :: ValidationDNS.Error -> String
 show_error_title v = case v of
-  ValidationDNS.UNKNOWN              -> "Unknown"
+  ValidationDNS.UNKNOWN          -> "Unknown"
-  ValidationDNS.VEIPv4     err       -> "The IPv4 address is wrong (position: "        <> show err.position <> ")"
+  ValidationDNS.VEIPv4     _     -> "Invalid IPv4 address"
-  ValidationDNS.VEIPv6     err       -> "The IPv6 address is wrong (position: "        <> show err.position <> ")"
+  ValidationDNS.VEIPv6     _     -> "Invalid IPv6 address"
-  ValidationDNS.VEName     err       -> "The name (domain label) is wrong (position: " <> show err.position <> ")"
+  ValidationDNS.VEName     _     -> "Invalid Name (domain label)"
-  ValidationDNS.VETTL min max n      -> "Invalid TTL (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
+  ValidationDNS.VETTL _ _ _      -> "Invalid TTL"
-  ValidationDNS.VETXT      err       -> "The TXT input is wrong (position: "           <> show err.position <> ")"
+  ValidationDNS.VEDMARCpct _ _ _ -> "Invalid DMARC sample rate"
-  ValidationDNS.VECNAME    err       -> "The CNAME input is wrong (position: "         <> show err.position <> ")"
+  ValidationDNS.VEDMARCri  _ _ _ -> "Invalid DMARC report interval"
-  ValidationDNS.VENS       err       -> "The NS input is wrong (position: "            <> show err.position <> ")"
+  ValidationDNS.VETXT      _     -> "Invalid TXT"
-  ValidationDNS.VEMX       err       -> "The MX target input is wrong (position: "     <> show err.position <> ")"
+  ValidationDNS.VECNAME    _     -> "Invalid CNAME"
-  ValidationDNS.VEPriority min max n -> "Invalid Priority (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
+  ValidationDNS.VENS       _     -> "Invalid NS Target"
-  ValidationDNS.VESRV      err       -> "The SRV target input is wrong (position: "    <> show err.position <> ")"
+  ValidationDNS.VEMX       _     -> "Invalid MX Target"
-  ValidationDNS.VEProtocol err       -> "The Protocol input is wrong (position: "      <> show err.position <> ")"
+  ValidationDNS.VEPriority _ _ _ -> "Invalid Priority"
-  ValidationDNS.VEPort min max n     -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
+  ValidationDNS.VESRV      _     -> "Invalid SRV Target"
-  ValidationDNS.VEWeight min max n   -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
+  ValidationDNS.VEProtocol _     -> "Invalid Protocol"
+  ValidationDNS.VEPort _ _ _     -> "Invalid Port"
+  ValidationDNS.VEWeight _ _ _   -> "Invalid Weight"
 
   -- SPF dedicated RR
-  ValidationDNS.VESPFMechanismName err -> "The domain name in a SPF mechanism is wrong (position: " <> show err.position <> ")"
+  ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
-  ValidationDNS.VESPFMechanismIPv4 err -> "The IPv4 address in a SPF mechanism is wrong (position: "        <> show err.position <> ")"
+  ValidationDNS.VESPFMechanismIPv4 _ -> "The IPv4 address in a SPF mechanism is wrong"
-  ValidationDNS.VESPFMechanismIPv6 err -> "The IPv6 address in a SPF mechanism is wrong (position: "        <> show err.position <> ")"
+  ValidationDNS.VESPFMechanismIPv6 _ -> "The IPv6 address in a SPF mechanism is wrong"
 
-  ValidationDNS.VESPFModifierName err  -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong (position: " <> show err.position <> ")"
+  ValidationDNS.VESPFModifierName _    -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong"
-  ValidationDNS.DKIMInvalidKeySize _ _ -> "Public key has an invalid length."
+  ValidationDNS.DKIMInvalidKeySize _ _ -> "Public key has an invalid length"
 
 show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
 show_error_domain e = case e of
@@ -87,7 +101,7 @@ show_error_domain e = case e of
   _ -> Bulma.p """
            The domain (or label) contains invalid characters.
            A domain label should start with a letter,
-           then eventually a series of letters, digits and hyphenations ('-'),
+           then eventually a series of letters, digits and hyphenations ("-"),
            and must finish with either a letter or a digit.
          """
 
@@ -102,7 +116,7 @@ show_error_ip6 e = case e of
   IPAddress.IP6NotEnoughChunks ->
     Bulma.p """
       The IPv6 representation is erroneous, it should contain 8 groups of hexadecimal characters or
-      being shortened with a double ':' character, such as '2000::1'.
+      being shortened with a double ':' character, such as "2000::1".
       """
   IPAddress.IP6TooManyChunks ->
     Bulma.p "The IPv6 representation is erroneous. It should contain only up to 8 groups of hexadecimal characters."
@@ -147,10 +161,46 @@ error_to_paragraph_label v = Bulma.error_message (Bulma.p $ show_error_title_lab
 show_error_title_label :: ValidationLabel.Error -> String
 show_error_title_label v = case v of
   ValidationLabel.ParsingError x -> case x.error of
-    Nothing -> "Cannot parse the label (position: " <> show x.position <> ")."
+    Nothing -> "Invalid label"
     Just (ValidationLabel.CannotParse _) ->
-      "Cannot parse the label (position: " <> show x.position <> ")."
+      "Invalid label"
-    Just (ValidationLabel.CannotEntirelyParse) -> "Cannot entirely parse the label."
+    Just (ValidationLabel.CannotEntirelyParse) -> "Invalid label (cannot entirely parse the label)"
     Just (ValidationLabel.Size min max n) ->
       "Label size should be between " <> show min <> " and " <> show max
       <> " (current size: " <> show n <> ")."
+
+show_error_login :: L.Error -> String
+show_error_login = case _ of
+  L.ParsingError {error} -> maybe "" string_error_login error
+
+string_error_login :: L.LoginParsingError -> String
+string_error_login = case _ of
+  L.CannotParse         -> "cannot parse the login"
+  L.CannotEntirelyParse -> "cannot entirely parse the login"
+  L.Size min max n      -> "login size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
+
+show_error_email :: E.Error -> String
+show_error_email = case _ of
+  E.ParsingError {error} -> maybe "" string_error_email error
+
+string_error_email :: E.EmailParsingError -> String
+string_error_email = case _ of
+  E.CannotParse         -> "cannot parse the email"
+  E.CannotEntirelyParse -> "cannot entirely parse the email"
+  E.Size min max n      -> "email size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
+
+show_error_password :: P.Error -> String
+show_error_password = case _ of
+  P.ParsingError {error} -> maybe "" string_error_password error
+
+string_error_password :: P.PasswordParsingError -> String
+string_error_password = case _ of
+  P.CannotParse         -> "cannot parse the password"
+  P.CannotEntirelyParse -> "cannot entirely parse the password"
+  P.Size min max n      -> "password size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"

src/App/Message/AuthenticationDaemon.purs

@@ -70,11 +70,11 @@ codecValidateUser
 {- NOTE: "user" attribute for both PasswordRecovery and AskPasswordRecovery could be UserID,
          but they'll be used as login since the user has to type it. -}
 {- 3  -}
-type AskPasswordRecovery = { user :: Maybe String, email :: Maybe Email.Email }
+type AskPasswordRecovery = { login :: Maybe String, email :: Maybe Email.Email }
 codecAskPasswordRecovery ∷ CA.JsonCodec AskPasswordRecovery
 codecAskPasswordRecovery
   = CA.object "AskPasswordRecovery"
-      (CAR.record { user: CAR.optional CA.string, email: CAR.optional Email.codec })
+      (CAR.record { login: CAR.optional CA.string, email: CAR.optional Email.codec })
 
 {- 4  -}
 type PasswordRecovery = { user               :: String

src/App/Message/DNSManagerDaemon.purs

@@ -208,10 +208,12 @@ codecAcceptedDomains ∷ CA.JsonCodec AcceptedDomains
 codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string })
 
 {- 16  -}
-type Logged = { accepted_domains :: Array String, my_domains :: Array String }
+type Logged = { accepted_domains :: Array String, my_domains :: Array String, admin :: Boolean }
 codecLogged ∷ CA.JsonCodec Logged
 codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
-                                             ,       my_domains: CA.array CA.string })
+                                             ,       my_domains: CA.array CA.string
+                                             ,            admin: CA.boolean
+                                             })
 
 {- 17  -}
 type DomainAdded = { domain :: String }

src/App/Page/Administration.purs

@@ -1,5 +1,5 @@
 {- Administration interface.
-   Allows to:
+   Enables to:
      - add, remove, search users
      - TODO: validate users
      - TODO: change user password
@@ -10,7 +10,7 @@
 -}
 module App.Page.Administration where
 
-import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=), (==))
+import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=), (==), unit)
 import Data.Eq (class Eq)
 
 import Bulma as Bulma
@@ -21,7 +21,6 @@ import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event (Event)
 import Web.Event.Event as Event
 
@@ -54,8 +53,6 @@ data Output
 
 data Query a
   = MessageReceived AuthD.AnswerMessage a
-  | ConnectionIsDown a
-  | ConnectionIsUp a
   | GotOrphanDomainList (Array String) a
   | ProvideState (Maybe State) a
 
@@ -104,7 +101,6 @@ type State =
   { addUserForm    :: StateAddUserForm
   , searchUserForm :: StateSearchUserForm
   , current_tab    :: Tab
-  , wsUp           :: Boolean
   , matching_users :: Array UserPublic
   , orphan_domains :: Array String
   }
@@ -128,11 +124,10 @@ initialState _ = { addUserForm:    { login: "", admin: false, email: "", pass: "
                  , matching_users: []
                  , orphan_domains: []
                  , current_tab: Home
-                 , wsUp: true
                  }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains, wsUp }
+render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains }
   = Bulma.section_small
       [ fancy_tab_bar
       , case current_tab of
@@ -167,15 +162,14 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
                                  , Bulma.btn_ (C.is_small) domain (ShowDomain domain)
                                  ]
     up x = HandleAddUserInput <<< x
-    active = (if wsUp then (HP.enabled true) else (HP.disabled true))
 
     render_adduser_form =
       HH.form
         [ HE.onSubmit PreventSubmit ]
-        [ Bulma.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login active
+        [ Bulma.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login
         , Bulma.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin)
-        , Bulma.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email active
+        , Bulma.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email
-        , Bulma.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass active
+        , Bulma.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass
         , Bulma.btn "Send" AddUserAttempt
         ]
 
@@ -184,13 +178,13 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
         [ HE.onSubmit PreventSubmit ]
         [ Bulma.p """
                   Following input accepts any regex.
-                  This will be used to search an user based on his login, full name or email address.
+                  This is used to search for a user based on their login, full name or email address.
                   """
-        , Bulma.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex active
+        , Bulma.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex
         --, Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin)
         --    (HandleAddUserInput SEARCHUSER_toggle_admin)
         --, Bulma.box_input "domain" "Domain owned" "blah.netlib.re."
-        --    (up SEARCHUSER_INP_domain) searchUserForm.domain active
+        --    (up SEARCHUSER_INP_domain) searchUserForm.domain
         , Bulma.btn "Send" SearchUserAttempt
         ]
 
@@ -201,7 +195,7 @@ handleAction = case _ of
     sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
     old_tab <- H.liftEffect $ Storage.getItem "current-ada-tab" sessionstorage
     case old_tab of
-      Nothing -> H.raise $ Log $ ErrorLog "We hadn't changed tab before reload apparently."
+      Nothing -> pure unit
       Just current_tab -> case current_tab of
         "Home"          -> handleAction $ ChangeTab Home
         "Search"        -> handleAction $ ChangeTab Search
@@ -312,19 +306,9 @@ handleQuery = case _ of
         H.modify_ _ { matching_users = A.filter (\x -> x.uid /= msg.uid) matching_users }
 
       -- Unexpected message.
-      _ -> do
+      _ -> H.raise $ Log $ ErrorLog $ "Authentication server didn't send a valid message."
-        H.raise $ Log $ ErrorLog $ "Authentication server didn't send a valid message."
-    pure (Just a)
-
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
     pure (Just a)
 
   GotOrphanDomainList domains a -> do
-    H.raise $ Log $ SuccessLog "Got orphan domain list!"
     H.modify_ _ { orphan_domains = domains }
     pure (Just a)

src/App/Page/Authentication.purs

@@ -2,23 +2,27 @@
 -- | TODO: token validation.
 module App.Page.Authentication where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (>), (==), map, show)
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show, unit)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Maybe (Maybe(..), maybe)
 import Data.Either (Either(..))
+import Data.Eq (class Eq)
+import Data.Maybe (Maybe(..), maybe)
 import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
 import Bulma as Bulma
 
+import Web.HTML (window) as HTML
+import Web.HTML.Window (sessionStorage) as Window
+import Web.Storage.Storage as Storage
+
 import App.Type.LogMessage
 import App.Message.AuthenticationDaemon as AuthD
 
@@ -47,6 +51,7 @@ data Output
   = MessageToSend ArrayBuffer
   | AuthenticateToAuthd (Tuple Login Password)
   | Log LogMessage
+  | UserLogin String
   | PasswordRecovery Login PasswordRecoveryToken Password
   | AskPasswordRecovery (Either Email Login)
 
@@ -55,8 +60,6 @@ data Output
 -- | Also, the component is informed when the connection went up or down.
 data Query a
   = MessageReceived AuthD.AnswerMessage a
-  | ConnectionIsDown a
-  | ConnectionIsUp a
 
 type Slot = H.Slot Query Output
 
@@ -77,7 +80,8 @@ data NewPasswordInput
   | NEWPASS_INP_confirmation String
 
 data Action
-  = HandleAuthenticationInput AuthenticationInput
+  = Initialize
+  | HandleAuthenticationInput AuthenticationInput
   | HandlePasswordRecovery    PasswordRecoveryInput
   | HandleNewPassword         NewPasswordInput
   --
@@ -85,6 +89,14 @@ data Action
   | PasswordRecoveryAttempt Event
   | NewPasswordAttempt Event
 
+  -- | Change the displayed tab.
+  | ChangeTab Tab
+
+-- | There are different tabs in the administration page.
+-- | For example, users can be searched (`authd`) and a list is provided.
+data Tab = Auth | ILostMyPassword | Recovery
+derive instance eqTab :: Eq Tab
+
 type StateAuthenticationForm = { login :: String, pass :: String }
 type StatePasswordRecoveryForm = { login :: String, email :: String }
 type StateNewPasswordForm = { login :: String, token :: String, password :: String, confirmation :: String }
@@ -94,7 +106,7 @@ type State =
   , passwordRecoveryForm   :: StatePasswordRecoveryForm
   , newPasswordForm        :: StateNewPasswordForm
   , errors                 :: Array Error
-  , wsUp                   :: Boolean
+  , current_tab            :: Tab
   }
 
 initialState :: Input -> State
@@ -102,8 +114,8 @@ initialState _ =
   { authenticationForm:   { login: "", pass:  "" }
   , passwordRecoveryForm: { login: "", email: "" }
   , newPasswordForm: { login: "", token: "", password: "", confirmation: "" }
-  , wsUp: true
   , errors: []
+  , current_tab: Auth
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -112,26 +124,33 @@ component =
     { initialState
     , render
     , eval: H.mkEval $ H.defaultEval
-        { handleAction = handleAction
+        { initialize   = Just Initialize
+        , handleAction = handleAction
         , handleQuery  = handleQuery
         }
     }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { wsUp, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
+render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
   Bulma.section_small
-    [ case wsUp of
+    [ fancy_tab_bar
-        false -> Bulma.p "You are disconnected."
+    , if A.length errors > 0
-        true  ->
+      then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ] ]
-          if A.length errors > 0
+      else HH.div_ []
-          then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ]
+    , case current_tab of
-                       , Bulma.columns_ [ b auth_form, b passrecovery_form, b newpass_form ]
+        Auth            -> Bulma.box auth_form
-                       ]
+        ILostMyPassword -> Bulma.box passrecovery_form
-          else Bulma.columns_ [ b auth_form, b passrecovery_form, b newpass_form ]
+        Recovery        -> Bulma.box newpass_form
     ]
 
   where
-    b e = Bulma.column_ [ Bulma.box e ]
+    fancy_tab_bar =
+      Bulma.fancy_tabs
+        [ Bulma.tab_entry (is_tab_active Auth) "Authentication" (ChangeTab Auth)
+        , Bulma.tab_entry (is_tab_active ILostMyPassword) "I lost my password! 😟" (ChangeTab ILostMyPassword)
+        , Bulma.tab_entry (is_tab_active Recovery) "Recover with a token" (ChangeTab Recovery)
+        ]
+    is_tab_active tab = current_tab == tab
 
     show_error :: Error -> String
     show_error = case _ of
@@ -177,28 +196,32 @@ render { wsUp, authenticationForm, passwordRecoveryForm, newPasswordForm, errors
                                <> show min <> " and " <> show max
                                <> " (currently: " <> show n <> ")"
 
-    auth_form         = [ Bulma.h3 "Authentication"   , render_auth_form ]
+    auth_form = [ Bulma.h3 "Authentication", render_auth_form ]
-    passrecovery_form = [ Bulma.h3 "Password Recovery", render_password_recovery_form ]
+    passrecovery_form =
-    newpass_form      = [ Bulma.h3 "New password", render_new_password_form ]
+      [ Bulma.h3 "You forgot your password (or your login)"
-
+      , Bulma.div_content
-    should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
+        [ Bulma.p "Enter either your login or email and you'll receive a recovery token."
+        ]
+      , render_password_recovery_form
+      ]
+    newpass_form =
+      [ Bulma.h3 "You got the password recovery mail"
+      , Bulma.div_content
+        [ Bulma.p "Nice! You get to choose your new password."
+        ]
+      , render_new_password_form
+      ]
 
     render_auth_form = HH.form
       [ HE.onSubmit AuthenticationAttempt ]
       [ Bulma.box_input "loginLOGIN" "Login" "login"                    -- title, placeholder
           (HandleAuthenticationInput <<< AUTH_INP_login)   -- action
           authenticationForm.login                         -- value
-          should_be_disabled                               -- condition
       , Bulma.box_password "passwordLOGIN" "Password" "password"           -- title, placeholder
           (HandleAuthenticationInput <<< AUTH_INP_pass)    -- action
           authenticationForm.pass                          -- value
-          should_be_disabled                               -- condition
+      , Bulma.btn_validation
-      , HH.button
+
-         [ HP.style "padding: 0.5rem 1.25rem;"
-         , HP.type_ HP.ButtonSubmit
-         , (if wsUp then (HP.enabled true) else (HP.disabled true))
-         ]
-         [ HH.text "Send Message to Server" ]
       ]
 
     render_password_recovery_form = HH.form
@@ -206,17 +229,10 @@ render { wsUp, authenticationForm, passwordRecoveryForm, newPasswordForm, errors
       [ Bulma.box_input "loginPASSR" "Login" "login"                    -- title, placeholder
           (HandlePasswordRecovery <<< PASSR_INP_login)  -- action
           passwordRecoveryForm.login                       -- value
-          should_be_disabled                               -- condition
       , Bulma.box_input "emailPASSR" "Email" "email"                    -- title, placeholder
           (HandlePasswordRecovery <<< PASSR_INP_email)  -- action
           passwordRecoveryForm.email                       -- value
-          should_be_disabled                               -- condition
+      , Bulma.btn_validation
-      , HH.button
-         [ HP.style "padding: 0.5rem 1.25rem;"
-         , HP.type_ HP.ButtonSubmit
-         , (if wsUp then (HP.enabled true) else (HP.disabled true))
-         ]
-         [ HH.text "Send Message to Server" ]
       ]
 
     render_new_password_form = HH.form
@@ -224,30 +240,32 @@ render { wsUp, authenticationForm, passwordRecoveryForm, newPasswordForm, errors
       [ Bulma.box_input "loginNEWPASS" "Login" "login"
           (HandleNewPassword <<< NEWPASS_INP_login)
           newPasswordForm.login
-          should_be_disabled
       , Bulma.box_input "tokenNEWPASS" "Token" "token"
           (HandleNewPassword <<< NEWPASS_INP_token)
           newPasswordForm.token
-          should_be_disabled
       , Bulma.box_password "passwordNEWPASS" "Password" "password"
           (HandleNewPassword <<< NEWPASS_INP_password)
           newPasswordForm.password
-          should_be_disabled
       , Bulma.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
           (HandleNewPassword <<< NEWPASS_INP_confirmation)
           newPasswordForm.confirmation
-          should_be_disabled
+      , Bulma.btn_validation
-      , HH.button
-         [ HP.style "padding: 0.5rem 1.25rem;"
-         , HP.type_ HP.ButtonSubmit
-         , (if wsUp then (HP.enabled true) else (HP.disabled true))
-         ]
-         [ HH.text "Send Message to Server" ]
       ]
 
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
+  Initialize -> do
+    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    old_tab <- H.liftEffect $ Storage.getItem "current-auth-tab" sessionstorage
+    case old_tab of
+      Nothing -> pure unit
+      Just current_tab -> case current_tab of
+        "Auth"            -> handleAction $ ChangeTab Auth
+        "ILostMyPassword" -> handleAction $ ChangeTab ILostMyPassword
+        "Recovery"        -> handleAction $ ChangeTab Recovery
+        _  -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
+
   HandleAuthenticationInput authinp -> do
     case authinp of
       AUTH_INP_login v -> H.modify_ _ { authenticationForm { login = v } }
@@ -271,6 +289,7 @@ handleAction = case _ of
     { authenticationForm } <- H.get
     let { login, pass } = authenticationForm
 
+    H.raise $ UserLogin login
     case login, pass of
       "" , _ ->
         H.raise $ Log $ UnableToSend "Write your login!"
@@ -307,7 +326,6 @@ handleAction = case _ of
                _           -> do H.modify_ _ { errors = [] }
                                  H.raise $ AskPasswordRecovery (Left email)
 
-  -- TODO: verify the login?
   NewPasswordAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
 
@@ -315,13 +333,28 @@ handleAction = case _ of
     let { login, token, password, confirmation} = newPasswordForm
 
     if A.any (_ == "") [ login, token, password, confirmation ]
-    then H.raise $ Log $ ErrorLog "All entries are required!"
+    then H.raise $ Log $ ErrorLog "All entries are required."
     else if password == confirmation
-         then case L.login login of
+         then case L.login login, P.password password of
-                Left errors -> H.modify_ _ { errors = [ Login errors ] }
+                Left errors, _ -> H.modify_ _ { errors = [ Login    errors ] }
-                Right _     -> do H.modify_ _ { errors = [] }
+                _, Left errors -> H.modify_ _ { errors = [ Password errors ] }
-                                  H.raise $ PasswordRecovery login token password
+                _, _           -> do H.modify_ _ { errors = [] }
-         else H.raise $ Log $ UnableToSend "Confirmation differs from password!"
+                                     H.raise $ Log $ SystemLog $ "Sending a new password"
+                                     H.raise $ PasswordRecovery login token password
+         else H.raise $ Log $ UnableToSend "Confirmation differs from password"
+
+  ChangeTab current_tab -> do
+    -- Store the current tab we are on and restore it when we reload.
+    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    _ <- case current_tab of
+      Auth -> do
+        H.modify_ \state -> state { authenticationForm { login = state.newPasswordForm.login } }
+        H.liftEffect $ Storage.setItem "current-auth-tab" "Auth"                sessionstorage
+      ILostMyPassword -> H.liftEffect $ Storage.setItem "current-auth-tab" "ILostMyPassword" sessionstorage
+      Recovery -> do
+        H.modify_ \state -> state { newPasswordForm { login = state.passwordRecoveryForm.login } }
+        H.liftEffect $ Storage.setItem "current-auth-tab" "Recovery"            sessionstorage
+    H.modify_ _ { current_tab = current_tab }
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
@@ -329,14 +362,10 @@ handleQuery = case _ of
   -- Error messages are simply logged (see the code in the Container component).
   MessageReceived message _ -> do
     case message of
+      AuthD.GotPasswordRecovered _ -> do
+        handleAction $ ChangeTab Auth
+      AuthD.GotPasswordRecoverySent _ -> do
+        handleAction $ ChangeTab Recovery
       _ -> do
         H.raise $ Log $ ErrorLog $ "Message not handled in AuthenticationInterface."
     pure Nothing
-
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
-    pure (Just a)

src/App/Page/DomainList.purs

@@ -1,7 +1,7 @@
 -- | `App.DomainListInterface` is a simple component with the list of own domains
 -- | and a form to add a new domain.
 -- |
--- | This interface allows to:
+-- | This interface enables to:
 -- |   - display the list of own domains
 -- |   - show and select accepted domains (TLDs)
 -- |   - create new domains
@@ -16,6 +16,7 @@ import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
+import Data.String (toLower)
 import Data.Maybe (Maybe(..), maybe)
 import Data.String.Utils (endsWith)
 import Effect.Aff.Class (class MonadAff)
@@ -23,7 +24,6 @@ import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Events as HHE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 import Bulma as Bulma
@@ -32,7 +32,6 @@ import App.DisplayErrors (error_to_paragraph_label)
 
 import App.Validation.Label as Validation
 
-import CSSClasses as C
 import App.Type.LogMessage
 import App.Message.DNSManagerDaemon as DNSManager
 
@@ -65,8 +64,6 @@ data Output
 
 data Query a
   = MessageReceived DNSManager.AnswerMessage a
-  | ConnectionIsDown a
-  | ConnectionIsUp a
   | ProvideState (Maybe State) a
 
 type Slot = H.Slot Query Output
@@ -123,7 +120,6 @@ type State =
   , accepted_domains       :: Array String
   , my_domains             :: Array String
 
-  , wsUp :: Boolean
   , active_modal :: Maybe String
   }
 
@@ -153,32 +149,31 @@ initialState _ =
                    }
   , accepted_domains: [ default_domain ]
   , my_domains: [ ]
-  , wsUp: true
   , active_modal: Nothing
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { accepted_domains, my_domains, newDomainForm, wsUp, active_modal }
+render { accepted_domains, my_domains, newDomainForm, active_modal }
   = Bulma.section_small
-      [ case wsUp of
+      [ case active_modal of
-          false -> Bulma.p "You are disconnected."
+          Nothing -> Bulma.columns_
-          true  -> case active_modal of
+            [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form]
-            Nothing -> Bulma.columns_
+            , Bulma.column_ [ Bulma.h3 "My domains"
-              [ Bulma.column_ [ Bulma.h3 "Add a domain!", render_add_domain_form]
+                            , if A.length my_domains > 0
-              , Bulma.column_ [ Bulma.h3 "My domains"
+                              then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains
-                              , HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) my_domains
+                              else Bulma.p "No domain yet."
-                              ]
+                            ]
-              ]
+            ]
-            Just domain -> Bulma.modal "Deleting a domain"
+          Just domain -> Bulma.modal "Deleting a domain"
-              [warning_message domain] [modal_delete_button domain, modal_cancel_button]
+            [warning_message domain] [modal_delete_button domain, modal_cancel_button]
       ]
   where
     modal_delete_button domain = Bulma.alert_btn "Delete the domain" (RemoveDomain domain)
     modal_cancel_button = Bulma.cancel_button CancelModal
     warning_message domain
-      = HH.p [] [ HH.text $ "You are about to delete your domain '"
+      = HH.p [] [ HH.text $ "You are about to delete your domain \""
                             <> domain
-                            <> "'. Are you sure you want to do this? This is "
+                            <> "\". Are you sure you want to do this? This is "
                 , HH.strong_ [ HH.text "irreversible" ]
                 , HH.text "."
                 ]
@@ -194,12 +189,8 @@ render { accepted_domains, my_domains, newDomainForm, wsUp, active_modal }
           (HandleNewDomainInput <<< INP_newdomain)
           newDomainForm.new_domain
           [ HHE.onSelectedIndexChange domain_choice ]
-          accepted_domains
+          (map (\v -> "." <> v) accepted_domains)
-      , HH.button
+      , Bulma.btn_validation_ "add a new domain"
-          [ HP.type_ HP.ButtonSubmit
-          , HP.classes C.button
-          ]
-          [ HH.text "add a new domain!" ]
       , if A.length newDomainForm._errors > 0
         then HH.div_ $ map error_to_paragraph_label newDomainForm._errors
         else HH.div_ [ ]
@@ -230,7 +221,7 @@ handleAction = case _ of
   HandleNewDomainInput adduserinp -> do
     case adduserinp of
       INP_newdomain v -> do
-        H.modify_ _ { newDomainForm { new_domain = v } }
+        H.modify_ _ { newDomainForm { new_domain = toLower v } }
         case v of
           "" -> H.modify_ _ { newDomainForm { _errors = [] } }
           _ -> case Validation.label v of
@@ -256,18 +247,18 @@ handleAction = case _ of
     { newDomainForm } <- H.get
     let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain
 
-    case newDomainForm._errors, new_domain of
+    case newDomainForm.new_domain, newDomainForm._errors, new_domain of
-      _, "" ->
+      "", _, _ ->
         H.raise $ Log $ UnableToSend "You didn't enter the new domain!"
-      [], _ -> do
+      _, [], _ -> do
         message <- H.liftEffect
           $ DNSManager.serialize
           $ DNSManager.MkNewDomain { domain: new_domain }
         H.raise $ MessageToSend message
         H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")"
         handleAction $ HandleNewDomainInput $ INP_newdomain ""
-      _, _ ->
+      _, _, _ ->
-        H.raise $ Log $ UnableToSend $ "You didn't enter a valid new domain"
+        H.raise $ Log $ UnableToSend $ "The new domain name is invalid."
 
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
@@ -296,20 +287,12 @@ handleQuery = case _ of
       _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
     pure (Just a)
 
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
-    pure (Just a)
-
 page_reload :: State -> DNSManager.AnswerMessage -> State
 page_reload s1 message =
   case message of
     DNSManager.MkLogged response ->
       s1 { accepted_domains = response.accepted_domains
-         , my_domains = response.my_domains
+         , my_domains = A.sort response.my_domains
          }
     _ -> s1
 

src/App/Page/Home.purs

@@ -41,25 +41,27 @@ initialState _ = unit
 render :: forall m. State -> H.ComponentHTML Action () m
 render _ = HH.div_
              [ Bulma.hero_danger
-                 "THIS IS AN ALPHA RELEASE"
+                 "THIS IS A BETA RELEASE"
-                 "You can register, login and play a bit with the tool! Please, report errors and suggestions"
+                 "You can register, login and play a bit with the tool. Feel free to report errors and suggestions!"
              , Bulma.section_small
                  [ Bulma.h1 "Welcome to netlib.re"
-                 , Bulma.subtitle "Free domain names"
+                 , Bulma.subtitle "Free domain names for the common folks"
                  , Bulma.hr
                  , render_description
-                 , render_second_line
+                 , render_update_why_and_contact
-                 , render_why_and_contact
                  , Bulma.hr
                  , render_how_and_code
                  ]
              ]
   where
     title = Bulma.h3
+    expl content = Bulma.div_content [ Bulma.explanation content ]
     p = Bulma.p
     b x = Bulma.column_ [ Bulma.box [ Bulma.div_content x ] ]
 
-    render_description = Bulma.columns_ [ render_basics, render_no_expert ]
+    render_description = Bulma.columns_ [ render_basics, render_no_expert, render_no_housing ]
+    render_update_why_and_contact = Bulma.columns_ [ render_updates, render_why, render_contact ]
+
     render_basics
       = b [ title "What is provided?"
           , p "Reserve a domain name in <something>.netlib.re for free."
@@ -71,7 +73,6 @@ render _ = HH.div_
               This website will help you through your configuration, as much as we can.
               """
           ]
-    render_second_line = Bulma.columns_ [ render_no_housing, render_updates ]
     render_no_housing
       = b [ title "No housing, just a name"
           , p """
@@ -83,12 +84,10 @@ render _ = HH.div_
     render_updates
       = b [ title "Automatic updates"
           , p "Update your records with a single, stupidly simple command. For example:"
-          , expl [ Bulma.strong "wget https://beta.netlib.re/token-update/<token>" ]
+          , expl [ Bulma.strong "wget https://netlib.re/token-update/<token>" ]
           , p "Every A and AAAA records have tokens for easy updates!"
           ]
 
-    expl content = Bulma.div_content [ Bulma.explanation content ]
-    render_why_and_contact = Bulma.columns_ [ render_why, render_contact ]
     render_why
       = b [ title "Why?"
           , p "Because everyone should be able to have a place on the Internet."
@@ -116,9 +115,9 @@ render _ = HH.div_
                    the authentication (and authorization) daemon, used to authenticate
                    clients through different services;
                    """
-            , link "https://git.baguette.netlib.re/Baguette/dnsmanagerd" "dnsmanagerd"
+            , link "https://git.baguette.netlib.re/Baguette/dnsmanager" "dnsmanagerd"
                    """
-                   the dns manager daemon, used as an interactive database, allowing clients
+                   the dns manager daemon, used as an interactive database, enabling clients
                    to ask for domains, then handle the domain zones;
                    """
             , link "https://git.baguette.netlib.re/Baguette/dnsmanager-webclient"
@@ -138,7 +137,7 @@ render _ = HH.div_
                    """
             , link "https://git.baguette.netlib.re/Baguette/dodb.cr" "dodb"
                    """
-                   the Document Oriented DataBase, allowing to store serialized objects
+                   the Document Oriented DataBase, enabling to store serialized objects
                    (a Zone, a User, etc.) in simple files as opposed to the usual complexity of
                    traditional databases.
                    """

src/App/Page/MailValidation.purs

@@ -3,17 +3,16 @@
 -- | This token has to be used to validate the email address.
 module App.Page.MailValidation where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), map, show)
+import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, show)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (maybe)
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
@@ -30,9 +29,7 @@ data Output
   | Log LogMessage
 
 -- | The component is informed when the connection went up or down.
-data Query a
+data Query a = DoNothing a
-  = ConnectionIsDown a
-  | ConnectionIsUp a
 
 type Slot = H.Slot Query Output
 
@@ -65,7 +62,6 @@ type MailValidationForm = { login :: String, token :: String }
 type State =
   { mailValidationForm :: MailValidationForm
   , errors             :: Array Error
-  , wsUp               :: Boolean
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -75,7 +71,6 @@ component =
     , render
     , eval: H.mkEval $ H.defaultEval
         { handleAction = handleAction
-        , handleQuery  = handleQuery
         }
     }
 
@@ -83,41 +78,25 @@ initialState :: Input -> State
 initialState _ =
   { mailValidationForm: { login: "", token: "" }
   , errors: []
-  , wsUp: true
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { wsUp, mailValidationForm }
+render { mailValidationForm }
-  = Bulma.section_small
+  = Bulma.section_small [ Bulma.columns_ [ b mail_validation_form ] ]
-      [ case wsUp of
-          false -> Bulma.p "You are disconnected."
-          true  -> Bulma.columns_ [ b mail_validation_form ]
-      ]
 
   where
     b e = Bulma.column_ [ Bulma.box e ]
     mail_validation_form = [ Bulma.h3 "Verify your account", render_register_form ]
 
-    should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
-
     render_register_form = HH.form
       [ HE.onSubmit ValidateInputs ]
       [ Bulma.box_input "loginValidation" "Login" "login"   -- title, placeholder
           (HandleValidationInput <<< VALIDATION_INP_login)  -- action
           mailValidationForm.login                          -- value
-          should_be_disabled                                -- condition
       , Bulma.box_input "tokenValidation" "Token" "token"   -- title, placeholder
           (HandleValidationInput <<< VALIDATION_INP_token)  -- action
           mailValidationForm.token                          -- value
-          should_be_disabled                                -- condition
+      , Bulma.btn_validation
-      , HH.div_
-          [ HH.button
-              [ HP.style "padding: 0.5rem 1.25rem;"
-              , HP.type_ HP.ButtonSubmit
-              , (if wsUp then (HP.enabled true) else (HP.disabled true))
-              ]
-              [ HH.text "Send Message to Server" ]
-          ]
       ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
@@ -185,13 +164,3 @@ string_error_token = case _ of
   T.Size min max n      -> "token size should be between "
                            <> show min <> " and " <> show max
                            <> " (currently: " <> show n <> ")"
-
-handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
-handleQuery = case _ of
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
-    pure (Just a)

src/App/Page/Navigation.purs

@@ -31,7 +31,10 @@ data Output
   | Disconnection
 
 -- | The component needs to know when the user is logged or not.
-data Query a = ToggleLogged Boolean a
+data Query a 
+  = ToggleLogged Boolean a
+  | ToggleAdmin Boolean a
+  | TellLogin (Maybe String) a
 
 type Slot = H.Slot Query Output
 
@@ -53,7 +56,7 @@ data Action
 -- | - `logged`, a boolean to toggle the display of some parts of the menu.
 -- | - `active`, a boolean to toggle the display of the menu.
 -- | - `admin`, a boolean to toggle the display of administration page link.
-type State = { logged :: Boolean, active :: Boolean, admin :: Boolean }
+type State = { logged :: Boolean, login :: Maybe String, active :: Boolean, admin :: Boolean }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
 component =
@@ -66,13 +69,16 @@ component =
     }
 
 initialState :: Input -> State
-initialState _ = { logged: false, active: false, admin: true }
+initialState _ = { logged: false, login: Nothing, active: false, admin: false }
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
   ToggleMenu -> H.modify_ \state -> state { active = not state.active }
   -- | Page change.
-  Navigate page -> H.raise $ Routing page
+  Navigate page -> do
+    -- Automatically close the menu.
+    H.modify_ \state -> state { active = false }
+    H.raise $ Routing page
   UnLog         -> do
     H.raise $ Disconnection
     H.modify_ _ { logged = false }
@@ -82,6 +88,12 @@ handleQuery = case _ of
   ToggleLogged islogged a -> do
     H.modify_ _ { logged = islogged }
     pure (Just a)
+  ToggleAdmin isadmin a -> do
+    H.modify_ _ { admin = isadmin }
+    pure (Just a)
+  TellLogin login a -> do
+    H.modify_ _ { login = login }
+    pure (Just a)
 
 
 -- | The navigation bar is a complex component to render.
@@ -93,7 +105,7 @@ handleQuery = case _ of
 -- | Also, when clicked again, the list disappears.
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { logged, active, admin } =
+render { logged, active, admin, login } =
   main_nav
     [ nav_brand [ logo, burger_menu ]
     , nav_menu
@@ -112,7 +124,7 @@ render { logged, active, admin } =
   right_bar_div =
     case logged of
         false -> [ link_auth, link_register, link_mail_validation ]
-        _     -> [ link_setup, link_disconnection ]
+        _     -> render_login login <> [ link_setup, link_disconnection ]
 
   navbar_color = C.is_success
 
@@ -122,7 +134,7 @@ render { logged, active, admin } =
            , ARIA.role "navigation"
            ]
 
-  logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🔻🍉"]
+  logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🍉"]
   --  HH.a [HP.classes C.navbar_item, HP.href "/"]
   --       [HH.img [HP.src "/logo.jpeg", HP.width 112, HP.height 28]]
 
@@ -153,6 +165,8 @@ render { logged, active, admin } =
   link_register        = nav_link_strong "Register"          (Navigate Registration)
   link_mail_validation = nav_link        "Mail verification" (Navigate MailValidation)
   link_setup           = nav_link_warn   "⚒ Setup"           (Navigate Setup)
+  render_login Nothing = []
+  render_login (Just l)= [nav_link       ("logged as " <> l) (Navigate Setup)]
   link_disconnection   =
     nav_link_ (C.has_text_light <> C.has_background_danger) "Disconnection" UnLog
 
@@ -160,7 +174,6 @@ render { logged, active, admin } =
     = HH.div [HP.classes $ C.navbar_item <> C.has_dropdown <> C.is_hoverable]
         [ dropdown_title title, HH.div [HP.classes C.navbar_dropdown] dropdown_elements ]
   dropdown_title str = HH.a [HP.classes C.navbar_link] [HH.text str]
-  dropdown_element link str = HH.a [HP.classes C.navbar_item, HP.href link] [HH.text str]
   dropdown_separator = HH.hr [HP.classes C.navbar_divider]
 
   --nav_button_strong str action = btn C.is_primary action (HH.strong [] [ HH.text str ])
@@ -179,6 +192,10 @@ render { logged, active, admin } =
          , HE.onClick (\_ -> action)
          ] [ (HH.text str) ]
 
+  dropdown_element classes link str = HH.a [HP.classes (C.navbar_item <> classes), HP.href link] [HH.text str]
+  dropdown_element_primary link str   = dropdown_element C.has_background_info_light link str
+  dropdown_element_secondary link str = dropdown_element C.has_background_warning_light link str
+
   dropdown_section_primary t
     = HH.p [HP.classes $ C.has_background_info <> C.has_text_light <> C.navbar_item] [HH.text t]
   dropdown_section_secondary t
@@ -186,13 +203,13 @@ render { logged, active, admin } =
   code_dropdown =
     dropdown "Source code"
       [ dropdown_section_primary "Main parts of this service"
-      , dropdown_element "https://git.baguette.netlib.re/Baguette/authd" "authentication daemon"
+      , dropdown_element_primary "https://git.baguette.netlib.re/Baguette/authd" "authentication daemon"
-      , dropdown_element "https://git.baguette.netlib.re/Baguette/dnsmanager" "dnsmanager daemon"
+      , dropdown_element_primary "https://git.baguette.netlib.re/Baguette/dnsmanager" "dnsmanager daemon"
-      , dropdown_element "https://git.baguette.netlib.re/Baguette/dnsmanager-webclient" "dnsmanager web client"
+      , dropdown_element_primary "https://git.baguette.netlib.re/Baguette/dnsmanager-webclient" "dnsmanager web client"
       , dropdown_separator
       , dropdown_section_secondary "A few more links (for nerds)"
-      , dropdown_element "https://git.baguette.netlib.re/Baguette/libipc" "libIPC: communication library"
+      , dropdown_element_secondary "https://git.baguette.netlib.re/Baguette/libipc" "libIPC: communication library"
-      , dropdown_element "https://git.baguette.netlib.re/Baguette/dodb.cr" "DoDB: document-oriented database"
+      , dropdown_element_secondary "https://git.baguette.netlib.re/Baguette/dodb.cr" "DoDB: document-oriented database"
       ]
 
   --btn c action str

src/App/Page/Registration.purs

@@ -2,17 +2,16 @@
 -- | Registration requires a login, an email address and a password.
 module App.Page.Registration where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), map, show)
+import Prelude (Unit, bind, discard, ($), (<<<), (<>), map)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
@@ -22,6 +21,8 @@ import App.Type.Email as Email
 import App.Type.LogMessage
 import App.Message.AuthenticationDaemon as AuthD
 
+import App.DisplayErrors (show_error_login, show_error_email, show_error_password)
+
 import App.Validation.Login as L
 import App.Validation.Email as E
 import App.Validation.Password as P
@@ -30,10 +31,7 @@ data Output
   = MessageToSend ArrayBuffer
   | Log LogMessage
 
--- | The component is informed when the connection went up or down.
+data Query a = DoNothing a
-data Query a
-  = ConnectionIsDown a
-  | ConnectionIsUp a
 
 type Slot = H.Slot Query Output
 
@@ -68,14 +66,12 @@ type StateRegistrationForm = { login :: String, email :: String, pass :: String
 type State =
   { registrationForm :: StateRegistrationForm
   , errors           :: Array Error
-  , wsUp             :: Boolean
   }
 
 initialState :: Input -> State
 initialState _ =
   { registrationForm: { login: "", email: "", pass: "" }
   , errors: []
-  , wsUp: true
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -85,46 +81,29 @@ component =
     , render
     , eval: H.mkEval $ H.defaultEval
         { handleAction = handleAction
-        , handleQuery  = handleQuery
         }
     }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { wsUp, registrationForm }
+render { registrationForm }
-  = Bulma.section_small
+  = Bulma.section_small [Bulma.columns_ [ b registration_form ]]
-      [ case wsUp of
-          false -> Bulma.p "You are disconnected."
-          true  -> Bulma.columns_ [ b registration_form ]
-      ]
 
   where
     b e = Bulma.column_ [ Bulma.box e ]
-    registration_form = [ Bulma.h3 "Register!", render_register_form ]
+    registration_form = [ Bulma.h3 "Register", render_register_form ]
-
-    should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
 
     render_register_form = HH.form
       [ HE.onSubmit ValidateInputs ]
       [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
           (HandleRegisterInput <<< REG_INP_login)      -- action
           registrationForm.login                       -- value
-          should_be_disabled                           -- condition
       , Bulma.box_input "emailREGISTER" "Email" "email@example.com"    -- title, placeholder
           (HandleRegisterInput <<< REG_INP_email)      -- action
           registrationForm.email                       -- value
-          should_be_disabled                           -- condition
       , Bulma.box_password "passwordREGISTER" "Password" "password"       -- title, placeholder
           (HandleRegisterInput <<< REG_INP_pass)       -- action
           registrationForm.pass                        -- value
-          should_be_disabled                           -- condition
+      , Bulma.btn_validation
-      , HH.div_
-          [ HH.button
-              [ HP.style "padding: 0.5rem 1.25rem;"
-              , HP.type_ HP.ButtonSubmit
-              , (if wsUp then (HP.enabled true) else (HP.disabled true))
-              ]
-              [ HH.text "Send Message to Server" ]
-          ]
       ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
@@ -175,52 +154,3 @@ show_error = case _ of
   Login    arr -> "Error with the Login: "    <> (A.fold $ map show_error_login arr)
   Email    arr -> "Error with the Email: "    <> (A.fold $ map show_error_email arr)
   Password arr -> "Error with the Password: " <> (A.fold $ map show_error_password arr)
-
-show_error_login :: L.Error -> String
-show_error_login = case _ of
-  L.ParsingError {error, position} ->
-    "position " <> show position <> " " <> maybe "" string_error_login error
-
-string_error_login :: L.LoginParsingError -> String
-string_error_login = case _ of
-  L.CannotParse         -> "cannot parse the login"
-  L.CannotEntirelyParse -> "cannot entirely parse the login"
-  L.Size min max n      -> "login size should be between "
-                           <> show min <> " and " <> show max
-                           <> " (currently: " <> show n <> ")"
-
-show_error_email :: E.Error -> String
-show_error_email = case _ of
-  E.ParsingError {error, position} ->
-    "position " <> show position <> " " <> maybe "" string_error_email error
-
-string_error_email :: E.EmailParsingError -> String
-string_error_email = case _ of
-  E.CannotParse         -> "cannot parse the email"
-  E.CannotEntirelyParse -> "cannot entirely parse the email"
-  E.Size min max n      -> "email size should be between "
-                           <> show min <> " and " <> show max
-                           <> " (currently: " <> show n <> ")"
-
-show_error_password :: P.Error -> String
-show_error_password = case _ of
-  P.ParsingError {error, position} ->
-    "position " <> show position <> " " <> maybe "" string_error_password error
-
-string_error_password :: P.PasswordParsingError -> String
-string_error_password = case _ of
-  P.CannotParse         -> "cannot parse the password"
-  P.CannotEntirelyParse -> "cannot entirely parse the password"
-  P.Size min max n      -> "password size should be between "
-                           <> show min <> " and " <> show max
-                           <> " (currently: " <> show n <> ")"
-
-handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
-handleQuery = case _ of
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
-    pure (Just a)

src/App/Page/Setup.purs

@@ -1,20 +1,23 @@
--- | `App.SetupInterface` allows users to change their password or their email address.
+-- | `App.SetupInterface` enables users to change their password or their email address.
 -- | Users can also erase their account.
 module App.Page.Setup where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (==))
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (==), (<>), show, map)
 
-import Data.Maybe (Maybe(..))
+import Data.Array as A
+import Data.Maybe (Maybe(..), maybe)
+import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
 import Bulma as Bulma
 
+import App.Validation.Password as P
+
 import App.Type.LogMessage
 import App.Message.AuthenticationDaemon as AuthD
 
@@ -24,12 +27,8 @@ data Output
   | DeleteUserAccount
 
 -- | The component's parent provides received messages.
--- |
--- | Also, the component is informed when the connection went up or down.
 data Query a
   = MessageReceived AuthD.AnswerMessage a
-  | ConnectionIsDown a
-  | ConnectionIsUp a
 
 type Slot = H.Slot Query Output
 
@@ -46,6 +45,7 @@ data NewPasswordInput
 data Action
   = HandleNewPassword NewPasswordInput
   | ChangePasswordAttempt Event
+  | SendChangePasswordMessage
   | CancelModal
   | DeleteAccountPopup
   | DeleteAccount
@@ -59,7 +59,6 @@ data Modal
 type State =
   { newPasswordForm :: StateNewPasswordForm
   , token           :: String
-  , wsUp            :: Boolean
   , modal           :: Modal
   }
 
@@ -79,38 +78,31 @@ initialState token =
   { newPasswordForm: { password: "", confirmation: "" }
   , token
   , modal: NoModal
-  , wsUp: true
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { modal, wsUp, newPasswordForm } =
+render { modal, newPasswordForm } =
-  case modal of
+  Bulma.section_small
-    DeleteAccountModal -> render_delete_account_modal
+    [ case modal of
-    NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change password", render_new_password_form ]
+        DeleteAccountModal -> render_delete_account_modal
-                              , b [ Bulma.h3 "Delete account", render_delete_account ]
+        NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change password", render_new_password_form ]
-                              ]
+                                  , b [ Bulma.h3 "Delete account", render_delete_account ]
+                                  ]
+    ]
 
   where
-  b e = Bulma.column_ [ Bulma.box e ]
+  b e = Bulma.column_ e
-  should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
 
   render_delete_account = Bulma.alert_btn "Delete my account" DeleteAccountPopup
   render_new_password_form = HH.form
     [ HE.onSubmit ChangePasswordAttempt ]
-    [ Bulma.box_input "passwordNEWPASS" "Password" "password"
+    [ Bulma.box_password "passwordNEWPASS" "New Password" "password"
         (HandleNewPassword <<< NEWPASS_INP_password)
         newPasswordForm.password
-        should_be_disabled
+    , Bulma.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
-    , Bulma.box_input "confirmationNEWPASS" "Confirmation" "confirmation"
         (HandleNewPassword <<< NEWPASS_INP_confirmation)
         newPasswordForm.confirmation
-        should_be_disabled
+    , Bulma.btn_validation
-    , HH.button
-       [ HP.style "padding: 0.5rem 1.25rem;"
-       , HP.type_ HP.ButtonSubmit
-       , (if wsUp then (HP.enabled true) else (HP.disabled true))
-       ]
-       [ HH.text "Send Message to Server" ]
     ]
 
   render_delete_account_modal = Bulma.modal "Delete your account"
@@ -145,10 +137,31 @@ handleAction = case _ of
       _ , "" -> H.raise $ Log $ UnableToSend "Confirm your password!"
       pass, confirmation -> do
         if pass == confirmation
-        then do H.raise $ Log $ SystemLog "Changing the password"
+        then case P.password pass of
-                H.raise $ ChangePassword pass
+               Left errors -> H.raise $ Log $ UnableToSend $ A.fold $ map show_error_password errors
+               Right _     -> handleAction SendChangePasswordMessage
         else H.raise $ Log $ UnableToSend "Confirmation differs from password"
 
+  SendChangePasswordMessage -> do
+    state <- H.get
+    H.raise $ Log $ SystemLog "Changing the password"
+    H.raise $ ChangePassword state.newPasswordForm.password
+
+
+  where
+  show_error_password :: P.Error -> String
+  show_error_password = case _ of
+    P.ParsingError {error, position} ->
+      "position " <> show position <> " " <> maybe "" string_error_password error
+
+  string_error_password :: P.PasswordParsingError -> String
+  string_error_password = case _ of
+    P.CannotParse         -> "cannot parse the password"
+    P.CannotEntirelyParse -> "cannot entirely parse the password"
+    P.Size min max n      -> "password size should be between "
+                             <> show min <> " and " <> show max
+                             <> " (currently: " <> show n <> ")"
+
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
   -- For now, no message actually needs to be handled here.
@@ -158,11 +171,3 @@ handleQuery = case _ of
       _ -> do
         H.raise $ Log $ ErrorLog $ "Message not handled in SetupInterface."
     pure Nothing
-
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
-    pure (Just a)

src/App/Page/Zone.purs

@@ -1,28 +1,33 @@
 -- | `App.ZoneInterface` provides an interface to display and modify a DNS zone.
 -- |
--- | This interface allows to:
+-- | This interface enables to:
 -- |   - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
--- |   - TODO: dedicated interfaces for: SPF, DKIM, DMARC
+-- |   - provide dedicated interfaces for SPF and DKIM (TODO: DMARC)
 -- |   - add, modify, remove resource records
 -- |
 -- | **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
+-- | This includes explaining use cases and displaying an appropriate interface for the task at hand.
--- | task at hand. For example, having a dedicated interface for DKIM.
 -- |
 -- | 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.
 -- |
--- | TODO: do not allow for the modification of read-only resource records.
--- |
 -- | TODO: move all serialization code to a single module.
 module App.Page.Zone where
 
 import Prelude (Unit, unit, void
                , bind, pure
-               , not, comparing, discard, map, show
+               , not, comparing, discard, map, show, class Show
-               , (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#))
+               , (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#), (=<<), (-))
 
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+
+import Web.HTML (window) as HTML
+import Web.HTML.Window (sessionStorage) as Window
+import Web.Storage.Storage as Storage
+
+import App.Validation.Email as Email
 
 import Data.Eq (class Eq)
 import Data.Array as A
@@ -31,6 +36,7 @@ import Data.Tuple (Tuple(..))
 import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Array.NonEmpty as NonEmpty
 import Data.Either (Either(..))
+import Data.String (toLower)
 import Data.String.CodePoints as CP
 -- import Data.Foldable as Foldable
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
@@ -53,8 +59,9 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
                           , mechanism_types, qualifier_types, modifier_types)
 import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
 import App.Type.DKIM as DKIM
+import App.Type.DMARC as DMARC
 
-import App.DisplayErrors (error_to_paragraph)
+import App.DisplayErrors (error_to_paragraph, show_error_email)
 
 import App.Type.LogMessage (LogMessage(..))
 import App.Message.DNSManagerDaemon as DNSManager
@@ -76,13 +83,9 @@ data Output
   | Log LogMessage
 
 -- | `App.ZoneInterface` can receive messages from `dnsmanagerd`.
--- |
--- | The component is also informed when the connection is lost or up again.
 
 data Query a
   = MessageReceived DNSManager.AnswerMessage a
-  | ConnectionIsDown a
-  | ConnectionIsUp a
 
 type Slot = H.Slot Query Output
 
@@ -148,6 +151,9 @@ data Action
   -- | Add a new resource record to the zone.
   | AddRR AcceptedRRTypes ResourceRecord
 
+  -- | Reset the different temporary values, such as SPF mechanisms or DMARC mail entry.
+  | ResetTemporaryValues
+
   -- | Save the changes done in an already existing resource record.
   | SaveRR ResourceRecord
 
@@ -178,6 +184,34 @@ data Action
   -- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
   | SPF_Modifier_Add
 
+  -- | Change the temporary mail address for DMARC.
+  | DMARC_mail String
+
+  -- | Change the temporary report size limit for DMARC.
+  | DMARC_mail_limit String
+
+  -- | Change the requested report interval.
+  | DMARC_ri String
+
+  -- | Add a new mail address to the DMARC rua list.
+  | DMARC_rua_Add
+
+  -- | Add a new mail address to the DMARC ruf list.
+  | DMARC_ruf_Add
+
+  -- | Remove a mail address of the DMARC rua list.
+  | DMARC_remove_rua Int
+
+  -- | Remove a mail address of the DMARC ruf list.
+  | DMARC_remove_ruf Int
+
+  | DMARC_policy Int
+  | DMARC_sp_policy Int
+  | DMARC_adkim Int
+  | DMARC_aspf Int
+  | DMARC_pct  String
+  | DMARC_fo Int
+
   | DKIM_hash_algo Int
   | DKIM_sign_algo Int
   | DKIM_pubkey    String
@@ -189,18 +223,6 @@ data RRModal
   | UpdateRRModal
   | RemoveRRModal RRId
 
-show_accepted_type :: AcceptedRRTypes -> String
-show_accepted_type = case _ of
-  A     -> "A"
-  AAAA  -> "AAAA"
-  TXT   -> "TXT"
-  CNAME -> "CNAME"
-  NS    -> "NS"
-  MX    -> "MX"
-  SRV   -> "SRV"
-  SPF   -> "SPF"
-  DKIM  -> "DKIM"
-
 string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
 string_to_acceptedtype str = case str of
   "A"     -> Just     A
@@ -212,14 +234,17 @@ string_to_acceptedtype str = case str of
   "SRV"   -> Just   SRV
   "SPF"   -> Just   SPF
   "DKIM"  -> Just  DKIM
+  "DMARC" -> Just DMARC
   _       -> Nothing
 
-data Tab = Zone | TokenExplanation
+data Tab = Zone | TheBasics | TokenExplanation
 derive instance eqTab :: Eq Tab
+derive instance genericTab :: Generic Tab _
+instance showTab :: Show Tab where
+  show = genericShow
 
 type State =
   { _domain :: String
-  , wsUp :: Boolean
 
   -- A modal to present a form for adding a new RR.
   , rr_modal :: RRModal
@@ -231,6 +256,7 @@ type State =
   -- Unique RR form.
   , _currentRR :: ResourceRecord
   , _currentRR_errors :: Array Validation.Error
+  , _dmarc_mail_errors :: Array Email.Error
 
   -- SPF details.
   , spf_mechanism_q :: String
@@ -239,7 +265,11 @@ type State =
   , spf_modifier_t  :: String
   , spf_modifier_v  :: String
 
+  , dmarc_mail :: String
+  , dmarc_mail_limit :: Maybe Int
+
   , dkim :: DKIM.DKIM
+  , dmarc :: DMARC.DMARC
 
   , _zonefile :: Maybe String
 
@@ -273,8 +303,7 @@ default_qualifier_str = "hard_fail" :: String
 
 initialState :: Input -> State
 initialState domain =
-  { wsUp: true
+  { rr_modal: NoModal
-  , rr_modal: NoModal
 
   , _domain: domain
 
@@ -285,6 +314,7 @@ initialState domain =
   , _currentRR: default_empty_rr
   -- List of errors within the form in new RR modal.
   , _currentRR_errors: []
+  , _dmarc_mail_errors: []
   , _zonefile: Nothing
 
   , spf_mechanism_q: "pass"
@@ -292,7 +322,12 @@ initialState domain =
   , spf_mechanism_v: ""
   , spf_modifier_t:  "redirect"
   , spf_modifier_v:  ""
+
   , dkim: DKIM.emptyDKIMRR
+  , dmarc: DMARC.emptyDMARCRR
+
+  , dmarc_mail: ""
+  , dmarc_mail_limit: Nothing
 
   , current_tab: Zone
   }
@@ -305,23 +340,24 @@ render state
       [ fancy_tab
       , case state.current_tab of
           Zone -> render_zone
+          TheBasics        -> Explanations.basics
           TokenExplanation -> Explanations.tokens
       ]
   where
     fancy_tab =
       Bulma.fancy_tabs
-        [ Bulma.tab_entry (is_tab_active Zone)             "Zone"       (ChangeTab Zone)
+        [ Bulma.tab_entry (is_tab_active Zone)             "Zone"          (ChangeTab Zone)
-        , Bulma.tab_entry (is_tab_active TokenExplanation) "Tokens? 🤨" (ChangeTab TokenExplanation)
+        , Bulma.tab_entry (is_tab_active TheBasics)        "The basics 🧠" (ChangeTab TheBasics)
+        , Bulma.tab_entry (is_tab_active TokenExplanation) "Tokens? 🤨"    (ChangeTab TokenExplanation)
         ]
     is_tab_active tab = state.current_tab == tab
 
     render_zone =
-      case state.wsUp, state.rr_modal of
+      case state.rr_modal of
-          false, _                   -> Bulma.p "You are disconnected."
+          RemoveRRModal rr_id -> modal_rr_delete rr_id
-          true,  RemoveRRModal rr_id -> modal_rr_delete rr_id
+          NewRRModal _        -> render_current_rr_modal
-          true,  NewRRModal _        -> render_current_rr_modal
+          UpdateRRModal       -> render_current_rr_modal
-          true,  UpdateRRModal       -> render_current_rr_modal
+          NoModal -> HH.div_
-          true,  NoModal -> HH.div_
             [ Bulma.h1 state._domain
             , Bulma.hr
             , render_resources $ sorted state._resources
@@ -341,7 +377,7 @@ render state
     modal_rr_delete rr_id = Bulma.modal "Deleting a resource record"
       [warning_message] [modal_delete_button, Bulma.cancel_button CancelModal]
       where
-      modal_delete_button = Bulma.alert_btn "Delete the resource record." (RemoveRR rr_id)
+      modal_delete_button = Bulma.alert_btn "Delete the resource record" (RemoveRR rr_id)
       warning_message
         = HH.p [] [ HH.text "You are about to delete a resource record, this actions is "
                   , Bulma.strong "irreversible"
@@ -360,6 +396,7 @@ render state
       "SRV"   -> template modal_content_srv    (foot_content SRV)
       "SPF"   -> template modal_content_spf    (foot_content SPF)
       "DKIM"  -> template modal_content_dkim   (foot_content DKIM)
+      "DMARC" -> template modal_content_dmarc  (foot_content DMARC)
       _       -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype
       where
         -- DRY
@@ -377,11 +414,12 @@ render state
           , Bulma.box_input ("ttl" <> state._currentRR.rrtype) "TTL" "600"
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
-              should_be_disabled
+          , case state._currentRR.rrtype of
-          , Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5"
+              "AAAA"  -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target"    "2001:db8::1"      (updateForm Field_Target) state._currentRR.target
-              (updateForm Field_Target)
+              "TXT"   -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Your text" "blah blah"        (updateForm Field_Target) state._currentRR.target
-              state._currentRR.target
+              "CNAME" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target"    "www"              (updateForm Field_Target) state._currentRR.target
-              should_be_disabled
+              "NS"    -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target"    "ns0.example.com." (updateForm Field_Target) state._currentRR.target
+              _       -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target"    "198.51.100.5"     (updateForm Field_Target) state._currentRR.target
           ] <> case state.rr_modal of
                  UpdateRRModal ->
                    if A.elem state._currentRR.rrtype ["A", "AAAA"]
@@ -400,15 +438,12 @@ render state
           , Bulma.box_input ("ttlMX") "TTL" "600"
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
-              should_be_disabled
           , Bulma.box_input ("targetMX") "Target" "www"
               (updateForm Field_Target)
               state._currentRR.target
-              should_be_disabled
           , Bulma.box_input ("priorityMX") "Priority" "10"
               (updateForm Field_Priority)
               (maybe "" show state._currentRR.priority)
-              should_be_disabled
           ]
         modal_content_srv :: Array (HH.HTML w Action)
         modal_content_srv =
@@ -417,31 +452,24 @@ render state
           , Bulma.box_input "domainSRV" "Service name" "service name"
               (updateForm Field_Domain)
               state._currentRR.name
-              should_be_disabled
           , Bulma.box_input ("protocolSRV") "Protocol" "tcp"
               (updateForm Field_Protocol)
               (fromMaybe "tcp" state._currentRR.protocol)
-              should_be_disabled
           , Bulma.box_input ("targetSRV") "Where the server is" "www"
               (updateForm Field_Target)
               state._currentRR.target
-              should_be_disabled
           , Bulma.box_input ("portSRV") "Port of the service" "5061"
               (updateForm Field_Port)
               (maybe "" show state._currentRR.port)
-              should_be_disabled
           , Bulma.box_input ("prioritySRV") "Priority" "10"
               (updateForm Field_Priority)
               (maybe "" show state._currentRR.priority)
-              should_be_disabled
           , Bulma.box_input ("ttlSRV") "TTL" "600"
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
-              should_be_disabled
           , Bulma.box_input ("weightSRV") "Weight" "100"
               (updateForm Field_Weight)
               (maybe "" show state._currentRR.weight)
-              should_be_disabled
           ]
         modal_content_spf :: Array (HH.HTML w Action)
         modal_content_spf =
@@ -454,32 +482,31 @@ render state
           , Bulma.box_input "ttlSPF" "TTL" "600"
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
-              should_be_disabled
           --, case state._currentRR.v of
           --  Nothing -> Bulma.p "default value for the version (spf1)"
-          --  Just v  -> Bulma.box_input "vSPF" "Version" "spf1" (updateForm Field_SPF_v) v should_be_disabled
+          --  Just v  -> Bulma.box_input "vSPF" "Version" "spf1" (updateForm Field_SPF_v) v
           , Bulma.hr
-          , maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
           , Bulma.box
-            [ Bulma.h3 "New mechanism"
+            [ Bulma.h3 "Current mechanisms"
+            , maybe (Bulma.p "You don't have any mechanism.") display_mechanisms state._currentRR.mechanisms
+            , Bulma.h3 "New mechanism"
             , Bulma.selection_field "idMechanismQ" "Policy" SPF_Mechanism_q qualifier_types state.spf_mechanism_q
             , Bulma.selection_field "idMechanismT" "Type"   SPF_Mechanism_t mechanism_types state.spf_mechanism_t
             , Bulma.box_input "valueNewMechanismSPF" "Value" ""
                 SPF_Mechanism_v
                 state.spf_mechanism_v
-                should_be_disabled
+            , Bulma.btn "Add a mechanism" SPF_Mechanism_Add
-            , Bulma.btn "Add" SPF_Mechanism_Add
             ]
           , Bulma.hr
-          , maybe (Bulma.p "no modifier") display_modifiers state._currentRR.modifiers
           , Bulma.box
-            [ Bulma.h3 "New modifier"
+            [ Bulma.h3 "Current modifiers"
+            , maybe (Bulma.p "You don't have any modifier.") display_modifiers state._currentRR.modifiers
+            , Bulma.h3 "New modifier"
             , Bulma.selection_field "idModifierT" "Modifier" SPF_Modifier_t modifier_types state.spf_modifier_t
             , Bulma.box_input "valueNewModifierSPF" "Value" ""
                 SPF_Modifier_v
                 state.spf_modifier_v
-                should_be_disabled
+            , Bulma.btn "Add a modifier" SPF_Modifier_Add
-            , Bulma.btn "Add" SPF_Modifier_Add
             ]
           , Bulma.hr
           , Bulma.box
@@ -499,28 +526,80 @@ render state
           , Bulma.box_input "ttlDKIM" "TTL" "600"
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
-              should_be_disabled
           , Bulma.hr
           , Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
           , Bulma.selection_field "idDKIMSignature" "Signature algo"
               DKIM_sign_algo
-              (map DKIM.show_signature_algorithm DKIM.sign_algos)
+              (map show DKIM.sign_algos)
-              (DKIM.show_signature_algorithm $ fromMaybe DKIM.RSA state.dkim.k)
+              (show $ fromMaybe DKIM.RSA state.dkim.k)
           , Bulma.selection_field "idDKIMHash"      "Hash algo"
               DKIM_hash_algo
-              (map DKIM.show_hashing_algorithm DKIM.hash_algos)
+              (map show DKIM.hash_algos)
-              (DKIM.show_hashing_algorithm   $ fromMaybe DKIM.SHA256 state.dkim.h)
+              (show $ fromMaybe DKIM.SHA256 state.dkim.h)
-          , Bulma.box_input "pkDKIM" "Public Key" "Your public key, such as 'MIIBIjANBgqh...'"
+          , Bulma.box_input "pkDKIM" "Public Key" "Your public key, such as \"MIIBIjANBgqh...\"" DKIM_pubkey state.dkim.p
-              DKIM_pubkey state.dkim.p should_be_disabled
+          , Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators." DKIM_note (fromMaybe "" state.dkim.n)
-          , Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators."
-              DKIM_note
-              (fromMaybe "" state.dkim.n)
-              should_be_disabled
           ]
 
+        modal_content_dmarc :: Array (HH.HTML w Action)
+        modal_content_dmarc =
+          [ Bulma.div_content [Bulma.explanation Explanations.dmarc_introduction]
+          , render_errors
+          , Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc"
+              (updateForm Field_Domain)
+              state._currentRR.name
+              display_domain_side
+          , Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl)
+
+          , Bulma.hr
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_policy]
+          , Bulma.selection_field "idDMARCPolicy" "Policy" DMARC_policy (map show DMARC.policies) (show state.dmarc.p)
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_sp_policy]
+          , Bulma.selection_field "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
+            (["do not provide policy advice"] <> map show DMARC.policies) (maybe "-" show state.dmarc.sp)
+
+          , Bulma.hr
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_adkim]
+          , Bulma.selection_field "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim DMARC.consistency_policies_txt (maybe "-" show state.dmarc.adkim)
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_aspf]
+          , Bulma.selection_field "idDMARCaspf" "Consistency Policy for SPF"   DMARC_aspf  DMARC.consistency_policies_txt  (maybe "-" show state.dmarc.aspf)
+
+          , Bulma.hr
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_pct]
+          , Bulma.box_input "idDMARCpct" "Sample rate [0..100]" "100" DMARC_pct (maybe "100" show state.dmarc.pct)
+
+          , Bulma.hr
+          , Bulma.selection_field' "idDMARCfo" "When to send a report" DMARC_fo
+              (zip_nullable DMARC.report_occasions_txt DMARC.report_occasions_raw)
+              (maybe "-" show state.dmarc.fo)
+
+          , Bulma.hr
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_contact]
+          , maybe (Bulma.p "There is no address to send aggregated reports to.")
+            (display_dmarc_mail_addresses "Addresses to contact for aggregated reports" DMARC_remove_rua) state.dmarc.rua
+          , maybe (Bulma.p "There is no address to send detailed reports to.")
+            (display_dmarc_mail_addresses "Addresses to contact for detailed reports" DMARC_remove_ruf) state.dmarc.ruf
+
+          , Bulma.hr
+          , render_dmarc_mail_errors
+          , Bulma.box_input "idDMARCmail"      "Address to contact" "admin@example.com" DMARC_mail state.dmarc_mail
+          , Bulma.box_input "idDMARCmaillimit" "Report size limit (in KB)" "2000" DMARC_mail_limit (maybe "0" show state.dmarc_mail_limit)
+          , Bulma.level [ Bulma.btn "New address for aggregated report" DMARC_rua_Add
+                        , Bulma.btn "New address for specific report" DMARC_ruf_Add
+                        ] []
+
+          , Bulma.hr
+          , Bulma.div_content [Bulma.explanation Explanations.dmarc_ri]
+          , Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc.ri)
+          ]
+
+        render_dmarc_mail_errors
+          = if A.length state._dmarc_mail_errors > 0
+            then Bulma.notification_danger_block'
+                   $ [ Bulma.h3 "Invalid mail 😥" ] <> map (Bulma.p <<< show_error_email) state._dmarc_mail_errors
+            else HH.div_ [ ]
+
         display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
-        should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
+        newtokenbtn = Bulma.btn (maybe "🏁​ Ask for a token" (\_ -> "🏁​ Ask for a new token") state._currentRR.token) (NewToken state._currentRR.rrid)
-        newtokenbtn = Bulma.btn "🏁​ Ask for a token!" (NewToken state._currentRR.rrid)
         foot_content x =
           case state.rr_modal of
             NewRRModal _  -> [Bulma.btn_add (ValidateRR x)]
@@ -533,11 +612,14 @@ render state
           where
           title = case state.rr_modal of
             NoModal             -> "Error: no modal should be displayed"
-            NewRRModal t_       -> "New " <> show_accepted_type t_ <> " resource record"
+            NewRRModal t_       -> "New " <> show t_ <> " resource record"
-            UpdateRRModal       -> "Update RR " <> show state._currentRR.rrid
+            UpdateRRModal       -> "Update " <> state._currentRR.rrtype <> " Resource Record"
             RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")"
           foot = foot_ <> [Bulma.cancel_button CancelModal]
 
+zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
+zip_nullable txt raw = A.zip txt ([""] <> raw)
+
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
   -- | Cancel the current modal being presented.
@@ -545,6 +627,8 @@ handleAction = case _ of
   CancelModal -> do
     H.modify_ _ { rr_modal = NoModal }
     H.modify_ _ { _currentRR_errors = [] }
+    H.modify_ _ { _dmarc_mail_errors = [] }
+    handleAction $ ResetTemporaryValues
 
   -- | Create the RR modal.
   DeleteRRModal rr_id -> do
@@ -552,6 +636,9 @@ handleAction = case _ of
 
   -- | Change the current tab.
   ChangeTab new_tab -> do
+    -- Store the current tab we are on and restore it when we reload.
+    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    H.liftEffect $ Storage.setItem "current-zone-tab" (show new_tab) sessionstorage
     H.modify_ _ { current_tab = new_tab }
 
   -- | Create modal (a form) for a resource record to update.
@@ -562,7 +649,8 @@ handleAction = case _ of
       Just rr -> do
         H.modify_ _ { _currentRR = rr }
         _ <- case rr.rrtype of
-          "DKIM" -> H.modify_ _ { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim }
+          "DKIM"  -> H.modify_ _ { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim }
+          "DMARC" -> H.modify_ _ { dmarc = fromMaybe DMARC.emptyDMARCRR rr.dmarc }
           _      -> pure unit
         H.modify_ _ { rr_modal = UpdateRRModal }
 
@@ -583,6 +671,7 @@ handleAction = case _ of
                                    , q = Just RR.HardFail
                                    }
         default_rr_DKIM  = emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" }
+        default_rr_DMARC = emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" }
 
     case t of
       A     -> H.modify_ _ { _currentRR = default_rr_A }
@@ -594,6 +683,7 @@ handleAction = case _ of
       SRV   -> H.modify_ _ { _currentRR = default_rr_SRV }
       SPF   -> H.modify_ _ { _currentRR = default_rr_SPF }
       DKIM  -> H.modify_ _ { _currentRR = default_rr_DKIM }
+      DMARC -> H.modify_ _ { _currentRR = default_rr_DMARC }
 
   -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
   Initialize -> do
@@ -602,6 +692,16 @@ handleAction = case _ of
     message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
     H.raise $ MessageToSend message
 
+    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    old_tab <- H.liftEffect $ Storage.getItem "current-zone-tab" sessionstorage
+    case old_tab of
+      Nothing -> pure unit
+      Just current_tab -> case current_tab of
+        "Zone"             -> handleAction $ ChangeTab Zone
+        "TheBasics"        -> handleAction $ ChangeTab TheBasics
+        "TokenExplanation" -> handleAction $ ChangeTab TokenExplanation
+        _  -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
+
   -- | Perform validation. In case the record is valid, it is added to the zone then the modal is closed.
   -- | Else, the different errors are added to the state.
   ValidateRR t -> do
@@ -612,6 +712,7 @@ handleAction = case _ of
     -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
     _ <- case t of
            DKIM -> H.modify_ \state -> state { _currentRR { dkim = Just state.dkim } }
+           DMARC -> H.modify_ \state -> state { _currentRR { dmarc = Just state.dmarc } }
            _ -> pure unit
 
     state <- H.get
@@ -621,7 +722,11 @@ handleAction = case _ of
         -- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors
         H.modify_ _ { _currentRR_errors = actual_errors }
       Right newrr -> do
-        H.modify_ _ { _currentRR_errors = [], dkim = DKIM.emptyDKIMRR }
+        H.modify_ _ { _currentRR_errors = []
+                    , _dmarc_mail_errors = []
+                    , dkim = DKIM.emptyDKIMRR
+                    , dmarc = DMARC.emptyDMARCRR
+                    }
         handleAction $ AddRR t newrr
         handleAction CancelModal
 
@@ -630,6 +735,7 @@ handleAction = case _ of
   AddRR t newrr -> do
     state <- H.get
     H.raise $ Log $ SystemLog $ "Add new " <> show t
+    H.modify_ _ { _zonefile = Nothing }
     message <- H.liftEffect
       $ DNSManager.serialize
       $ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
@@ -649,7 +755,8 @@ handleAction = case _ of
     -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
     state0 <- H.get
     _ <- case state0._currentRR.rrtype of
-           "DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } }
+           "DKIM"  -> H.modify_ _ { _currentRR { dkim  = Just state0.dkim } }
+           "DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } }
            _      -> pure unit
 
     state <- H.get
@@ -657,20 +764,34 @@ handleAction = case _ of
       Left actual_errors -> do
         H.modify_ _ { _currentRR_errors = actual_errors }
       Right rr -> do
-        H.modify_ _ { _currentRR_errors = [] }
+        H.modify_ _ { _currentRR_errors = [], _dmarc_mail_errors = [] }
         handleAction $ SaveRR rr
 
+  ResetTemporaryValues -> do
+    H.modify_ _ { spf_mechanism_q = "pass"
+                , spf_mechanism_t = "a"
+                , spf_mechanism_v = ""
+                , spf_modifier_t = "redirect"
+                , spf_modifier_v = ""
+                , dmarc_mail = ""
+                , dmarc_mail_limit = Nothing
+                , _dmarc_mail_errors = []
+                }
+
   SaveRR rr -> do
     state <- H.get
     H.raise $ Log $ SystemLog $ "Updating RR " <> show rr.rrid
+    H.modify_ _ { _zonefile = Nothing }
     message <- H.liftEffect
       $ DNSManager.serialize
       $ DNSManager.MkUpdateRR { domain: state._domain, rr: rr }
     H.raise $ MessageToSend message
+    handleAction $ ResetTemporaryValues
 
   RemoveRR rr_id -> do
     { _domain } <- H.get
     H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
+    H.modify_ _ { _zonefile = Nothing }
     -- Send a removal message.
     message <- H.liftEffect
       $ DNSManager.serialize
@@ -726,6 +847,7 @@ handleAction = case _ of
           [] -> Nothing
           v  -> Just v
     H.modify_ _ { _currentRR { mechanisms = new_value }}
+    handleAction $ ResetTemporaryValues
 
   SPF_Modifier_Add -> do
     state <- H.get
@@ -737,6 +859,67 @@ handleAction = case _ of
           [] -> Nothing
           v  -> Just v
     H.modify_ _ { _currentRR { modifiers = new_value }}
+    handleAction $ ResetTemporaryValues
+
+  DMARC_mail v -> H.modify_ _ { dmarc_mail = v }
+  DMARC_mail_limit v -> H.modify_ _ { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v }
+  DMARC_ri v -> H.modify_ _ { dmarc { ri = fromString v } }
+  DMARC_rua_Add -> do
+    state <- H.get
+    case Email.email state.dmarc_mail of
+      Left errors -> H.modify_ _ { _dmarc_mail_errors = errors }
+      Right _     -> do
+        let current_ruas = fromMaybe [] state.dmarc.rua
+            dmarc_mail       = state.dmarc_mail
+            dmarc_mail_limit = state.dmarc_mail_limit
+            new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
+        H.modify_ _ { dmarc { rua = Just new_list }}
+        handleAction $ ResetTemporaryValues
+
+  DMARC_ruf_Add -> do
+    state <- H.get
+    case Email.email state.dmarc_mail of
+      Left errors -> H.modify_ _ { _dmarc_mail_errors = errors }
+      Right _     -> do
+        let current_rufs = fromMaybe [] state.dmarc.ruf
+            dmarc_mail       = state.dmarc_mail
+            dmarc_mail_limit = state.dmarc_mail_limit
+            new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
+        H.modify_ _ { dmarc { ruf = Just new_list } }
+        handleAction $ ResetTemporaryValues
+
+  DMARC_remove_rua i -> do
+    state <- H.get
+    let current_ruas = case state._currentRR.dmarc of
+          Nothing    -> []
+          Just dmarc -> fromMaybe [] dmarc.rua
+        new_value = case (remove_id i $ attach_id 0 current_ruas) of
+          [] -> Nothing
+          v -> Just v
+        new_dmarc = case state._currentRR.dmarc of
+          Nothing    -> DMARC.emptyDMARCRR { rua = new_value }
+          Just dmarc -> dmarc              { rua = new_value }
+    H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
+
+  DMARC_remove_ruf i -> do
+    state <- H.get
+    let current_rufs = case state._currentRR.dmarc of
+          Nothing    -> []
+          Just dmarc -> fromMaybe [] dmarc.ruf
+        new_value = case (remove_id i $ attach_id 0 current_rufs) of
+          [] -> Nothing
+          v -> Just v
+        new_dmarc = case state._currentRR.dmarc of
+          Nothing    -> DMARC.emptyDMARCRR { ruf = new_value }
+          Just dmarc -> dmarc              { ruf = new_value }
+    H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
+
+  DMARC_policy    v -> H.modify_ _ { dmarc { p  = fromMaybe DMARC.None $ DMARC.policies A.!! v } }
+  DMARC_sp_policy v -> H.modify_ _ { dmarc { sp =                        DMARC.policies A.!! (v - 1) } }
+  DMARC_adkim  v -> H.modify_ _ { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } }
+  DMARC_aspf   v -> H.modify_ _ { dmarc { aspf  = DMARC.consistency_policies A.!! (v - 1) } }
+  DMARC_pct    v -> H.modify_ _ { dmarc { pct   = Just $ fromMaybe 100 (fromString v) } }
+  DMARC_fo     v -> H.modify_ _ { dmarc { fo    = DMARC.report_occasions A.!! (v - 1) } }
 
   DKIM_hash_algo v -> H.modify_ _ { dkim { h = DKIM.hash_algos A.!! v } }
   DKIM_sign_algo v -> H.modify_ _ { dkim { k = DKIM.sign_algos A.!! v } }
@@ -774,14 +957,6 @@ handleQuery = case _ of
       _ -> H.raise $ Log $ ErrorLog $ "Message not handled in ZoneInterface."
     pure (Just a)
 
-  ConnectionIsDown a -> do
-    H.modify_ _ { wsUp = false }
-    pure (Just a)
-
-  ConnectionIsUp a -> do
-    H.modify_ _ { wsUp = true }
-    pure (Just a)
-
   where
     -- replace_entry :: ResourceRecord
     replace_entry new_rr = do
@@ -826,6 +1001,7 @@ render_resources records
       <> (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)
+      <> (rr_box tag_dmarc     []          Bulma.dmarc_table_header     table_content        all_dmarc_rr)
       <> (rr_box tag_basic_ro  bg_color_ro Bulma.simple_table_header_ro table_content_w_seps all_basic_ro_rr)
   where
   all_basic_rr    = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
@@ -836,14 +1012,16 @@ render_resources records
   all_srv_rr      = all_XX_rr "SRV"
   all_spf_rr      = all_XX_rr "SPF"
   all_dkim_rr     = all_XX_rr "DKIM"
+  all_dmarc_rr    = all_XX_rr "DMARC"
 
   tag_soa      = tags [tag_ro "SOA", tag_ro "read only"]
-  tag_basic    = tags [tag "Basic RRs (A, AAAA, PTR, NS, TXT)"]
+  tag_basic    = tags [tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"]
   tag_mx       = tags [tag "MX"]
   tag_srv      = tags [tag "SRV"]
   tag_spf      = tags [tag "SPF"]
   tag_dkim     = tags [tag "DKIM"]
-  tag_basic_ro = tags [tag_ro "Basic RRs", tag_ro "read only"]
+  tag_dmarc    = tags [tag "DMARC"]
+  tag_basic_ro = tags [tag_ro "Basic Resource Records", tag_ro "read only"]
 
   rr_box :: HH.HTML w Action                                          -- box title (type of data)
             -> Array HH.ClassName
@@ -917,15 +1095,36 @@ render_resources records
           Just dkim ->
             [
             -- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DKIM1.
-              HH.td_ [ Bulma.p $ maybe "" DKIM.show_hashing_algorithm    dkim.h ]
+              HH.td_ [ Bulma.p $ maybe "" show dkim.h ]
-            , HH.td_ [ Bulma.p $ maybe "" DKIM.show_signature_algorithm  dkim.k ]
+            , HH.td_ [ Bulma.p $ maybe "" show dkim.k ]
-            , HH.td_ [ Bulma.p $ CP.take 5                               dkim.p ]
+            , HH.td_ [ Bulma.p $ CP.take 20    dkim.p ]
-            , HH.td_ [ Bulma.p $ fromMaybe ""                            dkim.n ]
+            , HH.td_ [ Bulma.p $ fromMaybe ""  dkim.n ]
             , 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 DKIM data." ]
+      "DMARC"  ->
+        [ HH.td_ [ Bulma.p rr.name ]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        ] <> case rr.dmarc of
+          Just dmarc ->
+            [
+            -- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DMARC1.
+              HH.td_ [ Bulma.p $ show dmarc.p               ]
+            , HH.td_ [ Bulma.p $ maybe "" show dmarc.sp     ]
+            , HH.td_ [ Bulma.p $ maybe "" show dmarc.adkim  ]
+            , HH.td_ [ Bulma.p $ maybe "" show dmarc.aspf   ]
+            , HH.td_ [ Bulma.p $ maybe "" show dmarc.pct    ]
+            , HH.td_ [ Bulma.p $ maybe "" show dmarc.fo     ]
+            , HH.td_ [ Bulma.p $ maybe "" show dmarc.ri     ]
+            -- TODO? rua & ruf
+            -- , HH.td_ [ ] -- For now, assume AFRF.
+            , 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 DMARC data." ]
       "MX"  ->
         [ HH.td_ [ Bulma.p rr.name ]
         , HH.td_ [ Bulma.p $ show rr.ttl ]
@@ -956,6 +1155,7 @@ render_resources records
   fancy_qualifier_display qualifier = "(" <> show_qualifier_char qualifier <> ") " <> show_qualifier qualifier
 
 display_mechanisms :: forall w. Array RR.Mechanism -> HH.HTML w Action
+display_mechanisms [] = Bulma.p "You don't have any mechanism."
 display_mechanisms ms =
   Bulma.box_ C.has_background_warning_light
     [ Bulma.table [] [ Bulma.mechanism_table_header, HH.tbody_ $ map render_mechanism_row $ attach_id 0 ms] ]
@@ -969,6 +1169,7 @@ display_mechanisms ms =
     ]
 
 display_modifiers :: forall w. Array RR.Modifier -> HH.HTML w Action
+display_modifiers [] = Bulma.p "You don't have any modifier."
 display_modifiers ms =
   Bulma.box_ C.has_background_warning_light
     [ Bulma.table [] [ Bulma.modifier_table_header, HH.tbody_ $ map render_modifier_row $ attach_id 0 ms] ]
@@ -980,6 +1181,19 @@ display_modifiers ms =
     , HH.td_ [ Bulma.alert_btn "x" (SPF_remove_modifier i) ]
     ]
 
+display_dmarc_mail_addresses :: forall w. String -> (Int -> Action) -> Array DMARC.DMARCURI -> HH.HTML w Action
+display_dmarc_mail_addresses t f ms =
+  Bulma.box_ C.has_background_warning_light
+    [ Bulma.h3 t
+    , Bulma.table [] [ Bulma.dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms] ]
+  where
+  render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w Action
+  render_dmarcuri_row (Tuple i m) = HH.tr_
+    [ HH.td_ [ Bulma.p m.mail ]
+    , HH.td_ [ Bulma.p $ maybe "(no size limit)" show m.limit ]
+    , HH.td_ [ Bulma.alert_btn "x" (f i) ]
+    ]
+
 baseRecords :: Array String
 baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
 
@@ -1000,16 +1214,16 @@ render_new_records _
           , Bulma.btn   "SRV" (CreateNewRRModal SRV)
           ] []
       , Bulma.hr
-      , Bulma.h1 "Special records about the mail system (soon)"
+      , 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 "SPF" (CreateNewRRModal SPF)
+            Bulma.btn "SPF"   (CreateNewRRModal SPF)
-          , Bulma.btn "DKIM" (CreateNewRRModal DKIM)
+          , Bulma.btn "DKIM"  (CreateNewRRModal DKIM)
-          , Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC"
+          , Bulma.btn "DMARC" (CreateNewRRModal DMARC)
           ] []
       , Bulma.hr
       , Bulma.level [
-            Bulma.btn "Get the final zone file." AskZoneFile
+            Bulma.btn "Get the final zone file" AskZoneFile
           ] [HH.text "For debug purposes. ⚠"]
       ]
 
@@ -1034,7 +1248,7 @@ loopE f a = case (A.head a) of
 
 update_field :: ResourceRecord -> Field -> ResourceRecord
 update_field rr updated_field = case updated_field of
-  Field_Domain val           -> rr { name       = val }
+  Field_Domain val           -> rr { name       = toLower val }
   Field_Target val           -> rr { target     = val }
   Field_TTL val              -> rr { ttl        = fromMaybe 0 (fromString val) }
   Field_Priority val         -> rr { priority   = fromString val }

src/App/Text/Explanations.purs

@@ -1,18 +1,25 @@
 module App.Text.Explanations where
 import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
 import Bulma as Bulma
 
+expl' :: forall w i. String -> HH.HTML w i
+expl' text = expl [Bulma.p text]
 expl :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
 expl content = Bulma.div_content [ Bulma.explanation content ]
+expl_txt :: forall w i. String -> HH.HTML w i
+expl_txt content = Bulma.explanation [ Bulma.p content ]
+
+col :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+col arr = Bulma.column_ [ Bulma.box arr ]
 
 tokens :: forall w i. HH.HTML w i
 tokens = HH.div_
   [ Bulma.h3 "What are tokens?"
-  , expl [ Bulma.p """
+  , expl' """
           Tokens are a simple way to update a resource record (A or AAAA) with your current IP address.
           """
-         ]
+  , HH.p_ [ HH.text "Let's take an example: you have an A record (IPv4) pointing to your web server at home, "
-  , HH.p_ [ HH.text "Let's take an example: you have a A record (IPv4) pointing to your web server at home, "
           , HH.text "but your ISP changes your IP address from time to time. "
           , HH.text "You can ask for a token (which looks like "
           , HH.u_ [HH.text "53be0c45-61c4-4d29-8ae9-c2cc8767603d"]
@@ -26,7 +33,7 @@ tokens = HH.div_
   , Bulma.hr
   , Bulma.h3 "How to automate the update of my IP address?"
   , Bulma.p "On Linux, you can make your computer access the update link with the following command."
-  , expl [ Bulma.strong "wget https://beta.netlib.re/token-update/<token>" ]
+  , expl [ Bulma.strong "wget https://beta.netlib.re/token-update/<your-token>" ]
   , Bulma.p """
     No need for a more complex program. This works just fine.
     And you can run this command every hour.
@@ -49,11 +56,110 @@ tokens = HH.div_
          ]
   ]
 
+basics :: forall w i. HH.HTML w i
+basics = HH.div_
+  [ Bulma.h3 "Basics of DNS"
+  , Bulma.p """
+          The domain name system (DNS) enables people share a name instead of an address to find a website or service.
+          """
+  , Bulma.p """
+          To configure a zone, the first steps are trivial.
+          """
+
+  , Bulma.hr
+  , Bulma.h3 "I have something to host (A and AAAA records)."
+  , expl' "Let's assume you have a web server and you host your website somewhere."
+  , Bulma.p """
+    You want an A (IPv4) or AAAA (IPv6) record pointing to your server, named "enigma" for example.
+    """
+
+  , Bulma.hr
+  , Bulma.h3 "You need other names pointing to your server (CNAME records)."
+  , Bulma.p """
+    You may not want to use the name of your server "enigma" directly.
+    Instead, you may want the usual names for your services, such as "www" or "blog".
+    CNAME records are basically aliases, exactly to that end.
+    """
+
+  , Bulma.hr
+  , Bulma.h3 "If you have other servers, just add more A or AAAA records."
+  , Bulma.p """
+    Tip: choose relevant names for your servers then add CNAME records.
+    For example, you can have an A record named "server1" and a CNAME "www" pointing to it.
+    The service isn't pointing to an actual IP address directly,
+    but to the name of the physical server providing the service.
+    You don't need to remember the IP address of each of your servers.
+    """
+
+  , Bulma.hr
+  , Bulma.h3 "I want an email server."
+  , expl' """
+           Hosting a mail server is quite complex.
+           This section will focus on the main parts regarding the DNS.
+           """
+  , Bulma.notification_danger' """
+    The actual configuration of your mail server is complex and depends on your choice of software.
+    This won't be covered here.
+    """
+  , Bulma.p """
+    You need an MX record pointing to your "www" A (or AAAA) record.
+    """
+  , Bulma.p """
+    Having an MX record isn't enough to handle a mail server.
+    You need to use a few spam mitigation mechanisms.
+    """
+  , Bulma.columns_
+      [ col
+        [ expl' """
+                Spam mitigation 1: tell what are the right mail servers for your domain with Sender Policy Framework (SPF).
+                """
+        , expl_txt """
+          You need a SPF record to tell other mail servers what are the acceptable mail servers for your domain.
+          """
+        ]
+      , col
+        [ expl' """
+                Spam mitigation 2: prove that the mails come from your mail server with DomainKeys Identified Mail (DKIM).
+                """
+        , expl_txt """
+          You will have to configure your mail server to sign the emails you send.
+          This involves creating a pair of keys (public and private).
+          Your mail server will sign the mails with the private key,
+          and other mail servers will verify the signature with the public key.
+          So, you need to publish the public key in a DKIM record.
+          """
+        ]
+      , col
+        [ expl' """
+                Spam mitigation 3: mitigate fraud (impersonators) with Domain-based Message Authentication Reporting and Conformance (DMARC).
+                Tell other mail servers to only accept emails from your domain which actually are coming from your domain (SPF) and sent by your mail server (DKIM).
+                """
+        , expl_txt """
+          Last but not least, DMARC.
+          """
+        , Bulma.hr
+        , Bulma.p """
+          DMARC enables to check the "From:" field of a mail, based on the SPF and DKIM mechanisms.
+          Thus, domains with a DMARC record enable to only allow verified mails.
+          Valid emails come from an authorized IP address (SPF), are signed by the verified email server (DKIM) and have an email address coming from a verified domain (DMARC) related to the two previous spam mitigation mechanisms.
+          """
+        , Bulma.hr
+        , Bulma.p """
+          With DMARC, you won't accept an email from "hacker@example.com" because it was sent by another domain with a valid SPF and DKIM.
+          """
+        ]
+      ]
+
+  , Bulma.hr
+  , Bulma.h3 "How to automate the update of my IP address?"
+  , Bulma.p "Check out the \"Tokens? 🤨\" tab."
+  ]
+
 dkim_introduction :: forall w i. Array (HH.HTML w i)
 dkim_introduction =
   [ Bulma.p """
     DKIM is a way to share a public signature key for the domain.
-    This allows emails to be signed by the sender, and for the receiver to prove the origin of the mail.
+    This enables emails to be signed by the sender and for the receiver to verify the origin of the mail.
     """
   , HH.p []
     [ HH.text """
@@ -67,6 +173,100 @@ dkim_introduction =
     ]
   ]
 
+dmarc_introduction :: forall w i. Array (HH.HTML w i)
+dmarc_introduction =
+  [ Bulma.p """
+    DMARC is a spam mitigation mechanism on top of SPF and DKIM.
+    Upon receiving a mail, the server checks whether the "From:" field of the mail is consistent with the SPF and DKIM
+    records of the sender's domain.
+    The DMARC record tells what to do with the mail in case of an inconsistency, and DMARC enables to define email
+    addresses that should receive error reports.
+    """
+  ]
+
+dmarc_policy :: forall w i. Array (HH.HTML w i)
+dmarc_policy =
+  [ Bulma.p """
+    DMARC record enables to tell receivers what to do with a non-conforming message;
+    a message that wasn't properly secured with SPF and DKIM.
+    """
+  , Bulma.p """
+    This message can either be accepted ("None") or rejected, or even quarantined, meaning to be considered as suspicious.
+    This can take different forms, such as being flagged, marked as spam or have a high "spam score", it's up to the receiver.
+    """
+  ]
+
+dmarc_sp_policy :: forall w i. Array (HH.HTML w i)
+dmarc_sp_policy =
+  [ Bulma.p """
+    Same as the previous entry, but for sub-domains.
+    """
+  ]
+
+dmarc_adkim :: forall w i. Array (HH.HTML w i)
+dmarc_adkim =
+  [ Bulma.p """
+    Consistency policy for DKIM. Tell what should be considered acceptable.
+    """
+  , Bulma.p """
+    This is about the relation between the email "From:" field and the domain field of the DKIM signature ("d:").
+    """
+  , Bulma.p """
+    The policy can be either strict (both should be identical) or relaxed (both in the same Organizational Domain).
+    """
+  ]
+
+dmarc_aspf :: forall w i. Array (HH.HTML w i)
+dmarc_aspf =
+  [ Bulma.p """
+    Consistency policy for SPF. Tell what should be considered acceptable.
+    """
+  , Bulma.p """
+    First, SPF should produce a passing result.
+    Then, the "From:" and the "MailFrom:" fields of the received email are checked.
+    """
+  , Bulma.p """
+    In strict mode, both fields should be identical.
+    In relaxed mode, they can be different, but in the same Organizational Domain.
+    """
+  , Bulma.p """
+    From RFC7489: For example, if a message passes an SPF check with an
+    RFC5321.MailFrom domain of "cbg.bounces.example.com", and the address
+    portion of the RFC5322.From field contains "payments@example.com",
+    the Authenticated RFC5321.MailFrom domain identifier and the
+    RFC5322.From domain are considered to be "in alignment" in relaxed
+    mode, but not in strict mode.
+    """
+  , HH.p_
+    [ HH.text "See "
+    , HH.a [HP.href "https://publicsuffix.org/"] [ HH.text "publicsuffix.org" ]
+    , HH.text " for a list of organizational domains."
+    ]
+  ]
+
+dmarc_contact :: forall w i. Array (HH.HTML w i)
+dmarc_contact =
+  [ Bulma.p """
+    In case you want to receive error reports, enter email addresses that should receive either an aggregated report or a detailed report of the occurring errors.
+    """
+  ]
+
+dmarc_ri :: forall w i. Array (HH.HTML w i)
+dmarc_ri =
+  [ Bulma.p """
+    Requested report interval. Default is 86400.
+    """
+  ]
+
+dmarc_pct :: forall w i. Array (HH.HTML w i)
+dmarc_pct =
+  [ Bulma.p """
+    Sampling rate.
+    Percentage of messages subjected to the requested policy.
+    """
+  ]
+
+
 dkim_default_algorithms :: forall w i. Array (HH.HTML w i)
 dkim_default_algorithms =
   [ Bulma.p """
@@ -78,16 +278,16 @@ dkim_default_algorithms =
 spf_introduction :: forall w i. Array (HH.HTML w i)
 spf_introduction =
   [ HH.p []
-    [ HH.text "Sender Policy Framework (SPF) is a way to tell "
+    [ HH.text "Sender Policy Framework (SPF) is a way to tell the "
     , HH.u_ [HH.text "other mail servers"]
-    , HH.text " what are mail servers susceptible to send mails with email addresses from "
+    , HH.text " which are the mail servers supposed to send mails from "
-    , HH.u_ [HH.text "our domain"]
+    , HH.u_ [HH.text "your domain"]
     , HH.text ". "
     ]
   , HH.p []
     [ HH.text """
     This way, we can mitigate spam.
-    A server receiving a mail with our email address but coming from an IP address we didn't list as authorized will be discarded.
+    A server receiving a mail from your email address but coming from an IP address we didn't list as authorized will be discarded.
     This is not a bullet-proof technique, but it's simple enough and works great with the most basic forms of spam.
     """
     ]
@@ -95,9 +295,11 @@ spf_introduction =
     [ HH.text "A correctly configured domain with a mail server should only advertise the right IP addresses that can possibly send mails from the domain."
     ]
   , HH.p []
-    [ HH.u_ [HH.text "Advice for novice users"]
+    [ HH.u_ [HH.text "Advice for beginners"]
     , HH.text """
       : default values should work great with simple domains.
+      Don't change anything, just click on the "Add" button below.
+      In addition, make sure to have an MX record, which should be pointing to an A or AAAA record, and that will do it. 🥳
       """
     ]
   ]
@@ -107,7 +309,7 @@ spf_default_behavior = [Bulma.p """
   What should someone do when receiving a mail with your email address but not from a listed domain or IP address?
   """
   , HH.text """
-  By default, let's advise to drop the mail (a
+  By default, let's opt for dropping the mail (a
   """
   , HH.u_ [HH.text "hard fail"]
   , HH.text """).
@@ -117,20 +319,20 @@ spf_default_behavior = [Bulma.p """
 
 srv_introduction :: forall w i. Array (HH.HTML w i)
 srv_introduction =
-  [ Bulma.p "The SRV record is a DNS RR for specifying the location of services."
+  [ Bulma.p "The SRV record is a DNS resource record for specifying the location of services."
   , HH.p_ [ HH.text "Given a specific "
           , HH.u_ [HH.text "service name"]
           , HH.text " (which may be arbitrary) and a "
           , HH.u_ [HH.text "protocol"]
           , HH.text " (such as TCP or UDP), you can tell where the server is (address name and port). "
           , HH.text """
-            Both the names of the service and the protocol are used to construct the name of the RR.
+            Both the names of the service and the protocol are used to construct the name of the resource record.
           """
           ]
   , HH.p_ [ HH.text "For example, for a service named "
           , HH.u_ [HH.text "voip"]
-          , HH.text " and given that this service uses the TCP protocol, you can specify that the target is "
+          , HH.text " and given that this service uses the TCP protocol, the target "
           , HH.u_ [HH.text "server1.example.com."]
-          , HH.text "."
+          , HH.text " could be specified."
           ]
   ]

src/App/Type/AcceptedRRTypes.purs

@@ -17,8 +17,9 @@ data AcceptedRRTypes
   | SRV
   | SPF
   | DKIM
+  | DMARC
 
-derive instance genericMyADT :: Generic AcceptedRRTypes _
+derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
 
-instance showMyADT :: Show AcceptedRRTypes where
+instance showAcceptedRRTypes :: Show AcceptedRRTypes where
   show = genericShow

src/App/Type/DKIM.purs

@@ -1,5 +1,10 @@
 module App.Type.DKIM 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)
@@ -39,10 +44,13 @@ emptyDKIMRR = { v: Nothing, k: Just RSA, h: Just SHA256, p: "", n: Nothing }
 
 data HashingAlgorithm = {- SHA1 | -} SHA256
 hash_algos = [ {- "sha1", -} SHA256] :: Array HashingAlgorithm
+derive instance genericHashingAlgorithm :: Generic HashingAlgorithm _
+instance showHashingAlgorithm :: Show HashingAlgorithm where
+  show = genericShow
 
 -- | Codec for just encoding a single value of type `HashingAlgorithm`.
 codecHashingAlgorithm :: CA.JsonCodec HashingAlgorithm
-codecHashingAlgorithm = CA.prismaticCodec "HashingAlgorithm" str_to_hashing_algorithm show_hashing_algorithm CA.string
+codecHashingAlgorithm = CA.prismaticCodec "HashingAlgorithm" str_to_hashing_algorithm generic_serialization CA.string
 
 str_to_hashing_algorithm :: String -> Maybe HashingAlgorithm
 str_to_hashing_algorithm = case _ of
@@ -50,17 +58,15 @@ str_to_hashing_algorithm = case _ of
   "sha256"    -> Just SHA256
   _ -> Nothing
 
-show_hashing_algorithm :: HashingAlgorithm -> String
-show_hashing_algorithm = case _ of
-  -- SHA1   -> "sha1"
-  SHA256 -> "sha256"
-
 data SignatureAlgorithm = RSA | ED25519
 sign_algos = [RSA, ED25519] :: Array SignatureAlgorithm
+derive instance genericSignatureAlgorithm :: Generic SignatureAlgorithm _
+instance showSignatureAlgorithm :: Show SignatureAlgorithm where
+  show = genericShow
 
 -- | Codec for just encoding a single value of type `SignatureAlgorithm`.
 codecSignatureAlgorithm :: CA.JsonCodec SignatureAlgorithm
-codecSignatureAlgorithm = CA.prismaticCodec "SignatureAlgorithm" str_to_signature_algorithm show_signature_algorithm CA.string
+codecSignatureAlgorithm = CA.prismaticCodec "SignatureAlgorithm" str_to_signature_algorithm generic_serialization CA.string
 
 str_to_signature_algorithm :: String -> Maybe SignatureAlgorithm
 str_to_signature_algorithm = case _ of
@@ -68,22 +74,16 @@ str_to_signature_algorithm = case _ of
   "ed25519"   -> Just ED25519
   _ -> Nothing
 
-show_signature_algorithm :: SignatureAlgorithm -> String
-show_signature_algorithm = case _ of
-  RSA     -> "rsa"
-  ED25519 -> "ed25519"
-
 data Version = DKIM1
+derive instance genericVersion :: Generic Version _
+instance showVersion :: Show Version where
+  show = genericShow
 
 -- | Codec for just encoding a single value of type `Version`.
 codecVersion :: CA.JsonCodec Version
-codecVersion = CA.prismaticCodec "Version" str_to_version show_version CA.string
+codecVersion = CA.prismaticCodec "Version" str_to_version generic_serialization CA.string
 
 str_to_version :: String -> Maybe Version
 str_to_version = case _ of
-  "dkim1"       -> Just DKIM1
+  "dkim1" -> Just DKIM1
-  _ -> Nothing
+  _       -> Nothing
-
-show_version :: Version -> String
-show_version = case _ of
-  DKIM1 -> "dkim1"

src/App/Type/DMARC.purs

@@ -0,0 +1,251 @@
+-- | DMARC is a spam mitigation mechanism described in RFC7489.
+-- | DMARC is built on top of DKIM and SPF.
+module App.Type.DMARC 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
+
+type DMARC
+  = {
+    -- | adkim= Optional.
+    -- | Consistency policy for DKIM.
+    -- | Either strict (dkim signature domain = "From:" field) or relaxed (both in the same Organizational Domain).
+      adkim :: Maybe ConsistencyPolicy
+
+    -- | aspf= Optional.
+    -- | Consistency policy for SPF.
+    -- | Either strict ("MailFrom:" same as "From:") or relaxed (both in the same Organizational Domain).
+    , aspf :: Maybe ConsistencyPolicy
+
+    -- | v= Required. Default is "DMARC1", so the implementation doesn't actually require it.
+    , v :: Maybe Version
+
+    -- | pct= Optional. Percentage of messages subjected to the requested policy [0...100], 100 by default.
+    , pct :: Maybe Int
+
+    -- | p= Required. Requested Mail Receiver policy (None, Quarantine, Reject).
+    , p :: Policy
+
+    -- | sp= Optional. Requested Mail Receiver policy for all subdomains.
+    , sp :: Maybe Policy
+
+    -- | fo= Optional. When to send a report (on DKIM or SPF error? Any? Both?).
+    , fo :: Maybe ReportOccasion
+
+    -- | rua= Optional. Addresses to which aggregate feedback is to be sent.
+    , rua :: Maybe (Array DMARCURI)
+
+    -- | ruf= Optional. Addresses to which message-specific failure information is to be reported.
+    , ruf :: Maybe (Array DMARCURI)
+
+    -- | rf= Optional. List of accepted report format, AFRF by default.
+    , rf :: Maybe (Array ReportFormat)
+
+    -- | ri= Optional. Interval requested between aggregate reports. Default is 86400.
+    , ri :: Maybe Int
+    }
+
+emptyDMARCRR :: DMARC
+emptyDMARCRR =
+  { adkim: Nothing
+  , aspf: Nothing
+  , v: Nothing     -- default: DMARC1
+  , pct: Nothing   -- default: 100%
+  , p: Reject
+  , sp: Nothing
+  , fo: Nothing
+  , rua: Nothing
+  , ruf: Nothing
+  , rf: Nothing    -- default: AFRF
+  , ri: Nothing    -- default: 86400
+  }
+
+codec :: JsonCodec DMARC
+codec = CA.object "DMARC"
+  (CAR.record
+    { v: CAR.optional codecVersion
+
+    , adkim: CAR.optional codecConsistencyPolicy
+    , aspf:  CAR.optional codecConsistencyPolicy
+    , pct:   CAR.optional CA.int
+    , p:     codecPolicy
+    , sp:    CAR.optional codecPolicy
+    , fo:    CAR.optional codecReportOccasion
+    , rua:   CAR.optional (CA.array codecDMARCURI)
+    , ruf:   CAR.optional (CA.array codecDMARCURI)
+    , rf:    CAR.optional (CA.array codecReportFormat)
+    , ri:    CAR.optional CA.int
+    })
+
+-- | DMARCURI is both an email and an eventual size.
+-- | This is a simplification of the actual specs, but that's good enough.
+type DMARCURI = { mail :: String, limit :: Maybe Int }
+
+-- | Codec for just encoding a single value of type `DMARCURI`.
+codecDMARCURI :: JsonCodec DMARCURI
+codecDMARCURI = CA.object "DMARCURI" (CAR.record { mail: CA.string, limit: CAR.optional CA.int })
+
+data ReportOccasion
+  -- | Both DKIM and SPF should be in error to have a report.
+  = Both
+  -- | DKIM should be erroneous to produce a report.
+  | DKIMonly
+  -- | SPF should be erroneous to produce a report.
+  | SPFonly
+  -- | Produce a report whether SPF or DKIM is erroneous.
+  | Any
+
+report_occasions :: Array ReportOccasion
+report_occasions = [Both, DKIMonly, SPFonly, Any]
+
+report_occasions_txt :: Array String
+report_occasions_txt
+  = [ "Do not tell when to send reports (default: when both fail)"
+    , "When both SPF and DKIM fail"
+    , "Upon a DKIM error"
+    , "Upon an SPF error"
+    , "Upon any error"
+    ]
+
+report_occasions_raw :: Array String
+report_occasions_raw = map show report_occasions
+
+-- | Codec for just encoding a single value of type `ReportOccasion`.
+codecReportOccasion :: CA.JsonCodec ReportOccasion
+codecReportOccasion = CA.prismaticCodec "ReportOccasion" str_to_report_occasion generic_serialization CA.string
+
+str_to_report_occasion :: String -> Maybe ReportOccasion
+str_to_report_occasion = case _ of
+  "both"     -> Just Both
+  "dkimonly" -> Just DKIMonly
+  "spfonly"  -> Just SPFonly
+  "any"      -> Just Any
+  _ -> Nothing
+
+derive instance genericReportOccasion :: Generic ReportOccasion _
+instance showReportOccasion :: Show ReportOccasion where
+  show = genericShow
+
+data ConsistencyPolicy
+  -- | s = strict.
+  -- |
+  -- | For DKIM: DKIM signature should first be verified.
+  -- | Then, the "From:" field should be the exact same domain as the DKIM signature domain.
+  -- |
+  -- | For SPF: first, SPF should produce a passing result. Then, the "From:" and the "MailFrom:" fields are checked.
+  -- | In strict mode, Both "MailFrom:" and "From:" fields should have the same value.
+  -- |
+  -- | From RFC7489: For example, if a message passes an SPF check with an
+  -- | RFC5321.MailFrom domain of "cbg.bounces.example.com", and the address
+  -- | portion of the RFC5322.From field contains "payments@example.com",
+  -- | the Authenticated RFC5321.MailFrom domain identifier and the
+  -- | RFC5322.From domain are considered to be "in alignment" in relaxed
+  -- | mode, but not in strict mode.
+  -- | See https://publicsuffix.org/ for a list of organizational domains.
+  = Strict
+  -- | r = relaxed, default.
+  -- |
+  -- | For DKIM: DKIM signature should first be verified.
+  -- | Then, the "From:" field should have the same domain as the DKIM signature domain or be in the same
+  -- | Organizational Domain.
+  -- | Example: "From:" is example@foo.example.org, DKIM signature can be d=example.org or d=bar.example.org.
+  -- |
+  -- | For SPF: as for "strict" policy, SPF should first produce a passing result.
+  -- | Then, the "From:" and the "MailFrom:" fields should be checked.
+  -- | In relaxed mode, they can be different, but in the same Organizational Domain.
+  -- | See https://publicsuffix.org/ for a list of organizational domains.
+  | Relaxed
+
+consistency_policies :: Array ConsistencyPolicy
+consistency_policies = [Strict, Relaxed]
+
+consistency_policies_txt :: Array String
+consistency_policies_txt
+  = [ "Do not provide policy advice"
+    , "Strict"
+    , "Relaxed"
+    ]
+
+-- | Codec for just encoding a single value of type `ConsistencyPolicy`.
+codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy
+codecConsistencyPolicy
+  = CA.prismaticCodec "ConsistencyPolicy" str_to_consistency_policy generic_serialization CA.string
+
+str_to_consistency_policy :: String -> Maybe ConsistencyPolicy
+str_to_consistency_policy = case _ of
+  "relaxed" -> Just Relaxed
+  "strict"  -> Just Strict
+  _ -> Nothing
+
+derive instance genericConsistencyPolicy :: Generic ConsistencyPolicy _
+instance showConsistencyPolicy :: Show ConsistencyPolicy where
+  show = genericShow
+
+data ReportFormat
+  -- | Authentication Failure Reporting Format, see RFC6591. Currently the only format referenced in RFC7489.
+  = AFRF
+
+-- | Codec for just encoding a single value of type `ReportFormat`.
+codecReportFormat :: CA.JsonCodec ReportFormat
+codecReportFormat = CA.prismaticCodec "ReportFormat" str_to_report_format generic_serialization CA.string
+
+str_to_report_format :: String -> Maybe ReportFormat
+str_to_report_format = case _ of
+  "afrf" -> Just AFRF
+  _ -> Nothing
+
+derive instance genericFormat :: Generic ReportFormat _
+instance showFormat :: Show ReportFormat where
+  show = genericShow
+
+data Version
+  -- | Version of DMARC only accepts DMARC1 currently.
+  -- | So, for dnsmanager, this field is just ignored for now.
+  = DMARC1
+
+-- | Codec for just encoding a single value of type `Version`.
+codecVersion :: CA.JsonCodec Version
+codecVersion = CA.prismaticCodec "Version" str_to_version generic_serialization CA.string
+
+str_to_version :: String -> Maybe Version
+str_to_version = case _ of
+  "dmarc1"      -> Just DMARC1
+  _ -> Nothing
+
+derive instance genericVersion :: Generic Version _
+instance showVersion :: Show Version where
+  show = genericShow
+
+data Policy
+  -- | "None" means to basically just accept the mail.
+  = None
+  -- | "Quarantine" means to consider the mail as suspicious, by giving it a bad spam score or something like that.
+  | Quarantine
+  -- | "Reject" means to not accept any failure of DKIM or SPF.
+  | Reject
+
+policies :: Array Policy
+policies = [None, Quarantine, Reject]
+
+-- | Codec for just encoding a single value of type `Policy`.
+codecPolicy :: CA.JsonCodec Policy
+codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string
+
+str_to_policy :: String -> Maybe Policy
+str_to_policy = case _ of
+  "none"       -> Just None
+  "quarantine" -> Just Quarantine
+  "reject"     -> Just Reject
+  _ -> Nothing
+
+derive instance genericPolicy :: Generic Policy _
+instance showPolicy :: Show Policy where
+  show = genericShow

src/App/Type/GenericSerialization.purs

@@ -0,0 +1,6 @@
+module App.Type.GenericSerialization where
+import Prelude (show, class Show, (<<<))
+import Data.String (toLower)
+
+generic_serialization :: forall a. Show a => a -> String
+generic_serialization = toLower <<< show

src/App/Type/Pages.purs

@@ -1,4 +1,8 @@
 module App.Type.Pages where
+
+import Prelude
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
 -- | This list will grow in a near future.
 -- |
 -- | TODO: 
@@ -11,3 +15,8 @@ data Page
   | Zone String    -- | `Zone`: to manage a zone.
   | Setup          -- | `Setup`: user account administration page
   | Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).
+
+derive instance genericPage :: Generic Page _
+
+instance showPage :: Show Page where
+  show = genericShow

src/App/Type/ResourceRecord.purs

@@ -9,6 +9,7 @@ import Data.Codec.Argonaut as CA
 import Data.Codec.Argonaut.Record as CAR
 
 import App.Type.DKIM as DKIM
+import App.Type.DMARC as DMARC
 
 type ResourceRecord
   = { rrtype   :: String
@@ -44,6 +45,7 @@ type ResourceRecord
     , q          :: Maybe Qualifier  -- Qualifier for default mechanism (`all`).
 
     , dkim :: Maybe DKIM.DKIM
+    , dmarc :: Maybe DMARC.DMARC
 
     -- TODO: DMARC specific entries.
     }
@@ -84,6 +86,7 @@ codec = CA.object "ResourceRecord"
     , q:          CAR.optional codecQualifier
 
     , dkim:       CAR.optional DKIM.codec
+    , dmarc:      CAR.optional DMARC.codec
     })
 
 type Mechanism
@@ -225,6 +228,7 @@ emptyRR
     , q:            Nothing
 
     , dkim:         Nothing
+    , dmarc:        Nothing
     }
 
 data Qualifier = Pass | Neutral | SoftFail | HardFail

src/App/Validation/DNS.purs

@@ -20,6 +20,7 @@ import GenericParser.IPAddress as IPAddress
 import GenericParser.RFC5234 as RFC5234
 
 import App.Type.DKIM as DKIM
+import App.Type.DMARC as DMARC
 
 -- | **History:**
 -- | The module once used dedicated types for each type of RR.
@@ -51,6 +52,8 @@ data Error
   | VEProtocol (G.Error ProtocolError)
   | VEPort Int Int Int
   | VEWeight Int Int Int
+  | VEDMARCpct Int Int Int
+  | VEDMARCri  Int Int Int
 
   -- SPF
   | VESPFMechanismName (G.Error DomainParser.DomainError)
@@ -105,7 +108,7 @@ txt_parser = do pos <- G.current_position
                     then pure $ CU.fromCharArray v
                     else G.Parser \_ -> G.failureError pos (Just $ TXTTooLong max_txt nbchar)
 
--- | `parse` allows to run any parser based on `GenericParser` and provide a validation error.
+-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
 -- | The actual validation error contains the parser's error including the position.
 parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
 parse (G.Parser p) str c = case p { string: str, position: 0 } of
@@ -270,7 +273,7 @@ validationSPF form = ado
 -- | Accepted RSA key sizes = 2048 or 4096 bits, 256 bits for ED25519.
 -- |
 -- | Since the public key representation for the RSA algorithm is in PKCS format (RFC 5958)
--- | then converted in PEM (RFC 7468), and knowing this format allows some optional parameters,
+-- | then converted in PEM (RFC 7468), and knowing this format enables some optional parameters,
 -- | it is not possible to expect an exact size for the public key input.
 -- | Consequently, we expect *at least* an input of 250 bytes for public key, loosely leading
 -- | to accept key sizes of at least 2048 bits. Maximum allowed key size is also arbitrary.
@@ -309,6 +312,20 @@ validationDKIM form =
                , name = name, ttl = ttl, target = "" -- `target` is discarded!
                , dkim = Just $ dkim { p = p } }
 
+validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord
+validationDMARC form =
+  let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
+  in ado
+    name     <- parse DomainParser.sub_eof form.name     VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
+    pct      <- is_between 0 100      (fromMaybe 100   dmarc.pct) VEDMARCpct
+    ri       <- is_between 0 1000000  (fromMaybe 86400 dmarc.ri)  VEDMARCri
+    -- 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 = "DMARC"
+               , name = name, ttl = ttl, target = "" -- `target` is discarded!
+               , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
+
 validation :: ResourceRecord -> Either (Array Error) ResourceRecord
 validation entry = case entry.rrtype of
   "A"     -> toEither $ validationA     entry
@@ -320,6 +337,7 @@ validation entry = case entry.rrtype of
   "SRV"   -> toEither $ validationSRV   entry
   "SPF"   -> toEither $ validationSPF   entry
   "DKIM"  -> toEither $ validationDKIM  entry
+  "DMARC" -> toEither $ validationDMARC entry
   _       -> toEither $ invalid [UNKNOWN]
 
 id :: forall a. a -> a

src/App/WS.purs

@@ -3,7 +3,7 @@
 module App.WS where
 
 import Prelude (Unit, bind, discard, pure, show, void, when
-               , ($), (&&), (<$>), (<>), (>>=), (>=>), (<<<), map, (=<<))
+               , ($), (&&), (<$>), (<>), (>>=), (>=>), (<<<), map, (=<<), unit)
 
 import Control.Monad.Rec.Class (forever)
 import Control.Monad.Except (runExcept)
@@ -230,7 +230,7 @@ send_message message = do
       Nothing -> H.raise $ Log $ UnableToSend "Not connected to server."
       Just webSocket -> do
         H.liftEffect (WS.readyState webSocket) >>= case _ of
-          Connecting -> H.raise $ Log $ UnableToSend "Still connecting to server."
+          Connecting -> pure unit -- H.raise $ Log $ UnableToSend "Still connecting to server."
           Closing    -> H.raise $ Log $ UnableToSend "Connection to server is closing."
           Closed     -> do
             H.raise $ Log $ UnableToSend "Connection to server has been closed."

src/Bulma.purs

@@ -2,6 +2,7 @@
 module Bulma where
 import Prelude
 
+import Data.Tuple (Tuple, fst, snd)
 import Halogen.HTML as HH
 import DOM.HTML.Indexed as DHI
 import Halogen.HTML.Properties as HP
@@ -77,6 +78,14 @@ modifier_table_header
                        ]
               ]
 
+dmarc_dmarcuri_table_header :: forall w i. HH.HTML w i
+dmarc_dmarcuri_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ]
+                       , HH.th_ [ HH.text "Report size limit" ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
 simple_table_header :: forall w i. HH.HTML w i
 simple_table_header
   = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Type" ]
@@ -147,6 +156,24 @@ dkim_table_header
                        ]
               ]
 
+dmarc_table_header :: forall w i. HH.HTML w i
+dmarc_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
+                       , HH.th_ [ HH.text "TTL"   ]
+                       -- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DMARC1.
+                       , HH.th_ [ HH.text "Policy" ]           -- p
+                       , HH.th_ [ HH.text "Subdomain Policy" ] -- sp
+                       , HH.th_ [ HH.text "DKIM policy" ]      -- adkim
+                       , HH.th_ [ HH.text "SPF policy" ]       -- aspf
+                       , HH.th_ [ HH.text "Sample rate" ]      -- pct
+                       , HH.th_ [ HH.text "Report on" ]        -- fo
+                       , HH.th_ [ HH.text "Report interval" ]  -- ri
+                       -- TODO? rua & ruf
+                       -- , HH.th_ [ HH.text "Accepted report formats" ] -- For now, assume AFRF.
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
 soa_table_header :: forall w i. HH.HTML w i
 soa_table_header
   = HH.thead_ [ HH.tr [ HP.classes C.has_background_warning_light ]
@@ -258,8 +285,8 @@ div_field_content content
            [ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]
 
 field_inner :: forall w i.
-  Boolean -> String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
+  Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-field_inner ispassword id title placeholder action value cond
+field_inner ispassword cond id title placeholder action value
   = div_field
       [ div_field_label id title
       , div_field_content $ render_input ispassword id placeholder action value cond
@@ -286,13 +313,19 @@ labeled_field id title content
       , div_field_content content
       ]
 
-box_input :: forall w i.
+box_input_ :: forall w i.
-  String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
+  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-box_input = field_inner false
+box_input_ = field_inner false
 
-box_password :: forall w i.
+box_password_ :: forall w i.
-  String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
+  (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
-box_password = field_inner true
+box_password_ = field_inner true
+
+box_input :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+box_input = box_input_ (HP.enabled true)
+
+box_password :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
+box_password = box_password_ (HP.enabled true)
 
 section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
 section_small = HH.section [ HP.classes (C.section <> C.is_small) ]
@@ -483,6 +516,22 @@ selection_field id title action values selected
       , 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
+      [ 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.
+selection' :: forall w i. (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
+selection' action values selected = HH.div [HP.classes $ C.select <> C.is_normal]
+  [ HH.select [ HE.onSelectedIndexChange action ]
+    $ map (\n -> HH.option [HP.value (snd n), HP.selected ((snd n) == selected)] [HH.text (fst n)]) values
+  ]
+
 tag_light_info :: forall w i. String -> HH.HTML w i
 tag_light_info str = HH.span [HP.classes (C.tag <> C.is_info <> C.is_light)] [HH.text str]
 
@@ -506,3 +555,48 @@ tab_entry :: forall w i. Boolean -> String -> i -> HH.HTML w i
 tab_entry active name action =
   HH.li (if active then [HP.classes C.is_active] else [])
     [ HH.a [HE.onClick \_ -> action] [HH.text name] ]
+
+delete_btn :: forall w i. i -> HH.HTML w i
+delete_btn action = HH.button [HE.onClick \_ -> action, HP.classes C.delete] []
+
+notification :: forall w i. Array HH.ClassName -> String -> i -> HH.HTML w i
+notification classes value deleteaction =
+  HH.div [HP.classes (C.notification <> classes)]
+         [ delete_btn deleteaction
+         , HH.text value
+         ]
+
+notification_primary :: forall w i. String -> i -> HH.HTML w i
+notification_primary value deleteaction = notification C.is_primary value deleteaction
+
+notification_success :: forall w i. String -> i -> HH.HTML w i
+notification_success value deleteaction = notification C.is_success value deleteaction
+
+notification_danger :: forall w i. String -> i -> HH.HTML w i
+notification_danger value deleteaction = notification C.is_danger value deleteaction
+
+notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+notification_block' classes content =
+  HH.div [HP.classes (C.notification <> classes)] content
+
+notification' :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
+notification' classes value =
+  HH.div [HP.classes (C.notification <> classes)]
+         [ HH.text value ]
+
+notification_danger' :: forall w i. String -> HH.HTML w i
+notification_danger' value = notification' C.is_danger value
+
+notification_danger_block' :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+notification_danger_block' content = notification_block' C.is_danger content
+
+btn_validation_ :: forall w i. String -> HH.HTML w i
+btn_validation_ str = HH.button
+  -- [ HP.style "padding: 0.5rem 1.25rem;"
+  [ HP.type_ HP.ButtonSubmit
+  , HP.classes $ C.button <> C.is_primary
+  ]
+  [ HH.text str ]
+
+btn_validation :: forall w i. HH.HTML w i
+btn_validation = btn_validation_ "Validate"