module App.AuthenticationForm where

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

import Control.Monad.Except (runExcept)
import Control.Monad.State (class MonadState)
import Data.Array as A
import Data.Tuple (Tuple(..))
import Data.Bifunctor (lmap)
-- import Data.Codec.Argonaut (JsonCodec, JsonDecodeError)
-- import Data.Argonaut.Core as J
-- import Data.Codec.Argonaut as CA
import Data.Const (Const)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
import Data.String as String
import Effect (Effect)
import Effect.Aff.Class (class MonadAff)
import Foreign (Foreign)
import Foreign as F
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Query.Event as HQE
import Halogen.Subscription as HS
import Web.Event.Event (Event)
import Web.Event.Event as Event
import Web.Socket.Event.CloseEvent as WSCE
import Web.Socket.Event.EventTypes as WSET
import Web.Socket.Event.MessageEvent as WSME
import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed))
import Web.Socket.WebSocket as WS

import Effect.Class (class MonadEffect)

import App.IPC as IPC

import App.Messages.AuthenticationDaemon as AuthD

import Data.ArrayBuffer.Types (ArrayBuffer)
import Web.Socket.BinaryType (BinaryType(ArrayBuffer))

--------------------------------------------------------------------------------
-- WebSocketEvent type
--------------------------------------------------------------------------------

data WebSocketEvent :: Type -> Type
data WebSocketEvent msg
  = WebSocketMessage { message :: msg, origin :: String, lastEventId :: String }
  | WebSocketOpen
  | WebSocketClose { code :: Int, reason :: String, wasClean :: Boolean }
  | WebSocketError ErrorType

webSocketEmitter :: WS.WebSocket -> HS.Emitter (WebSocketEvent WebSocketMessageType)
webSocketEmitter socket = do

  HS.makeEmitter \push -> do

    openId <- HS.subscribe openEmitter push
    errorId <- HS.subscribe errorEmitter push
    closeId <- HS.subscribe closeEmitter push
    messageId <- HS.subscribe messageEmitter push

    pure do
      HS.unsubscribe openId
      HS.unsubscribe errorId
      HS.unsubscribe closeId
      HS.unsubscribe messageId

  where
  target = WS.toEventTarget socket

  openEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  openEmitter =
    HQE.eventListener WSET.onOpen target \_ ->
      Just WebSocketOpen

  errorEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  errorEmitter =
    HQE.eventListener WSET.onError target \_ ->
      Just (WebSocketError UnknownWebSocketError)

  closeEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  closeEmitter =
    HQE.eventListener WSET.onClose target \event ->
      WSCE.fromEvent event >>= \closeEvent ->
        Just $ WebSocketClose  { code: WSCE.code closeEvent
                               , reason: WSCE.reason closeEvent
                               , wasClean: WSCE.wasClean closeEvent
                               }

  messageEmitter :: HS.Emitter (WebSocketEvent WebSocketMessageType)
  messageEmitter = HQE.eventListener WSET.onMessage target (WSME.fromEvent >=> decodeMessageEvent)

decodeMessageEvent :: WSME.MessageEvent -> Maybe (WebSocketEvent WebSocketMessageType)
decodeMessageEvent = \msgEvent -> do
  let
    foreign' :: Foreign
    foreign' = WSME.data_ msgEvent
  case foreignToArrayBuffer foreign' of
    Left errs -> pure $ WebSocketError $ UnknownError errs
    Right arrayBuffer -> pure $ WebSocketMessage { message: arrayBuffer, origin: WSME.origin msgEvent, lastEventId: WSME.lastEventId msgEvent }

---------------------------
-- Errors
---------------------------

data ErrorType
  = UnknownError String
  | UnknownWebSocketError

renderError :: ErrorType -> String
renderError = case _ of
  UnknownError str ->
    "Unknown error: " <> str
  UnknownWebSocketError ->
    "Unknown 'error' event has been fired by WebSocket event listener"

--------------------------------------------------------------------------------
-- WebSocket message type
--------------------------------------------------------------------------------

type WebSocketMessageType = ArrayBuffer

--------------------------------------------------------------------------------
-- Root component module
--------------------------------------------------------------------------------

data Output = AuthToken String
type Slot = H.Slot Query Output

type Query :: forall k. k -> Type
type Query = Const Void
type Input = String

