WIP: cleaner API for components.

src/App/Container.purs

@@ -524,7 +524,6 @@ handleAction = case _ of
     PageNavigation.Disconnection -> handleAction $ Disconnection
 
   EventPageAuthentication ev -> case ev of
-    PageAuthentication.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
     PageAuthentication.AskPasswordRecovery e -> case e of
       Left  email -> do
         message <- H.liftEffect $ AuthD.serialize $
@@ -550,11 +549,15 @@ handleAction = case _ of
       H.tell _nav unit $ PageNavigation.TellLogin (Just login)
 
   EventPageRegistration ev -> case ev of
-    PageRegistration.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
-    PageRegistration.Log message            -> handleAction $ Log message
+    PageRegistration.AskRegister login email password -> do
+      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkRegister { login, email, password }
+      H.tell _ws_auth unit (WS.ToSend message)
+    PageRegistration.Log message -> handleAction $ Log message
 
   EventPageMailValidation ev -> case ev of
-    PageMailValidation.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
+    PageMailValidation.AskValidateUser user activation_key -> do
+      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkValidateUser { user, activation_key }
+      H.tell _ws_auth unit (WS.ToSend message)
     PageMailValidation.Log message            -> handleAction $ Log message
 
   EventPageSetup ev -> case ev of
@@ -582,8 +585,6 @@ handleAction = case _ of
     PageSetup.Log message -> handleAction $ Log message
 
   EventPageAdministration ev     -> case ev of
-    PageAdministration.SendToAuthd message      -> H.tell _ws_auth unit (WS.ToSend message)
-    PageAdministration.SendToDNSManager message -> H.tell _ws_dns  unit (WS.ToSend message)
     PageAdministration.DeleteDomain domain      -> do
       message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
       H.tell _ws_dns  unit (WS.ToSend message)
@@ -620,7 +621,24 @@ handleAction = case _ of
     PageZone.ToDomainList           -> handleAction $ Routing DomainList
 
   EventPageDomainList ev -> case ev of
-    PageDomainList.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
+    PageDomainList.AskShareToken domain -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain }
+      H.tell _ws_dns unit (WS.ToSend message)
+    PageDomainList.AskTransferToken domain -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskTransferToken { domain }
+      H.tell _ws_dns unit (WS.ToSend message)
+    PageDomainList.AskUnShareDomain domain -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskUnShareDomain { domain }
+      H.tell _ws_dns unit (WS.ToSend message)
+    PageDomainList.AskDeleteDomain domain -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
+      H.tell _ws_dns unit (WS.ToSend message)
+    PageDomainList.AskNewDomain domain -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkNewDomain { domain }
+      H.tell _ws_dns unit (WS.ToSend message)
+    PageDomainList.AskGainOwnership uuid -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGainOwnership { uuid }
+      H.tell _ws_dns unit (WS.ToSend message)
     PageDomainList.Log message            -> handleAction $ Log message
     PageDomainList.StoreState s           -> H.modify_ _ { childstates { domainlist = Just s } }
     PageDomainList.ChangePageZoneInterface domain -> do

src/App/Page/Administration.purs

@@ -34,7 +34,6 @@ import Web.HTML.Window (sessionStorage) as Window
 import Web.Storage.Storage as Storage
 
 import App.Type.UserPublic (UserPublic)
-import Data.ArrayBuffer.Types (ArrayBuffer)
 
 import App.Type.LogMessage
 import App.Type.Email as Email
@@ -42,10 +41,7 @@ import App.Type.Email as Email
 import App.Message.AuthenticationDaemon as AuthD
 
 data Output
-  = SendToAuthd ArrayBuffer
-  | SendToDNSManager ArrayBuffer
-
-  | AddUser String Boolean (Maybe Email.Email) String
+  = AddUser String Boolean (Maybe Email.Email) String
   | SearchUser (Maybe String) (Maybe Int)
   | DeleteUserAccount Int
 

src/App/Page/Authentication.purs

@@ -5,7 +5,6 @@ module App.Page.Authentication where
 import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show, unit)
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
 import Data.Eq (class Eq)
 import Data.Maybe (Maybe(..), maybe)
@@ -48,8 +47,7 @@ data Error
 -- |
 -- | TODO: authentication is performed in `App.Container`.
 data Output
-  = MessageToSend ArrayBuffer
-  | AuthenticateToAuthd (Tuple Login Password)
+  = AuthenticateToAuthd (Tuple Login Password)
   | Log LogMessage
   | UserLogin String
   | PasswordRecovery Login PasswordRecoveryToken Password

src/App/Page/DomainList.purs

@@ -15,7 +15,6 @@ module App.Page.DomainList where
 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)
@@ -52,7 +51,12 @@ import App.Message.DNSManagerDaemon as DNSManager
 -- | component is removed. This way, the data is conserved.
 
 data Output
-  = MessageToSend ArrayBuffer
+  = AskShareToken String
+  | AskTransferToken String
+  | AskUnShareDomain String
+  | AskDeleteDomain String
+  | AskNewDomain String
+  | AskGainOwnership String
   | Log LogMessage
   | ChangePageZoneInterface String
   | AskState
