halogen-websocket-ipc-playzone/src/App/AuthenticationForm.purs

module App.AuthenticationForm where

import Prelude (Unit, Void, bind, discard, map, show, void, when, ($), (&&), (<$>), (<<<), (<>), (>>=), pure, unit)

import Bulma as Bulma

import Control.Monad.State (class MonadState)
import Data.Tuple (Tuple(..))
import Data.Const (Const)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
import Data.String as String
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Web.Event.Event (Event)
import Web.Event.Event as Event

import Effect.Class (class MonadEffect)

import App.IPC as IPC
import App.Email as Email

import App.Messages.AuthenticationDaemon as AuthD

import Data.ArrayBuffer.Types (ArrayBuffer)

data Output
  = AuthToken (Tuple Int String)
  | MessageToSend ArrayBuffer
  | AppendMessage String
  | SystemMessage String
  | UnableToSend String

data Query a = MessageReceived ArrayBuffer a

type Slot = H.Slot Query Output

type Input = Unit

data AuthenticationInput
  = AUTH_INP_login String
  | AUTH_INP_pass String

data RegisterInput
  = REG_INP_login String
  | REG_INP_email String
  | REG_INP_pass String

data Action
  = Initialize
  -- | WebSocketParseError String
  -- | ConnectWebSocket

  | HandleAuthenticationInput AuthenticationInput
  | HandleRegisterInput       RegisterInput

  | AuthenticationAttempt Event
  | RegisterAttempt Event
  | Finalize
  --| HandleWebSocket (WebSocketEvent WebSocketMessageType)

type StateAuthenticationForm = { login :: String, pass :: String }
type StateRegistrationForm = { login :: String, email :: String, pass :: String }

type State =
  { authenticationForm     :: StateAuthenticationForm
  , registrationForm       :: StateRegistrationForm

  , wsUp                   :: Boolean
  }

component :: forall m. MonadAff m => H.Component Query Input Output m
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval
        { initialize = Just Initialize
        , handleAction = handleAction
        , handleQuery  = handleQuery
        , finalize = Just Finalize
        }
    }

initialState :: Input -> State
initialState _ =
  { authenticationForm: { login:     "", pass:  "" }
  , registrationForm:   { login:     "", email: "", pass: "" }

  , wsUp: true
  }