data Action
  = Initialize
  | WebSocketParseError String
  | ConnectWebSocket
  | HandleLoginInputUpdate String
  | HandlePassInputUpdate String
  | AuthenticationAttempt Event
  | HandleWebSocket (WebSocketEvent WebSocketMessageType)

type State =
  { messages             :: Array String
  , messageHistoryLength :: Int
  , loginInputText       :: String
  , passInputText        :: String
  , wsUrl                :: String
  , wsConnection         :: Maybe WS.WebSocket
  , canReconnect         :: 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
        }
    }

initialState :: Input -> State
initialState input =
  { messages: []
  , messageHistoryLength: 10
  , loginInputText: ""
  , passInputText: ""
  , wsUrl: input
  , wsConnection: Nothing
  , canReconnect: false
  }

wrapperStyle :: String
wrapperStyle =
  """
  display: block;
  flex-direction: column;
  justify-content: space-between;
  height: calc(100vh - 30px);
  background: #282c34;
  color: #e06c75;
  font-family: 'Consolas';
  padding: 5px 20px 5px 20px;
  """

render :: forall m. State -> H.ComponentHTML Action () m
render { messages, loginInputText, passInputText, wsConnection, canReconnect, messageHistoryLength } =
  HH.div
  [ HP.style wrapperStyle ]
  [ HH.h2_ [ HH.text "Authentication!" ]
  , HH.form
      [ HE.onSubmit AuthenticationAttempt ]
      [ HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
      , HH.p_
          [ HH.div_
              [ HH.input
                [ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
                , HP.type_ HP.InputText
                , HP.value loginInputText
                , HE.onValueInput HandleLoginInputUpdate
                , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
                ]
              ]
          , HH.div_
              [ HH.input
                [ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
                , HP.type_ HP.InputText
                , HP.value passInputText
                , HE.onValueInput HandlePassInputUpdate
                , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
                ]
              ]
          , HH.div_
              [ HH.button
                  [ HP.style "padding: 0.5rem 1.25rem;"
                  , HP.type_ HP.ButtonSubmit
                  , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
                  ]
                  [ HH.text "Send Message to Server" ]
              ]
          ]
      , renderMaxHistoryLength messageHistoryLength
      , renderReconnectButton (isNothing wsConnection && canReconnect)
      ]
  ]
  where
  renderFootnote :: String -> H.ComponentHTML Action () m
  renderFootnote txt =
    HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]

  renderMaxHistoryLength :: Int -> H.ComponentHTML Action () m
  renderMaxHistoryLength len =
    renderFootnote ("NOTE: Maximum chat history length is " <> show len <> " messages")

  renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
  renderReconnectButton cond =
    if cond
    then
      HH.p_
        [ HH.button
          [ HP.type_ HP.ButtonButton
          , HE.onClick \_ -> ConnectWebSocket
          ]
          [ HH.text "Reconnect?" ]
        ]
    else
      HH.p_
        [ renderFootnote "NOTE: A 'Reconnect?' button will appear if the connection drops"
        , renderFootnote "NOTE: You can type /disconnect to manually disconnect"
        ]

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
  Initialize ->
    handleAction ConnectWebSocket

  WebSocketParseError error ->
    systemMessage $ renderError (UnknownError error)

  ConnectWebSocket -> do
    { wsUrl } <- H.get
    systemMessage ("Connecting to \"" <> wsUrl <>  "\"...")
    webSocket <- H.liftEffect $ WS.create wsUrl []
    H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
    H.modify_ _ { wsConnection = Just webSocket }
    void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)

  HandleLoginInputUpdate text -> do
    H.modify_ _ { loginInputText = text }

  HandlePassInputUpdate text -> do
    H.modify_ _ { passInputText = text }

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

    { wsConnection, loginInputText, passInputText } <- H.get

    case wsConnection, loginInputText, passInputText of
      Nothing, _, _ ->
        unableToSend "Not connected to server."

      Just _ , "" , _ ->
        unableToSend "Write your login!"

      Just _ , _ , "" ->
        unableToSend "Write your password!"

      Just webSocket, login, pass -> do
        H.liftEffect (WS.readyState webSocket) >>= case _ of
          Connecting ->
            unableToSend "Still connecting to server."

          Closing ->
            unableToSend "Connection to server is closing."

          Closed -> do
            unableToSend "Connection to server has been closed."
            maybeCurrentConnection <- H.gets _.wsConnection
            when (isJust maybeCurrentConnection) do
              H.modify_ _ { wsConnection = Nothing, canReconnect = true }

          Open -> do
            H.liftEffect $ do
              ab <- AuthD.serialize (AuthD.MkGetToken { login: login, password: pass })
              sendArrayBuffer webSocket ab
            appendMessageReset $ "[😇] Trying to connect with login: " <> login

  HandleWebSocket wsEvent ->
    case wsEvent of
      WebSocketMessage messageEvent -> do
        receivedMessage <- H.liftEffect $ AuthD.deserialize messageEvent.message
        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
                  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 _) -> do
                  appendMessage $ "[😈] Failed! (TODO: put the reason)"
                -- The authentication was a success!
                (AuthD.GotToken msg) -> 
                  appendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token
                -- WTH?!
                _ -> do
                  appendMessage $ "[😈] Failed! Don't understand the answer received!"

      WebSocketOpen -> do
        { wsUrl } <- H.get
        systemMessage ("Successfully connected to WebSocket at \"" <> wsUrl <>  "\"!🎉")

      WebSocketClose { code, reason, wasClean } -> do
        systemMessage $ renderCloseMessage code wasClean reason
        maybeCurrentConnection <- H.gets _.wsConnection
        when (isJust maybeCurrentConnection) do
          H.modify_ _ { wsConnection = Nothing, canReconnect = true }

      WebSocketError errorType ->
        systemMessage $ renderError errorType

  where
  renderCloseMessage
    :: Int
    -> Boolean
    -> String
    -> String
  renderCloseMessage code wasClean = case _ of
      ""     -> baseCloseMessage
      reason -> baseCloseMessage <> "Reason: " <> reason
    where
    baseCloseMessage :: String
    baseCloseMessage =
      String.joinWith " "
        [ "Connection to WebSocket closed"
        , "[ CODE:"
        , show code
        , "|"
        , if wasClean then "CLEAN" else "DIRTY"
        , "]"
        ]

  sendArrayBuffer :: WS.WebSocket -> ArrayBuffer -> Effect Unit
  sendArrayBuffer = WS.sendArrayBuffer