@@ -328,27 +332,23 @@ handleAction = case _ of
     H.raise $ ChangePageZoneInterface domain
 
   ShareDomain domain -> do
-    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain: domain }
-    H.raise $ MessageToSend message
     H.raise $ Log $ SystemLog $ "Ask a \"share token\" for domain " <> domain <> "."
+    H.raise $ AskShareToken domain
 
   TransferDomain domain -> do
-    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskTransferToken { domain: domain }
-    H.raise $ MessageToSend message
     H.raise $ Log $ SystemLog $ "Ask a \"transfer token\" for domain " <> domain <> "."
+    H.raise $ AskTransferToken domain
 
   UnShareDomain domain -> do
-    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskUnShareDomain { domain: domain }
-    H.raise $ MessageToSend message
     H.raise $ Log $ SystemLog $ "Ask for exclusive ownership for domain " <> domain <> "."
+    H.raise $ AskUnShareDomain domain
 
   DeleteDomainModal domain -> do
     H.modify_ _ { deletion_modal = Just domain }
 
   RemoveDomain domain -> do
-    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
-    H.raise $ MessageToSend message
     H.raise $ Log $ SystemLog $ "Remove domain: " <> domain
+    H.raise $ AskDeleteDomain domain
     H.modify_ _ { deletion_modal = Nothing }
 
   NewDomainAttempt ev -> do
@@ -361,10 +361,7 @@ handleAction = case _ of
       "", _, _ ->
         H.raise $ Log $ UnableToSend "Please enter the new domain."
       _, [], _ -> do
-        message <- H.liftEffect
-          $ DNSManager.serialize
-          $ DNSManager.MkNewDomain { domain: new_domain }
-        H.raise $ MessageToSend message
+        H.raise $ AskNewDomain new_domain
         H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")"
         handleAction $ HandleNewDomainInput $ INP_newdomain ""
       _, _, _ ->
@@ -374,14 +371,12 @@ handleAction = case _ of
     H.liftEffect $ Event.preventDefault ev
 
     { askDomainTransferForm } <- H.get
-    case askDomainTransferForm.uuid, askDomainTransferForm._errors of
+    let { uuid, _errors } = askDomainTransferForm
+    case uuid, _errors of
       "", _ ->
         H.raise $ Log $ UnableToSend "Please enter the UUID of the transfer."
       uuid, [] -> do
-        message <- H.liftEffect
-          $ DNSManager.serialize
-          $ DNSManager.MkGainOwnership { uuid: uuid }
-        H.raise $ MessageToSend message
+        H.raise $ AskGainOwnership uuid
         H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> uuid <> ")."
         handleAction $ AskDomainTransferUUIDInput ""
       _, _ ->

src/App/Page/MailValidation.purs

@@ -6,7 +6,6 @@ module App.Page.MailValidation where
 import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, show)
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Maybe (maybe)
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
@@ -19,13 +18,12 @@ import Web.Event.Event (Event)
 import Web as Web
 
 import App.Type.LogMessage
-import App.Message.AuthenticationDaemon as AuthD
 
 import App.Validation.Login as L
 import App.Validation.Token as T
 
 data Output
-  = MessageToSend ArrayBuffer
+  = AskValidateUser String String
   | Log LogMessage
 
 -- | The component is informed when the connection went up or down.
@@ -127,8 +125,7 @@ handleAction = case _ of
   SendMailValidationToken -> do
     { mailValidationForm } <- H.get
     let { login, token } = mailValidationForm
-    message <- H.liftEffect $ AuthD.serialize $ AuthD.MkValidateUser { user: login, activation_key: token }
-    H.raise $ MessageToSend message
+    H.raise $ AskValidateUser login token
     H.raise $ Log $ SystemLog $ "Trying to validate email address of user \"" <> login <> "\""
 
 show_error :: Error -> String

src/App/Page/Registration.purs

@@ -5,7 +5,6 @@ module App.Page.Registration where
 import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between, not)
 
 import Data.Array as A
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
@@ -24,7 +23,6 @@ import CSSClasses as C
 import Data.String as S
 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)
 
@@ -35,7 +33,7 @@ import App.Validation.Email as E
 import App.Validation.Password as P
 
 data Output
-  = MessageToSend ArrayBuffer
+  = AskRegister String (Maybe Email.Email) String
   | Log LogMessage
 
 data Query a = DoNothing a
@@ -193,9 +191,7 @@ handleAction = case _ of
   SendRegistrationRequest -> do
     { registrationForm } <- H.get
     let { login, email, pass } = registrationForm
-    message <- H.liftEffect $ AuthD.serialize $
-      AuthD.MkRegister { login, email: Just (Email.Email email), password: pass }
-    H.raise $ MessageToSend message
+    H.raise $ AskRegister login (Just (Email.Email email)) pass
     H.raise $ Log $ SystemLog $ "Trying to register (login: " <> login <> ")"
 
 show_error :: Error -> String