Put all decoding message code in Container instead of AuthenticationForm.

This commit is contained in:
Philippe Pittoli 2023-10-01 01:39:37 +02:00
parent 7178b29ae1
commit 6829b6445b
2 changed files with 111 additions and 87 deletions

View File

@ -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,73 +260,12 @@ 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
-- Cases where we didn't understand the message.
Left err -> do
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 _ -> do
H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message." H.raise $ Log $ SimpleLog $ "[😈] Message not handled in AuthenticationForm."
pure Nothing pure Nothing
ConnectionIsDown a -> do ConnectionIsDown a -> do
@ -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

View File

@ -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