--------------------------------------------------------------------------------
-- Helpers for updating the array of messages sent/received
--------------------------------------------------------------------------------
-- Append a new message to the chat history, with a boolean that allows you to
-- clear the text input field or not. The number of displayed `messages` in the
-- chat history (including system) is controlled by the `messageHistoryLength`
-- field in the component `State`.
appendMessageGeneric :: forall m. MonadState State m => Boolean -> String -> m Unit
appendMessageGeneric clearField msg = do
  histSize <- H.gets _.messageHistoryLength
  if clearField
    then H.modify_ \st ->
           st { messages = appendSingle histSize msg st.messages, loginInputText = "" }
    else H.modify_ \st ->
           st { messages = appendSingle histSize msg st.messages }
  where
  -- Limits the nnumber of recent messages to `maxHist`
  appendSingle :: Int -> String -> Array String -> Array String
  appendSingle maxHist x xs
    | A.length xs < maxHist = xs `A.snoc` x
    | otherwise             = (A.takeEnd (maxHist-1) xs) `A.snoc` x

-- Append a new message to the chat history, while not clearing
-- the user input field
appendMessage :: forall m. MonadState State m => String -> m Unit
appendMessage = appendMessageGeneric false

-- Append a new message to the chat history and also clear
-- the user input field
appendMessageReset :: forall m. MonadState State m => String -> m Unit
appendMessageReset = appendMessageGeneric true

-- Append a system message to the chat log.
systemMessage :: forall m. MonadState State m => String -> m Unit
systemMessage msg = appendMessage ("[🤖] System: " <> msg)

-- As above, but also clears the user input field. e.g. in
-- the case of a "/disconnect" command
systemMessageReset :: forall m. MonadState State m => String -> m Unit
systemMessageReset msg = appendMessageReset ("[🤖] System: " <> msg)

-- A system message to use when a message cannot be sent.
unableToSend :: forall m. MonadState State m => String -> m Unit
unableToSend reason = systemMessage ("Unable to send. " <> reason)

foreignToArrayBuffer :: Foreign -> Either String ArrayBuffer
foreignToArrayBuffer
  = lmap renderForeignErrors
  <<< runExcept
  <<< F.unsafeReadTagged "ArrayBuffer"
  where
  renderForeignErrors :: F.MultipleErrors -> String
  renderForeignErrors =
    String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError

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