From 507588cd66b68f54075dc91fe67e4b350b7af56f Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 9 May 2025 20:49:25 +0200 Subject: [PATCH] WIP: cleaner API for components. --- src/App/Container.purs | 32 ++++++++++++++++++++++++------- src/App/Page/Administration.purs | 6 +----- src/App/Page/Authentication.purs | 4 +--- src/App/Page/DomainList.purs | 33 ++++++++++++++------------------ src/App/Page/MailValidation.purs | 7 ++----- src/App/Page/Registration.purs | 8 ++------ 6 files changed, 45 insertions(+), 45 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index ba08fdd..8acc300 100644 --- a/src/App/Container.purs +++ b/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 diff --git a/src/App/Page/Administration.purs b/src/App/Page/Administration.purs index 740c2ef..0c2fe80 100644 --- a/src/App/Page/Administration.purs +++ b/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 diff --git a/src/App/Page/Authentication.purs b/src/App/Page/Authentication.purs index 2ad9557..e351ff6 100644 --- a/src/App/Page/Authentication.purs +++ b/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 diff --git a/src/App/Page/DomainList.purs b/src/App/Page/DomainList.purs index bcc4362..8961e2d 100644 --- a/src/App/Page/DomainList.purs +++ b/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 "" _, _ -> diff --git a/src/App/Page/MailValidation.purs b/src/App/Page/MailValidation.purs index ee64cb2..3397916 100644 --- a/src/App/Page/MailValidation.purs +++ b/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 diff --git a/src/App/Page/Registration.purs b/src/App/Page/Registration.purs index 7ffc6dc..3c2b449 100644 --- a/src/App/Page/Registration.purs +++ b/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