Put all decoding message code in Container instead of AuthenticationForm.
This commit is contained in:
parent
7178b29ae1
commit
6829b6445b
@ -6,7 +6,7 @@ import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), show)
|
|||||||
|
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..))
|
||||||
import Data.Tuple (Tuple(..))
|
import Data.Tuple (Tuple(..))
|
||||||
import Effect.Aff.Class (class MonadAff)
|
import Effect.Aff.Class (class MonadAff)
|
||||||
import Halogen as H
|
import Halogen as H
|
||||||
@ -28,15 +28,14 @@ import App.Messages.AuthenticationDaemon as AuthD
|
|||||||
-- |
|
-- |
|
||||||
-- | Also, the component can send a message to a websocket and log messages.
|
-- | Also, the component can send a message to a websocket and log messages.
|
||||||
data Output
|
data Output
|
||||||
= AuthToken (Tuple Int String)
|
= MessageToSend ArrayBuffer
|
||||||
| MessageToSend ArrayBuffer
|
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
|
|
||||||
-- | The component's parent provides received messages.
|
-- | The component's parent provides received messages.
|
||||||
-- |
|
-- |
|
||||||
-- | Also, the component is informed when the connection went up or down.
|
-- | Also, the component is informed when the connection went up or down.
|
||||||
data Query a
|
data Query a
|
||||||
= MessageReceived ArrayBuffer a
|
= MessageReceived AuthD.AnswerMessage a
|
||||||
| ConnectionIsDown a
|
| ConnectionIsDown a
|
||||||
| ConnectionIsUp a
|
| ConnectionIsUp a
|
||||||
|
|
||||||
@ -261,74 +260,13 @@ handleAction = case _ of
|
|||||||
|
|
||||||
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||||
handleQuery = case _ of
|
handleQuery = case _ of
|
||||||
|
-- For now, no message actually needs to be handled here.
|
||||||
|
-- Error messages are simply logged (see the code in the Container component).
|
||||||
MessageReceived message a -> do
|
MessageReceived message a -> do
|
||||||
receivedMessage <- H.liftEffect $ AuthD.deserialize message
|
case message of
|
||||||
case receivedMessage of
|
_ -> do
|
||||||
-- Cases where we didn't understand the message.
|
H.raise $ Log $ SimpleLog $ "[😈] Message not handled in AuthenticationForm."
|
||||||
Left err -> do
|
pure Nothing
|
||||||
case err of
|
|
||||||
(AuthD.JSONERROR jerr) -> do
|
|
||||||
-- print_json_string messageEvent.message
|
|
||||||
H.raise $ Log $ SimpleLog ("JSON parsing error: " <> jerr <> " JSON is: " <> jerr)
|
|
||||||
(AuthD.UnknownError unerr) -> H.raise $ Log $ SimpleLog ("Parsing error: AuthD.UnknownError" <> (show unerr))
|
|
||||||
(AuthD.UnknownNumber ) -> H.raise $ Log $ SimpleLog ("Parsing error: AuthD.UnknownNumber")
|
|
||||||
pure Nothing
|
|
||||||
|
|
||||||
-- Cases where we understood the message.
|
|
||||||
Right response -> do
|
|
||||||
case response of
|
|
||||||
-- The authentication failed.
|
|
||||||
(AuthD.GotError errmsg) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
|
|
||||||
pure (Just a)
|
|
||||||
(AuthD.GotPasswordRecoverySent _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Password recovery: email sent!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorPasswordTooShort _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Password too short!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorMailRequired _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Email required!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorInvalidCredentials _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Invalid credentials!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorRegistrationsClosed _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Registration closed! Try another time or contact an administrator."
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorInvalidLoginFormat _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Invalid login format!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorInvalidEmailFormat _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Invalid email format!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorAlreadyUsersInDB _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Login already taken!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorReadOnlyProfileKeys _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Trying to add a profile with some invalid (read-only) keys!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorInvalidActivationKey _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Invalid activation key!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorUserAlreadyValidated _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] User already validated!"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorCannotContactUser _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] User cannot be contacted. Are you sure about your email address?"
|
|
||||||
pure Nothing
|
|
||||||
(AuthD.GotErrorInvalidRenewKey _) -> do
|
|
||||||
H.raise $ Log $ SimpleLog "[😈] Invalid renew key!"
|
|
||||||
pure Nothing
|
|
||||||
-- The authentication was a success!
|
|
||||||
(AuthD.GotToken msg) -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[🎉] Authenticated to authd!"
|
|
||||||
H.raise $ AuthToken (Tuple msg.uid msg.token)
|
|
||||||
pure (Just a)
|
|
||||||
-- WTH?!
|
|
||||||
_ -> do
|
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
|
|
||||||
pure Nothing
|
|
||||||
|
|
||||||
ConnectionIsDown a -> do
|
ConnectionIsDown a -> do
|
||||||
H.modify_ _ { wsUp = false }
|
H.modify_ _ { wsUp = false }
|
||||||
@ -337,11 +275,3 @@ handleQuery = case _ of
|
|||||||
ConnectionIsUp a -> do
|
ConnectionIsUp a -> do
|
||||||
H.modify_ _ { wsUp = true }
|
H.modify_ _ { wsUp = true }
|
||||||
pure (Just a)
|
pure (Just a)
|
||||||
|
|
||||||
--print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
|
|
||||||
--print_json_string arraybuffer = do
|
|
||||||
-- -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
|
|
||||||
-- value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
|
|
||||||
-- H.raise $ Log $ SimpleLog $ case (value) of
|
|
||||||
-- Left _ -> "Cannot even fromTypedIPC the message."
|
|
||||||
-- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
|
|
||||||
|
@ -7,7 +7,7 @@ import Bulma as Bulma
|
|||||||
import App.Nav as Nav
|
import App.Nav as Nav
|
||||||
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Data.Tuple (Tuple(..))
|
import Data.Tuple (Tuple(..))
|
||||||
import App.AuthenticationForm as AF
|
import App.AuthenticationForm as AF
|
||||||
@ -18,6 +18,7 @@ import App.DomainListInterface as DomainListInterface
|
|||||||
import App.ZoneInterface as ZoneInterface
|
import App.ZoneInterface as ZoneInterface
|
||||||
import App.HomeInterface as HomeInterface
|
import App.HomeInterface as HomeInterface
|
||||||
import App.Messages.DNSManagerDaemon as DNSManager
|
import App.Messages.DNSManagerDaemon as DNSManager
|
||||||
|
import App.Messages.AuthenticationDaemon as AuthD
|
||||||
import Halogen as H
|
import Halogen as H
|
||||||
import Halogen.HTML as HH
|
import Halogen.HTML as HH
|
||||||
import Type.Proxy (Proxy(..))
|
import Type.Proxy (Proxy(..))
|
||||||
@ -54,6 +55,15 @@ data Action
|
|||||||
-- | Then, the message will be provided to the `DispatchDNSMessage` action.
|
-- | Then, the message will be provided to the `DispatchDNSMessage` action.
|
||||||
| DNSRawMessageReceived ArrayBuffer
|
| DNSRawMessageReceived ArrayBuffer
|
||||||
|
|
||||||
|
-- | AuthDaemonRawMessageReceived is the action when receiving a message, which is decoded in the handler.
|
||||||
|
-- | Then, the message will be provided to the `DispatchAuthDaemonMessage` action.
|
||||||
|
| AuthDaemonRawMessageReceived ArrayBuffer
|
||||||
|
|
||||||
|
-- | DispatchAuthDaemonMessage: an auth daemon message (from `authd`) was received and decoded through the
|
||||||
|
-- | `AuthDaemonRawMessageReceived` action.
|
||||||
|
-- | The message is provided to the right component.
|
||||||
|
-- | DispatchAuthDaemonMessage AuthD.AnswerMessage
|
||||||
|
|
||||||
-- | Log message (through the Log component).
|
-- | Log message (through the Log component).
|
||||||
| Log LogMessage
|
| Log LogMessage
|
||||||
|
|
||||||
@ -183,9 +193,6 @@ handleAction = case _ of
|
|||||||
H.tell _log unit (AppLog.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token")
|
H.tell _log unit (AppLog.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token")
|
||||||
|
|
||||||
AuthenticationComponentEvent ev -> case ev of
|
AuthenticationComponentEvent ev -> case ev of
|
||||||
AF.AuthToken (Tuple uid token) -> do
|
|
||||||
H.modify_ _ { uid = Just uid, token = Just token, current_page = DomainList }
|
|
||||||
handleAction AuthenticateToDNSManager
|
|
||||||
AF.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
AF.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||||
AF.Log message -> H.tell _log unit (AppLog.Log message)
|
AF.Log message -> H.tell _log unit (AppLog.Log message)
|
||||||
|
|
||||||
@ -215,10 +222,7 @@ handleAction = case _ of
|
|||||||
-- TODO: depending on the current page, we should provide the received message to different components.
|
-- TODO: depending on the current page, we should provide the received message to different components.
|
||||||
AuthenticationDaemonEvent ev -> case ev of
|
AuthenticationDaemonEvent ev -> case ev of
|
||||||
WS.MessageReceived (Tuple _ message) -> do
|
WS.MessageReceived (Tuple _ message) -> do
|
||||||
{ token } <- H.get
|
handleAction $ AuthDaemonRawMessageReceived message
|
||||||
case token of
|
|
||||||
Nothing -> H.tell _af unit (AF.MessageReceived message)
|
|
||||||
Just _ -> H.tell _aai unit (AAI.MessageReceived message)
|
|
||||||
WS.WSJustConnected -> do
|
WS.WSJustConnected -> do
|
||||||
H.tell _af unit AF.ConnectionIsUp
|
H.tell _af unit AF.ConnectionIsUp
|
||||||
H.tell _aai unit AAI.ConnectionIsUp
|
H.tell _aai unit AAI.ConnectionIsUp
|
||||||
@ -227,6 +231,96 @@ handleAction = case _ of
|
|||||||
H.tell _aai unit AAI.ConnectionIsDown
|
H.tell _aai unit AAI.ConnectionIsDown
|
||||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||||
|
|
||||||
|
AuthDaemonRawMessageReceived message -> do
|
||||||
|
receivedMessage <- H.liftEffect $ AuthD.deserialize message
|
||||||
|
case receivedMessage of
|
||||||
|
-- Cases where we didn't understand the message.
|
||||||
|
Left err -> do
|
||||||
|
-- handleAction $ Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err
|
||||||
|
case err of
|
||||||
|
(AuthD.JSONERROR jerr) -> do
|
||||||
|
-- print_json_string messageEvent.message
|
||||||
|
handleAction $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
|
||||||
|
(AuthD.UnknownError unerr) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownError" <> (show unerr))
|
||||||
|
(AuthD.UnknownNumber ) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownNumber")
|
||||||
|
-- Cases where we understood the message.
|
||||||
|
Right response -> do
|
||||||
|
case response of
|
||||||
|
(AuthD.GotUser _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUser message."
|
||||||
|
(AuthD.GotUserAdded _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserAdded message."
|
||||||
|
(AuthD.GotUserEdited _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserEdited message."
|
||||||
|
(AuthD.GotUserValidated _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserValidated message."
|
||||||
|
(AuthD.GotUsersList _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUsersList message."
|
||||||
|
(AuthD.GotPermissionCheck _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPermissionCheck message."
|
||||||
|
(AuthD.GotPermissionSet _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Received a GotPermissionSet message."
|
||||||
|
(AuthD.GotPasswordRecovered _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPasswordRecovered message."
|
||||||
|
(AuthD.GotMatchingUsers _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotMatchingUsers message."
|
||||||
|
(AuthD.GotUserDeleted _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Received a GotUserDeleted message."
|
||||||
|
(AuthD.GotErrorMustBeAuthenticated _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorMustBeAuthenticated message."
|
||||||
|
(AuthD.GotErrorAlreadyUsedLogin _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorAlreadyUsedLogin message."
|
||||||
|
(AuthD.GotErrorUserNotFound _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorUserNotFound message."
|
||||||
|
|
||||||
|
-- The authentication failed.
|
||||||
|
(AuthD.GotError errmsg) -> do
|
||||||
|
handleAction $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
|
||||||
|
(AuthD.GotPasswordRecoverySent _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog $ "[🎉] Password recovery: email sent!"
|
||||||
|
(AuthD.GotErrorPasswordTooShort _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Password too short!"
|
||||||
|
(AuthD.GotErrorMailRequired _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Email required!"
|
||||||
|
(AuthD.GotErrorInvalidCredentials _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Invalid credentials!"
|
||||||
|
(AuthD.GotErrorRegistrationsClosed _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Registration closed! Try another time or contact an administrator."
|
||||||
|
(AuthD.GotErrorInvalidLoginFormat _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Invalid login format!"
|
||||||
|
(AuthD.GotErrorInvalidEmailFormat _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Invalid email format!"
|
||||||
|
(AuthD.GotErrorAlreadyUsersInDB _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Login already taken!"
|
||||||
|
(AuthD.GotErrorReadOnlyProfileKeys _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Trying to add a profile with some invalid (read-only) keys!"
|
||||||
|
(AuthD.GotErrorInvalidActivationKey _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Invalid activation key!"
|
||||||
|
(AuthD.GotErrorUserAlreadyValidated _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] User already validated!"
|
||||||
|
(AuthD.GotErrorCannotContactUser _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] User cannot be contacted. Are you sure about your email address?"
|
||||||
|
(AuthD.GotErrorInvalidRenewKey _) -> do
|
||||||
|
handleAction $ Log $ SimpleLog "[😈] Invalid renew key!"
|
||||||
|
-- The authentication was a success!
|
||||||
|
(AuthD.GotToken msg) -> do
|
||||||
|
handleAction $ Log $ SimpleLog $ "[🎉] Authenticated to authd!"
|
||||||
|
H.modify_ _ { uid = Just msg.uid, token = Just msg.token, current_page = DomainList }
|
||||||
|
handleAction AuthenticateToDNSManager
|
||||||
|
pure unit
|
||||||
|
|
||||||
|
-- Send a received authentication daemon message to a component.
|
||||||
|
-- DispatchAuthDaemonMessage message -> do
|
||||||
|
-- { token } <- H.get
|
||||||
|
-- case token of
|
||||||
|
-- Nothing -> H.tell _af unit (AF.MessageReceived message)
|
||||||
|
-- Just _ -> H.tell _aai unit (AAI.MessageReceived message)
|
||||||
|
-- case current_page of
|
||||||
|
-- DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message)
|
||||||
|
-- Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message)
|
||||||
|
-- _ -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from authd")
|
||||||
|
-- pure unit
|
||||||
|
|
||||||
Disconnection -> do
|
Disconnection -> do
|
||||||
H.put $ initialState unit
|
H.put $ initialState unit
|
||||||
handleAction $ Routing Home
|
handleAction $ Routing Home
|
||||||
|
Loading…
Reference in New Issue
Block a user