{-# LANGUAGE OverloadedRecordDot #-}

module Prod.UserAuth (
    UserAuthApi,
    handleUserAuth,
    initRuntime,
    Runtime,
    --
    withLoginCookieVerified,
    withOptionalLoginCookieVerified,
    --
    CookieProtect,
    UserAuthInfo (..),
    authUserId,
    Request,
    authServerContext,
    --
    authorized,
    limited,
    --
    renderStatus,
    --
    Track (..),
    BehaviourTrack (..),
    BackendTrack (..),
    JwtTrack (..),
    CallbackTrack (..),
)
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson (Value (Number))
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import Prod.Status (RenderStatus)
import Prod.UserAuth.Api (CookieProtect, UserAuthApi)
import Prod.UserAuth.Backend
import Prod.UserAuth.Base
import Prod.UserAuth.HandlerCombinators
import Prod.UserAuth.JWT
import Prod.UserAuth.Runtime (Counters (..), Runtime, counters, initRuntime, secretstring, tokenValidityDuration, traceAttempt, traceAugmentCookie, traceRecoveryApplication, traceRecoveryRequest, traceRegistration, withConn)
import Prod.UserAuth.Trace
import qualified Prometheus as Prometheus
import Servant
import Servant.Server

import Lucid

handleUserAuth :: Runtime info -> Server (UserAuthApi info)
handleUserAuth runtime =
    handleEchoCookieClaims runtime
        :<|> handleWhoAmI runtime
        :<|> handleCleanCookie
        :<|> handleRegister runtime
        :<|> handleLogin runtime
        :<|> handleRecoveryRequest runtime
        :<|> handleApplyRecovery runtime
        :<|> handleHello

handleEchoCookieClaims :: Runtime info -> Maybe LoggedInCookie -> Handler JWTClaimsSet
handleEchoCookieClaims runtime cookie = do
    inc echoes "requested" (counters runtime)
    withLoginCookieVerified runtime cookie (pure . claims)

handleWhoAmI :: Runtime info -> Maybe LoggedInCookie -> Handler [WhoAmI info]
handleWhoAmI runtime cookie = do
    inc whoamis "requested" (counters runtime)
    withLoginCookieVerified runtime cookie $ \jwt -> do
        let muid = Map.lookup "user-id" (unClaimsMap . unregisteredClaims $ claims jwt)
        case muid of
            Just (Number nid) -> do
                inc whoamis "success" (counters runtime)
                let uid = truncate nid :: UserId
                liftIO $ whoAmIQueryIO runtime uid
            _ -> do
                inc whoamis "token-corrupted" (counters runtime)
                throwError $ err400{errBody = "this cookie is wrong"}

handleHello :: UserAuthInfo -> Handler Text
handleHello (UserAuthInfo jwt) = do
    pure "hello world"

handleCleanCookie ::
    Handler (Headers '[Header "Set-Cookie" LoggedInCookie] ())
handleCleanCookie =
    pure $
        addHeader (LoggedInCookie "logged-off") ()

handleRegister ::
    Runtime info ->
    RegistrationRequest ->
    Handler (Headers '[Header "Set-Cookie" LoggedInCookie] (RegistrationResult info))
handleRegister runtime req = do
    inc registrations "requested" (counters runtime)
    res <- liftIO $ registerIO runtime req
    traceRegistration runtime req res
    withheaders <- liftIO $ wrapHeader res
    inc registrations "ok" (counters runtime)
    pure $ withheaders res
  where
    wrapHeader :: RegistrationResult info -> IO (a -> Headers '[Header "Set-Cookie" LoggedInCookie] a)
    wrapHeader res = case res of
        RegisterFailure -> pure noHeader
        RegisterSuccess dat -> do
            cookie <- makeLoggedInCookie runtime (userId dat)
            traceAugmentCookie runtime cookie
            case cookie of
                Left _ -> pure noHeader
                Right c -> pure $ addHeader c

handleLogin ::
    Runtime info ->
    LoginAttempt ->
    Handler (Headers '[Header "Set-Cookie" LoggedInCookie] (LoginResult info))
handleLogin runtime attempt = do
    inc logins "requested" (counters runtime)
    res <- liftIO $ loginIO runtime attempt
    traceAttempt runtime attempt res
    withheaders <- liftIO $ wrapHeader res
    pure $ withheaders res
  where
    wrapHeader :: LoginResult info -> IO (a -> Headers '[Header "Set-Cookie" LoggedInCookie] a)
    wrapHeader res = case res of
        LoginFailed -> do
            inc logins "ko" (counters runtime)
            pure noHeader
        LoginSuccess dat -> do
            inc logins "ok" (counters runtime)
            cookie <- makeLoggedInCookie runtime (userId dat)
            traceAugmentCookie runtime cookie
            case cookie of
                Left _ -> pure noHeader
                Right c -> pure $ addHeader c

handleRecoveryRequest :: Runtime info -> RecoveryRequest -> Handler RecoveryRequestNotification
handleRecoveryRequest runtime req = do
    inc recoveryRequests "requested" (counters runtime)
    xs <- liftIO $ recoveryRequestIO runtime req
    let token = case xs of [] -> ""; (x : _) -> tokenValue x :: Text
    inc recoveryRequests "ok" (counters runtime)
    let res = RecoveryRequestNotification (req.email) tokenValidityDuration token
    traceRecoveryRequest runtime req res
    pure res

handleApplyRecovery :: Runtime info -> ApplyRecoveryRequest -> Handler RecoveryResult
handleApplyRecovery runtime req = do
    inc recoveryApplied "requested" (counters runtime)
    res <- liftIO $ applyRecoveryIO runtime req
    traceRecoveryApplication runtime req res
    case res of
        RecoverySuccess -> pure res <* inc recoveryApplied "ok" (counters runtime)
        _ -> throwError err403

inc ::
    (MonadIO m) =>
    (a -> Prometheus.Vector (Text) Prometheus.Counter) ->
    Text ->
    a ->
    m ()
inc f s cnts =
    liftIO $ Prometheus.withLabel (f cnts) s Prometheus.incCounter

renderStatus :: RenderStatus a
renderStatus = const $ section_ $ do
    h1_ "user-auth"
    h4_ "login"
    p_ $ with form_ [id_ "login-form", action_ "/user-auth/login", method_ "post"] $ do
        p_ $ do
            label_ [for_ "login-email", type_ "text"] "email"
            input_ [type_ "text", id_ "login-email", name_ "email"]
        p_ $ do
            label_ [for_ "login-plain", type_ "text"] "password"
            input_ [type_ "password", id_ "login-plain", name_ "plain"]
        p_ $ do
            input_ [type_ "submit", value_ "login"]
    h4_ "register"
    p_ $ with form_ [id_ "register-form", action_ "/user-auth/registration", method_ "post"] $ do
        p_ $ do
            label_ [for_ "register-email", type_ "text"] "email"
            input_ [type_ "text", id_ "register-email", name_ "email"]
        p_ $ do
            label_ [for_ "register-plain", type_ "text"] "password"
            input_ [type_ "password", id_ "register-plain", name_ "plain"]
        p_ $ do
            input_ [type_ "submit", value_ "register"]
    h4_ "recovery-request"
    p_ $ with form_ [id_ "recovery-request-form", action_ "/user-auth/recovery/request", method_ "post"] $ do
        p_ $ do
            label_ [for_ "recovery-request-email", type_ "text"] "email"
            input_ [type_ "text", id_ "recovery-request-email", name_ "email"]
        p_ $ do
            input_ [type_ "submit", value_ "recover"]
    h4_ "recovery-apply"
    p_ $ with form_ [id_ "recovery-apply-form", action_ "/user-auth/recovery/apply", method_ "post"] $ do
        p_ $ do
            label_ [for_ "recovery-apply-email", type_ "text"] "email"
            input_ [type_ "text", id_ "recovery-apply-email", name_ "email"]
        p_ $ do
            label_ [for_ "recovery-apply-plain", type_ "text"] "new-password"
            input_ [type_ "password", id_ "recovery-apply-plain", name_ "plain"]
        p_ $ do
            label_ [for_ "recovery-apply-token", type_ "text"] "token"
            input_ [type_ "password", id_ "recovery-apply-token", name_ "token"]
        p_ $ do
            input_ [type_ "submit", value_ "recover"]
    h4_ "misc"
    p_ $ with a_ [href_ "/user-auth/whoami"] "whoami"
    p_ $ with a_ [href_ "/user-auth/echo-cookie"] "echo-cookie"
    p_ $
        with form_ [action_ "/user-auth/clean-cookie", method_ "post"] $
            input_ [type_ "submit", value_ "clear cookie"]