render :: forall m. State -> H.ComponentHTML Action () m
render { wsUp,
  authenticationForm,
  registrationForm }
    = HH.div_
       [ Bulma.columns_ [ Bulma.column_ auth_form, Bulma.column_ register_form ]
       ]
    where

      auth_form
        = [ Bulma.h3 "Authentication"
          , render_auth_form
          ]

      register_form
        = [ Bulma.h3 "Register!"
          , render_register_form
          ]

      should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))

      render_auth_form = HH.form
        [ HE.onSubmit AuthenticationAttempt ]
        [ Bulma.box_input "Login" "login"                    -- title, placeholder
            (HandleAuthenticationInput <<< AUTH_INP_login)   -- action
            authenticationForm.login                         -- value
            true                                             -- validity (TODO)
            should_be_disabled                               -- condition
        , Bulma.box_password "Password" "password"           -- title, placeholder
            (HandleAuthenticationInput <<< AUTH_INP_pass)    -- action
            authenticationForm.pass                          -- value
            true                                             -- validity (TODO)
            should_be_disabled                               -- condition
        , HH.button
           [ HP.style "padding: 0.5rem 1.25rem;"
           , HP.type_ HP.ButtonSubmit
           , (if wsUp then (HP.enabled true) else (HP.disabled true))
           ]
           [ HH.text "Send Message to Server" ]
        ]

      render_register_form = HH.form
        [ HE.onSubmit RegisterAttempt ]
        [ Bulma.box_input "Login" "login"                -- title, placeholder
            (HandleRegisterInput <<< REG_INP_login)      -- action
            registrationForm.login                       -- value
            true                                         -- validity (TODO)
            should_be_disabled                           -- condition
        , Bulma.box_input "Email" "email@example.com"    -- title, placeholder
            (HandleRegisterInput <<< REG_INP_email)      -- action
            registrationForm.email                       -- value
            true                                         -- validity (TODO)
            should_be_disabled                           -- condition
        , Bulma.box_password "Password" "password"       -- title, placeholder
            (HandleRegisterInput <<< REG_INP_pass)       -- action
            registrationForm.pass                        -- value
            true                                         -- validity (TODO)
            should_be_disabled                           -- condition
        , HH.div_
            [ HH.button
                [ HP.style "padding: 0.5rem 1.25rem;"
                , HP.type_ HP.ButtonSubmit
                , (if wsUp then (HP.enabled true) else (HP.disabled true))
                ]
                [ HH.text "Send Message to Server" ]
            ]
        ]

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
  Initialize ->
    H.raise $ SystemMessage "Authentication form initialized."

  Finalize ->
    H.raise $ SystemMessage "Removing the authentication form."

  HandleAuthenticationInput authinp -> do
    case authinp of
      AUTH_INP_login v -> H.modify_ _ { authenticationForm { login = v } }
      AUTH_INP_pass  v -> H.modify_ _ { authenticationForm { pass  = v } }

  HandleRegisterInput reginp -> do
    case reginp of
      REG_INP_login v -> H.modify_ _ { registrationForm { login = v } }
      REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
      REG_INP_pass  v -> H.modify_ _ { registrationForm { pass  = v } }

  RegisterAttempt ev -> do
    H.liftEffect $ Event.preventDefault ev

    { registrationForm } <- H.get
    let login = registrationForm.login
        email = registrationForm.email
        pass  = registrationForm.pass

    case login, email, pass of
      "", _, _ ->
        H.raise $ UnableToSend "Write your login!"

      _, "", _ ->
        H.raise $ UnableToSend "Write your email!"

      _, _, "" ->
        H.raise $ UnableToSend "Write your password!"

      _, _, _ -> do
        message <- H.liftEffect $ AuthD.serialize $
          AuthD.MkRegister { login: login
                           , email: Just (Email.Email email)
                           , password: pass }
        H.raise $ MessageToSend message
        H.raise $ AppendMessage "[😇] Trying to register"

  AuthenticationAttempt ev -> do
    H.liftEffect $ Event.preventDefault ev

    { authenticationForm } <- H.get

    case authenticationForm.login, authenticationForm.pass of
      "" , _ ->
        H.raise $ UnableToSend "Write your login!"

      _ , "" ->
        H.raise $ UnableToSend "Write your password!"

      login, pass -> do
        message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass }
        H.raise $ MessageToSend message
        H.raise $ AppendMessage $ "[😇] Trying to connect with login: " <> login


handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of
  MessageReceived message a -> do
    receivedMessage <- H.liftEffect $ AuthD.deserialize message
    case receivedMessage of
        -- Cases where we didn't understand the message.
        Left _ -> pure Nothing
          --case err of
          --  (AuthD.JSONERROR jerr) -> do
          --    print_json_string messageEvent.message
          --    handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr <> " JSON is: " <> jerr)
          --  (AuthD.UnknownError   unerr) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownError" <> (show unerr))
          --  (AuthD.UnknownNumber       ) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownNumber")

        -- Cases where we understood the message.
        Right response -> do
          case response of
            -- The authentication failed.
            (AuthD.GotError errmsg) -> do
              H.raise $ AppendMessage $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
              pure (Just a)
            -- The authentication was a success!
            (AuthD.GotToken msg) -> do
              H.raise $ AppendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token
              H.raise $ AuthToken (Tuple msg.uid msg.token)
              pure (Just a)
            -- WTH?!
            _ -> do
              H.raise $ AppendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
              pure Nothing

--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 $ AppendMessage $ case (value) of
    Left _ -> "Cannot even fromTypedIPC the message."
    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string