-- | `App.Page.Migration` is the interface for migrated users before they validate their email address. -- | To complete their migration, they need to provide an email address that will be validated with a token. -- | This token will be required before the user can do anything else on the website. -- | -- | Exchanges between the webapp and authd: -- | -- | ``` -- | User gives a valid email address -> authd -- | (authd accepts the email address and sends an email) -- | -- | authd -> email pending -- | (we switch tab to "mail validation tab") -- | -- | User gives the received token -> authd -- | (authd accepts the token and validates the email address) -- | -- | authd -> EmailChanged -- | (webapp switches to domain list) -- | ``` module App.Page.Migration where import Prelude (Unit, between, bind, discard, map, pure, ($), (<>)) import Data.Array as A import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.String as S import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Web.Event.Event as Event import Web.Event.Event (Event) -- import Data.Generic.Rep (class Generic) -- import Data.Show.Generic (genericShow) import Bulma as Bulma import Scroll (scrollToTop) import App.Type.LogMessage import App.Message.AuthenticationDaemon as AuthD import App.DisplayErrors (show_error_email) import App.Validation.Email as E data Output = MessageToSend ArrayBuffer | Log LogMessage -- | Once the new email address has been accepted by `authd` as "pending", -- | this page automatically switches to a second tab. data Query a = WaitingForToken a type Slot = H.Slot Query Output type Input = Unit -- | Both value types to validate before sending the appropriate messages to `authd`. data Subject = EmailAddress | Token --derive instance eqSubject :: Eq Subject --derive instance genericSubject :: Generic Subject _ --instance showSubject :: Show Subject where -- show = genericShow data Action -- | Copy user input in the different HTML inputs. = UserInput Subject String -- | Verify either the format of the new email address or the token then send the request. | Verify Subject Event -- | Send either the new email address or the token to `authd`. | ContactAuthd Subject -- | Change the current tab. -- | ChangeTab Subject -- | The possible errors from the email format. -- | TODO: check the token. data Error = Email (Array E.Error) -- | State is composed of the new email address, the token and the possible errors. type State = { email :: String , token :: String , errors :: Array Error -- , current_tab :: Subject } initialState :: Input -> State initialState _ = { email: "" , token: "" , errors: [] -- , current_tab: EmailAddress } component :: forall m. MonadAff m => H.Component Query Input Output m component = H.mkComponent { initialState , render , eval: H.mkEval $ H.defaultEval { handleAction = handleAction , handleQuery = handleQuery } } handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of -- TODO WaitingForToken a -> pure (Just a) render :: forall m. State -> H.ComponentHTML Action () m render state = Bulma.section_small [Bulma.columns_ [ b email_form , b token_form ]] where b e = Bulma.column_ [ Bulma.box e ] email_form = [ Bulma.h3 "New Email address" -- TODO: put some text here , HH.form [ HE.onSubmit (Verify EmailAddress) ] [ email_input, email_error, Bulma.btn_validation ] ] email_input = Bulma.email_input "Email" state.email (UserInput EmailAddress) email_error = case between 0 5 (S.length state.email), E.email state.email of true, _ -> HH.text "" _, Left errors -> Bulma.error_box "newAddress" "Email error" (show_error $ Email errors) _, Right _ -> HH.text "" token_form = [ Bulma.h3 "Email validation token" -- TODO: put some text here , HH.form [ HE.onSubmit (Verify Token) ] [ token_input {-, token_error -}, Bulma.btn_validation ] ] token_input = Bulma.token_input "Token" state.token (UserInput Token) handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction = case _ of UserInput subject value -> do case subject of EmailAddress -> H.modify_ _ { email = value } Token -> H.modify_ _ { token = value } -- Validate either the email address or the token then send the related requests to `authd`. Verify subject ev -> do H.liftEffect $ Event.preventDefault ev state <- H.get case subject of EmailAddress -> do case state.email of "" -> do H.raise $ Log $ UnableToSend "Please, write your new email address." H.liftEffect scrollToTop _ -> do case E.email state.email of Left errors -> H.raise $ Log $ UnableToSend $ show_error $ Email errors Right _ -> handleAction $ ContactAuthd EmailAddress Token -> do case state.token of "" -> do H.raise $ Log $ UnableToSend "Please, write your validation token." H.liftEffect scrollToTop _ -> handleAction $ ContactAuthd Token ContactAuthd subject -> do state <- H.get case subject of EmailAddress -> do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddress { email: state.email } H.raise $ MessageToSend message H.raise $ Log $ SystemLog $ "Sending a new email address." Token -> do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddressToken { token: state.token } H.raise $ MessageToSend message H.raise $ Log $ SystemLog $ "Sending a validation token." show_error :: Error -> String show_error = case _ of Email arr -> "Error with the Email: " <> (A.fold $ map show_error_email arr)