WIP: cleaner API for components.
This commit is contained in:
parent
6392c1941c
commit
507588cd66
6 changed files with 45 additions and 45 deletions
|
@ -524,7 +524,6 @@ handleAction = case _ of
|
||||||
PageNavigation.Disconnection -> handleAction $ Disconnection
|
PageNavigation.Disconnection -> handleAction $ Disconnection
|
||||||
|
|
||||||
EventPageAuthentication ev -> case ev of
|
EventPageAuthentication ev -> case ev of
|
||||||
PageAuthentication.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
|
||||||
PageAuthentication.AskPasswordRecovery e -> case e of
|
PageAuthentication.AskPasswordRecovery e -> case e of
|
||||||
Left email -> do
|
Left email -> do
|
||||||
message <- H.liftEffect $ AuthD.serialize $
|
message <- H.liftEffect $ AuthD.serialize $
|
||||||
|
@ -550,11 +549,15 @@ handleAction = case _ of
|
||||||
H.tell _nav unit $ PageNavigation.TellLogin (Just login)
|
H.tell _nav unit $ PageNavigation.TellLogin (Just login)
|
||||||
|
|
||||||
EventPageRegistration ev -> case ev of
|
EventPageRegistration ev -> case ev of
|
||||||
PageRegistration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
PageRegistration.AskRegister login email password -> do
|
||||||
PageRegistration.Log message -> handleAction $ Log message
|
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
|
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
|
PageMailValidation.Log message -> handleAction $ Log message
|
||||||
|
|
||||||
EventPageSetup ev -> case ev of
|
EventPageSetup ev -> case ev of
|
||||||
|
@ -582,8 +585,6 @@ handleAction = case _ of
|
||||||
PageSetup.Log message -> handleAction $ Log message
|
PageSetup.Log message -> handleAction $ Log message
|
||||||
|
|
||||||
EventPageAdministration ev -> case ev of
|
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
|
PageAdministration.DeleteDomain domain -> do
|
||||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
|
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
|
||||||
H.tell _ws_dns unit (WS.ToSend message)
|
H.tell _ws_dns unit (WS.ToSend message)
|
||||||
|
@ -620,7 +621,24 @@ handleAction = case _ of
|
||||||
PageZone.ToDomainList -> handleAction $ Routing DomainList
|
PageZone.ToDomainList -> handleAction $ Routing DomainList
|
||||||
|
|
||||||
EventPageDomainList ev -> case ev of
|
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.Log message -> handleAction $ Log message
|
||||||
PageDomainList.StoreState s -> H.modify_ _ { childstates { domainlist = Just s } }
|
PageDomainList.StoreState s -> H.modify_ _ { childstates { domainlist = Just s } }
|
||||||
PageDomainList.ChangePageZoneInterface domain -> do
|
PageDomainList.ChangePageZoneInterface domain -> do
|
||||||
|
|
|
@ -34,7 +34,6 @@ import Web.HTML.Window (sessionStorage) as Window
|
||||||
import Web.Storage.Storage as Storage
|
import Web.Storage.Storage as Storage
|
||||||
|
|
||||||
import App.Type.UserPublic (UserPublic)
|
import App.Type.UserPublic (UserPublic)
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
|
||||||
|
|
||||||
import App.Type.LogMessage
|
import App.Type.LogMessage
|
||||||
import App.Type.Email as Email
|
import App.Type.Email as Email
|
||||||
|
@ -42,10 +41,7 @@ import App.Type.Email as Email
|
||||||
import App.Message.AuthenticationDaemon as AuthD
|
import App.Message.AuthenticationDaemon as AuthD
|
||||||
|
|
||||||
data Output
|
data Output
|
||||||
= SendToAuthd ArrayBuffer
|
= AddUser String Boolean (Maybe Email.Email) String
|
||||||
| SendToDNSManager ArrayBuffer
|
|
||||||
|
|
||||||
| AddUser String Boolean (Maybe Email.Email) String
|
|
||||||
| SearchUser (Maybe String) (Maybe Int)
|
| SearchUser (Maybe String) (Maybe Int)
|
||||||
| DeleteUserAccount Int
|
| DeleteUserAccount Int
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,6 @@ module App.Page.Authentication where
|
||||||
import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show, unit)
|
import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show, unit)
|
||||||
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Data.Eq (class Eq)
|
import Data.Eq (class Eq)
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
|
@ -48,8 +47,7 @@ data Error
|
||||||
-- |
|
-- |
|
||||||
-- | TODO: authentication is performed in `App.Container`.
|
-- | TODO: authentication is performed in `App.Container`.
|
||||||
data Output
|
data Output
|
||||||
= MessageToSend ArrayBuffer
|
= AuthenticateToAuthd (Tuple Login Password)
|
||||||
| AuthenticateToAuthd (Tuple Login Password)
|
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
| UserLogin String
|
| UserLogin String
|
||||||
| PasswordRecovery Login PasswordRecoveryToken Password
|
| PasswordRecovery Login PasswordRecoveryToken Password
|
||||||
|
|
|
@ -15,7 +15,6 @@ module App.Page.DomainList where
|
||||||
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==))
|
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==))
|
||||||
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Data.String (toLower)
|
import Data.String (toLower)
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
|
@ -52,7 +51,12 @@ import App.Message.DNSManagerDaemon as DNSManager
|
||||||
-- | component is removed. This way, the data is conserved.
|
-- | component is removed. This way, the data is conserved.
|
||||||
|
|
||||||
data Output
|
data Output
|
||||||
= MessageToSend ArrayBuffer
|
= AskShareToken String
|
||||||
|
| AskTransferToken String
|
||||||
|
| AskUnShareDomain String
|
||||||
|
| AskDeleteDomain String
|
||||||
|
| AskNewDomain String
|
||||||
|
| AskGainOwnership String
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
| ChangePageZoneInterface String
|
| ChangePageZoneInterface String
|
||||||
| AskState
|
| AskState
|
||||||
|
@ -328,27 +332,23 @@ handleAction = case _ of
|
||||||
H.raise $ ChangePageZoneInterface domain
|
H.raise $ ChangePageZoneInterface domain
|
||||||
|
|
||||||
ShareDomain domain -> do
|
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 $ Log $ SystemLog $ "Ask a \"share token\" for domain " <> domain <> "."
|
||||||
|
H.raise $ AskShareToken domain
|
||||||
|
|
||||||
TransferDomain domain -> do
|
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 $ Log $ SystemLog $ "Ask a \"transfer token\" for domain " <> domain <> "."
|
||||||
|
H.raise $ AskTransferToken domain
|
||||||
|
|
||||||
UnShareDomain domain -> do
|
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 $ Log $ SystemLog $ "Ask for exclusive ownership for domain " <> domain <> "."
|
||||||
|
H.raise $ AskUnShareDomain domain
|
||||||
|
|
||||||
DeleteDomainModal domain -> do
|
DeleteDomainModal domain -> do
|
||||||
H.modify_ _ { deletion_modal = Just domain }
|
H.modify_ _ { deletion_modal = Just domain }
|
||||||
|
|
||||||
RemoveDomain domain -> do
|
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 $ Log $ SystemLog $ "Remove domain: " <> domain
|
||||||
|
H.raise $ AskDeleteDomain domain
|
||||||
H.modify_ _ { deletion_modal = Nothing }
|
H.modify_ _ { deletion_modal = Nothing }
|
||||||
|
|
||||||
NewDomainAttempt ev -> do
|
NewDomainAttempt ev -> do
|
||||||
|
@ -361,10 +361,7 @@ handleAction = case _ of
|
||||||
"", _, _ ->
|
"", _, _ ->
|
||||||
H.raise $ Log $ UnableToSend "Please enter the new domain."
|
H.raise $ Log $ UnableToSend "Please enter the new domain."
|
||||||
_, [], _ -> do
|
_, [], _ -> do
|
||||||
message <- H.liftEffect
|
H.raise $ AskNewDomain new_domain
|
||||||
$ DNSManager.serialize
|
|
||||||
$ DNSManager.MkNewDomain { domain: new_domain }
|
|
||||||
H.raise $ MessageToSend message
|
|
||||||
H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")"
|
H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")"
|
||||||
handleAction $ HandleNewDomainInput $ INP_newdomain ""
|
handleAction $ HandleNewDomainInput $ INP_newdomain ""
|
||||||
_, _, _ ->
|
_, _, _ ->
|
||||||
|
@ -374,14 +371,12 @@ handleAction = case _ of
|
||||||
H.liftEffect $ Event.preventDefault ev
|
H.liftEffect $ Event.preventDefault ev
|
||||||
|
|
||||||
{ askDomainTransferForm } <- H.get
|
{ 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."
|
H.raise $ Log $ UnableToSend "Please enter the UUID of the transfer."
|
||||||
uuid, [] -> do
|
uuid, [] -> do
|
||||||
message <- H.liftEffect
|
H.raise $ AskGainOwnership uuid
|
||||||
$ DNSManager.serialize
|
|
||||||
$ DNSManager.MkGainOwnership { uuid: uuid }
|
|
||||||
H.raise $ MessageToSend message
|
|
||||||
H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> uuid <> ")."
|
H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> uuid <> ")."
|
||||||
handleAction $ AskDomainTransferUUIDInput ""
|
handleAction $ AskDomainTransferUUIDInput ""
|
||||||
_, _ ->
|
_, _ ->
|
||||||
|
|
|
@ -6,7 +6,6 @@ module App.Page.MailValidation where
|
||||||
import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, show)
|
import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, show)
|
||||||
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
|
||||||
import Data.Maybe (maybe)
|
import Data.Maybe (maybe)
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Effect.Aff.Class (class MonadAff)
|
import Effect.Aff.Class (class MonadAff)
|
||||||
|
@ -19,13 +18,12 @@ import Web.Event.Event (Event)
|
||||||
import Web as Web
|
import Web as Web
|
||||||
|
|
||||||
import App.Type.LogMessage
|
import App.Type.LogMessage
|
||||||
import App.Message.AuthenticationDaemon as AuthD
|
|
||||||
|
|
||||||
import App.Validation.Login as L
|
import App.Validation.Login as L
|
||||||
import App.Validation.Token as T
|
import App.Validation.Token as T
|
||||||
|
|
||||||
data Output
|
data Output
|
||||||
= MessageToSend ArrayBuffer
|
= AskValidateUser String String
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
|
|
||||||
-- | The component is informed when the connection went up or down.
|
-- | The component is informed when the connection went up or down.
|
||||||
|
@ -127,8 +125,7 @@ handleAction = case _ of
|
||||||
SendMailValidationToken -> do
|
SendMailValidationToken -> do
|
||||||
{ mailValidationForm } <- H.get
|
{ mailValidationForm } <- H.get
|
||||||
let { login, token } = mailValidationForm
|
let { login, token } = mailValidationForm
|
||||||
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkValidateUser { user: login, activation_key: token }
|
H.raise $ AskValidateUser login token
|
||||||
H.raise $ MessageToSend message
|
|
||||||
H.raise $ Log $ SystemLog $ "Trying to validate email address of user \"" <> login <> "\""
|
H.raise $ Log $ SystemLog $ "Trying to validate email address of user \"" <> login <> "\""
|
||||||
|
|
||||||
show_error :: Error -> String
|
show_error :: Error -> String
|
||||||
|
|
|
@ -5,7 +5,6 @@ module App.Page.Registration where
|
||||||
import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between, not)
|
import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between, not)
|
||||||
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..))
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Effect.Aff.Class (class MonadAff)
|
import Effect.Aff.Class (class MonadAff)
|
||||||
|
@ -24,7 +23,6 @@ import CSSClasses as C
|
||||||
import Data.String as S
|
import Data.String as S
|
||||||
import App.Type.Email as Email
|
import App.Type.Email as Email
|
||||||
import App.Type.LogMessage
|
import App.Type.LogMessage
|
||||||
import App.Message.AuthenticationDaemon as AuthD
|
|
||||||
|
|
||||||
import App.DisplayErrors (show_error_login, show_error_email, show_error_password)
|
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
|
import App.Validation.Password as P
|
||||||
|
|
||||||
data Output
|
data Output
|
||||||
= MessageToSend ArrayBuffer
|
= AskRegister String (Maybe Email.Email) String
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
|
|
||||||
data Query a = DoNothing a
|
data Query a = DoNothing a
|
||||||
|
@ -193,9 +191,7 @@ handleAction = case _ of
|
||||||
SendRegistrationRequest -> do
|
SendRegistrationRequest -> do
|
||||||
{ registrationForm } <- H.get
|
{ registrationForm } <- H.get
|
||||||
let { login, email, pass } = registrationForm
|
let { login, email, pass } = registrationForm
|
||||||
message <- H.liftEffect $ AuthD.serialize $
|
H.raise $ AskRegister login (Just (Email.Email email)) pass
|
||||||
AuthD.MkRegister { login, email: Just (Email.Email email), password: pass }
|
|
||||||
H.raise $ MessageToSend message
|
|
||||||
H.raise $ Log $ SystemLog $ "Trying to register (login: " <> login <> ")"
|
H.raise $ Log $ SystemLog $ "Trying to register (login: " <> login <> ")"
|
||||||
|
|
||||||
show_error :: Error -> String
|
show_error :: Error -> String
|
||||||
|
|
Loading…
Add table
Reference in a new issue