{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-do-bind -Wno-redundant-constraints #-}

module Sis.Page.Login (page) where

import Data.Text (Text)
import Data.Text qualified as T
import Effectful
import Sis.Auth (generateToken, hashPassword, verifyPassword)
import Sis.Database
import Sis.Route
import Sis.Style
import Sis.Types
import Sis.View.Layout
import Web.Hyperbole
import Web.Hyperbole.Effect.Session
import Web.Hyperbole.HyperView.Forms
import Web.Hyperbole.Page

data LoginPage = LoginPage
    deriving stock (Generic)
    deriving anyclass (ViewId)
instance (DB :> es, IOE :> es) => HyperView LoginPage es where
    data Action LoginPage
        = SubmitLogin
        | Noop
        deriving stock (Generic)
        deriving anyclass (ViewAction)
    update SubmitLogin = do
        formData' <- formData @LoginForm
        mUser <- findUserByEmail (lfEmail formData')
        case mUser of
            Just u
                | verifyPassword (lfPassword formData') (userPasswordHash u) -> do
                    saveSession (UserSession (unUserId (userId u)))
                    pure (loginSuccessView)
            _ -> pure (loginView (Just "Invalid email or password"))
    update Noop = pure (loginView Nothing)

loginSuccessView :: View LoginPage ()
loginSuccessView = do
    el @ att "class" nbContainerClass @ att "style" "max-width:480px;margin:4rem auto;text-align:center" $ do
        el @ att "class" nbBoxClass @ att "style" "padding:2rem" $ do
            el @ att "class" nbFontHeading1Class $ text "Logged In!"
            el @ att "style" "margin-top:1rem;margin-bottom:1rem" $ text "You are now logged in."
            route RDashboard $ text "Go to Dashboard"

loginView :: Maybe Text -> View LoginPage ()
loginView mError = do
    el @ att "class" nbContainerClass @ att "style" "max-width:480px;margin:4rem auto" $ do
        el @ att "class" nbBoxClass @ att "style" "padding:2rem" $ do
            el @ att "class" nbFontHeading1Class $ text "Welcome Back"
            el @ att "style" "opacity:0.7;margin-bottom:1.5rem" $ text "Log in to manage your household chores."
            case mError of
                Just err ->
                    el @ att "class" nbBoxClass @ att "style" ("border-color:" <> colorRed <> ";color:" <> colorRed <> ";padding:0.5rem;margin-bottom:1rem") $ text err
                Nothing -> none
            form SubmitLogin $ do
                el @ att "class" nbLabelClass $ text "Email"
                tag "input" @ att "type" "email" . att "name" "lfEmail" . att "class" nbInputClass @ att "style" "width:100%" $ none
                el @ att "class" nbLabelClass $ text "Password"
                tag "input" @ att "type" "password" . att "name" "lfPassword" . att "class" nbInputClass @ att "style" "width:100%" $ none
                el @ att "style" "display:flex;align-items:center;gap:0.5rem;margin-bottom:1rem" $ do
                    tag "input" @ att "type" "checkbox" . att "name" "lfRemember" $ none
                    text "Remember me"
                submit (text "Log In") @ att "class" nbButtonClass @ att "style" "width:100%"
            route RSignup $ text "Don't have an account? Sign Up"
page :: (Hyperbole :> es, DB :> es, IOE :> es) => Page es '[LoginPage]
page = do
    mSession <- lookupSession @UserSession
    case mSession of
        Just _ -> do
            redirect (routeUri RDashboard)
        Nothing -> pure $ hyper LoginPage $ loginView Nothing