{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Datarekisteri.Backend.Sql.Queries where

import Control.Monad (void)
import Control.Monad.Logger (LoggingT)
import Data.Aeson (fromJSON, toJSON, Result(..))
import Data.Maybe (listToMaybe)
import Data.Text (Text)

import qualified Database.Persist as Persist

import Database.Esqueleto.Experimental

import Datarekisteri.Backend.Types (MemberData(..))

import Datarekisteri.Backend.Sql.Types
import Datarekisteri.Core.Types

type SqlM a = SqlPersistT (LoggingT IO) a

getUserByEmail :: Email -> SqlM (Maybe (Entity SqlUser))
getUserByEmail email = fmap listToMaybe $ select $ do
    (dbUser :& dbEmail) <- from $ table @SqlUser `crossJoin` table @SqlEmail
    where_ $ dbEmail ^. SqlEmailEmail ==. val email &&. dbUser ^. SqlUserId ==. dbEmail ^. SqlEmailUid
    -- There is only one row in SqlEmail with a given email (unique constraint) and a SqlEmail only
    -- has one user id and there is only row in SqlUser with a given user id (primary key). Thus
    -- there is at most one combination of rows from SqlEmail and SqlUser that satisfy this query.
    pure dbUser

addUser :: SqlUser -> SqlM UserID
addUser = fmap toID . insert

getUser :: UserID -> SqlM (Maybe SqlUser)
getUser = get . fromID

getKeys :: UserID -> SqlM [Entity SqlKey]
getKeys user = select $ do
    keys <- from $ table @SqlKey
    where_ $ keys ^. SqlKeyUid ==. val (fromID user)
    pure $ keys

getKey :: KeyID -> SqlM (Maybe SqlKey)
getKey = get . fromID

getPermissions :: UserID -> SqlM (Maybe Permissions)
getPermissions user = fmap (fmap sqlUserPermissions) $ get $ fromID user

setPermissions :: UserID -> Permissions -> SqlM ()
setPermissions user permissions = void $ updateUserData user [SqlUserPermissions Persist.=. permissions] []

getPrimaryKey :: UserID -> SqlM (Maybe (Entity SqlKey))
getPrimaryKey user = fmap listToMaybe $ select $ do
    keys <- from $ table @SqlKey
    where_ $ keys ^. SqlKeyIsPrimaryEncryptionKey &&. keys ^. SqlKeyUid ==. val (fromID user)
    pure $ keys

getUserTokens :: UserID -> SqlM [Entity SqlToken]
getUserTokens user = select $ do 
    tokens <- from $ table @SqlToken
    where_ $ tokens ^. SqlTokenUid ==. val (fromID user)
    pure $ tokens

addToken :: SqlToken -> SqlM TokenID
addToken = fmap toID . insert

getToken :: TokenID -> SqlM (Maybe SqlToken)
getToken = get . fromID

getTokenBySecret :: Text -> SqlM (Maybe (Entity SqlToken))
getTokenBySecret = getBy . UniqueData

addKey :: SqlKey -> SqlM KeyID
addKey = fmap toID . insert

getAllUsers :: SqlM [Entity SqlUser]
getAllUsers = select $ do
    users <- from $ table @SqlUser
    where_ $ isMember users
    pure $ users

getApplicants :: SqlM [Entity SqlUser]
getApplicants = select $ do
    users <- from $ table @SqlUser
    where_ $ isApplicant users
    pure $ users

isVerified :: SqlExpr (Entity SqlEmail) -> SqlExpr (Value Bool)
isVerified email = isNothing $ email ^. SqlEmailVid

hasVerifiedEmail :: SqlExpr (Value SqlUserId) -> SqlExpr (Value Bool)
hasVerifiedEmail userId = not_ $ isNothing $ subSelect $ do
    emails <- from $ table @SqlEmail
    where_ $ emails ^. SqlEmailUid ==. userId &&. isVerified emails
    pure $ val True -- This is not used anywhere, there just isn't a PersistField instance for ()

isApplicant :: SqlExpr (Entity SqlUser) -> SqlExpr (Value Bool)
isApplicant user = isNothing (user ^. SqlUserAccepted)
    &&. hasVerifiedEmail (user ^. SqlUserId)

isMember :: SqlExpr (Entity SqlUser) -> SqlExpr (Value Bool)
isMember user = not_ $ isApplicant user

verifyEmailSecret :: Text -> SqlM Bool
verifyEmailSecret secret = do
    pendingEmail <- selectOne $ do
        email <- from $ table @SqlEmail
        where_ $ (>. val (0 :: Int)) $ subSelectCount $ do
            verification <- from $ table @SqlEmailVerification
            where_ $ email ^. SqlEmailVid ==. just (verification ^. SqlEmailVerificationId)
                &&. verification ^. SqlEmailVerificationSecret ==. val secret
        pure email
    case pendingEmail of
      Nothing -> pure False
      Just (Entity _ SqlEmail {..}) -> do
          delete $ do
              email <- from $ table @SqlEmail
              where_ $ val sqlEmailUid ==. email ^. SqlEmailUid &&. isVerified email
          update $ \email -> do
              set email [SqlEmailVid =. val Nothing]
              where_ $ (>. val (0 :: Int)) $ subSelectCount $ do
                  verification <- from $ table @SqlEmailVerification
                  where_ $ email ^. SqlEmailVid ==. just (verification ^. SqlEmailVerificationId)
                      &&. verification ^. SqlEmailVerificationSecret ==. val secret
          fmap (> 0) $ deleteCount $ do
              verification <- from (table @SqlEmailVerification)
              where_ $ verification ^. SqlEmailVerificationSecret ==. val secret

getUserEmail' :: UserID -> Bool -> SqlM (Maybe (Entity SqlEmail))
getUserEmail' user verified = fmap listToMaybe $ select $ do
    email <- from $ table @SqlEmail
    where_ $ email ^. SqlEmailUid ==. val (fromID user)
        &&. isNothing (email ^. SqlEmailVid) ==. val verified
    pure email

getUserEmail :: UserID -> SqlM (Maybe (Entity SqlEmail))
getUserEmail user = getUserEmail' user True

getUserPendingEmail :: UserID -> SqlM (Maybe (Entity SqlEmail))
getUserPendingEmail user = getUserEmail' user False

addEmail :: SqlEmail -> SqlM (Key SqlEmail)
addEmail = insert

addEmailVerification :: Text -> Time -> SqlM (Key SqlEmailVerification)
addEmailVerification secret expires = do
    insert $ SqlEmailVerification
        { sqlEmailVerificationSecret = secret
        , sqlEmailVerificationExpires = expires
        }

getEmailVerificationSecret :: UserID -> SqlM (Maybe Text)
getEmailVerificationSecret userID = fmap (listToMaybe . fmap unValue) $ select $ do
    verification <- from $ table @SqlEmailVerification
    where_ $ (>. val (0 :: Int)) $ subSelectCount $ do
        email <- from $ table @SqlEmail
        where_ $ email ^. SqlEmailUid ==. val (fromID userID) &&.
            email ^. SqlEmailVid ==. just (verification ^. SqlEmailVerificationId)
    pure $ verification ^. SqlEmailVerificationSecret

deleteExpiredEmails :: Time -> SqlM ()
deleteExpiredEmails time = delete $ do
    verification <- from $ table @SqlEmailVerification
    where_ $ verification ^. SqlEmailVerificationExpires <=. val time

deleteUnverifiedEmail :: UserID -> SqlM ()
deleteUnverifiedEmail user = delete $ do
    email <- from $ table @SqlEmail
    where_ $ email ^. SqlEmailUid ==. val (fromID user) &&. not_ (isVerified email)

deleteOrphanedVerifications :: SqlM ()
deleteOrphanedVerifications = delete $ do
    verification <- from $ table @SqlEmailVerification
    where_ $ (==. val (0 :: Int)) $ subSelectCount $ do
        email <- from $ table @SqlEmail
        where_ $ email ^. SqlEmailVid ==. just (verification ^. SqlEmailVerificationId)

deleteUsersWithoutEmail :: SqlM ()
deleteUsersWithoutEmail = delete $ do
    user <- from $ table @SqlUser
    where_ $ (==. val (0 :: Int)) $ subSelectCount $ do
        email <- from $ table @SqlEmail
        where_ $ email ^. SqlEmailUid ==. user ^. SqlUserId
        pure $ email ^. SqlEmailId -- Not used anywhere

updateEmail :: UserID -> Email -> Text -> Time -> SqlM (Key SqlEmail)
updateEmail user email secret expires = do
    delete $ do
        dbEmail <- from $ table @SqlEmail
        where_ $ dbEmail ^. SqlEmailUid ==. val (fromID user) &&. not_ (isVerified dbEmail)
    verifiedEmail <- fmap listToMaybe $ select $ do
        dbEmail <- from $ table @SqlEmail
        where_ $ dbEmail ^. SqlEmailUid ==. val (fromID user)
            &&. dbEmail ^. SqlEmailEmail ==. val email
        pure dbEmail
    case verifiedEmail of
      Just (Entity key _) -> pure key
      Nothing -> do
          verificationId <- insert SqlEmailVerification
              { sqlEmailVerificationSecret = secret
              , sqlEmailVerificationExpires = expires
              }
          insert SqlEmail
              { sqlEmailUid = fromID user
              , sqlEmailEmail = email
              , sqlEmailVid = Just verificationId
              }

markAsAccepted :: UserID -> Time -> SqlM Bool
markAsAccepted userID time = fmap (> 0) $ updateCount $ \user -> do
    set user [SqlUserAccepted =. just (val time)]
    where_ $ user ^. SqlUserId ==. val (fromID userID) &&. isApplicant user

deleteApplication :: UserID -> SqlM Bool
deleteApplication userID = fmap (> 0) $ deleteCount $ do
    user <- from $ table @SqlUser
    where_ $ user ^. SqlUserId ==. val (fromID userID) &&. isApplicant user

updateUserData :: UserID -> [Persist.Update SqlUser] -> [UserUpdate] -> SqlM ()
updateUserData user updates memberDataUpdates = do
    let key = fromID user
    Just userData <- get key
    let Success memberData = fromJSON $ sqlUserMemberData userData :: Result MemberData
        userUpdates = [SqlUserMemberData Persist.=. (toJSON $ foldr updateData memberData memberDataUpdates)]
        updateData (SetUserName x) memberData = memberData { name = x }
        updateData (SetUserNickname x) memberData = memberData { nickname = x }
        updateData (SetUserHomeplace x) memberData = memberData { homeplace = x }
        updateData (SetUserPhoneNumber x) memberData = memberData { phoneNumber = x }
        updateData (SetUserApplication x) memberData = memberData { application = x }
    Persist.update key (userUpdates <> updates)

data UserUpdate = SetUserName Text
                | SetUserNickname (Maybe Text)
                | SetUserHomeplace Text
                | SetUserPhoneNumber PhoneNumber
                | SetUserApplication Text