-- SPDX-FileCopyrightText: 2022 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-|
Module      : Handler.Utils.Delete
Description : Generic deletion from database after confirmation

`postDeleteR`, `getDeleteR`, and `deleteR` provide handlers for calling
`deleteCascade` on a `Set` of Record-`Key`s after asking for confirmation, which
currently entails asking the user to copy a text, which is dependent on the
records to be deleted (i.e. a comma-separated list of user names), into a
`Textarea`.
-}
module Handler.Utils.Delete
  ( DeleteRoute(..)
  , deleteR
  , postDeleteR, getDeleteR
  , JobDB
  ) where

import Import
import Handler.Utils.Form
import Handler.Utils.Memcached

import qualified Data.Text as Text
import qualified Data.Set as Set

import qualified Data.CaseInsensitive as CI

import Data.Char (isAlphaNum)

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Internal.Internal as E (SqlSelect)

import Jobs.Queue

{-# ANN deleteR ("HLint: ignore Use const" :: String) #-}


data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr info, E.From tables) => DeleteRoute
  { drRecords :: Set (Key record) -- ^ Records to be deleted
  , drGetInfo :: tables -> E.SqlQuery infoExpr -- ^ SQL-Query to get necessary information to render identifing information about records to the user (`drRenderRecord`, `drRecordConfirmString`); @tables@ is an arbitrary join, see `E.from`; @infoExpr@ gets converted to @info@ by esqueleto
  , drUnjoin :: tables -> E.SqlExpr (Entity record) -- ^ `E.SqlExpr` of @Key record@ extracted from @tables@, `deleteR` restricts `drGetInfo` to `drRecords` automatically
  , drRenderRecord :: info -> DB Widget -- ^ Present a single record, to be deleted, to the user for inspection prior to deletion
  , drRecordConfirmString :: info -> DB Text -- ^ Text for the user to copy to confirm deletion; should probably contain all information from `drRenderRecord` so user gets prompted to think about what they're deleting
  , drFormMessage :: [info] -> DB (Maybe Message)
  , drCaption
  , drSuccessMessage :: SomeMessage UniWorX
  , drAbort
  , drSuccess :: SomeRoute UniWorX
  , drDelete :: forall a. Key record -> JobDB a -> JobDB a
  }

confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX )
           => Text -- ^ Confirmation string
           -> AForm m Bool
confirmForm confirmString = flip traverseAForm aform $ \(inpConfirmStr, BtnDelete) -> if
  | ((==) `on` map (CI.mk . filter isAlphaNum) . Text.words) confirmString inpConfirmStr
    -> return $ pure True
  | otherwise
    -> formFailure [MsgDeleteConfirmationWrong]
  where
    aform = (,)
        <$> areq confirmField (fslI MsgDeleteConfirmation) Nothing
        <*> pure BtnDelete
    confirmField
      | multiple  = convertField unTextarea Textarea textareaField
      | otherwise = textField
    multiple = length (filter (not . Text.null . Text.strip) $ Text.lines confirmString) > 1

confirmFormReduced :: Monad m => AForm m Bool
confirmFormReduced = pure True

confirmForm' :: PersistEntity record => Set (Key record) -> Text -> Maybe Message -> Form Bool
confirmForm' drRecords confirmString mmsg = identifyForm FIDDelete . addDeleteTargets . renderAForm FormStandard . maybe id ((*>) . aformMessage) mmsg . maybe confirmFormReduced confirmForm $ assertM' (not . Text.null . Text.strip) confirmString
  where
    addDeleteTargets :: Form a -> Form a
    addDeleteTargets form csrf = do
      (_, fvTargets) <- mreq secretJsonField ("" & addName (toPathPiece PostDeleteTarget)) (Just drRecords)
      over _2 (mappend $ fvInput fvTargets) <$> form csrf


postDeleteR :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend)
            => (Set (Key record) -> DeleteRoute record) -- ^ Construct `DeleteRoute` based on incoming record keys
            -> Handler ()
-- | Perform deletion
postDeleteR mkRoute = do
  drResult <- fmap (fmap mkRoute) . runInputPost . iopt secretJsonField $ toPathPiece PostDeleteTarget

  traverse_ deleteR' drResult

getDeleteR :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend)
           => DeleteRoute record -> Handler a
getDeleteR = deleteR'

deleteR' :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend)
         => DeleteRoute record -> Handler a
deleteR' DeleteRoute{..} = do
  (targets, confirmString, message) <- runDB $ do
    infos <- E.select . E.from $ \t -> do
      E.where_ $ drUnjoin t E.^. persistIdField `E.in_` E.valList (Set.toList drRecords)
      drGetInfo t

    targets <- mapM (runKleisli $ Kleisli drRenderRecord &&& Kleisli drRecordConfirmString) infos
    let confirmString = Text.unlines $ view _2 <$> targets
    message <- drFormMessage infos

    return (targets, confirmString, message)

  ((confirmRes, deleteFormWdgt), deleteFormEnctype) <- runFormPost $ confirmForm' drRecords confirmString message

  formResult confirmRes $ \case
    True -> do
      runDBJobs $ do
        forM_ drRecords $ \k -> drDelete k $ delete k
        memcachedInvalidateClass MemcachedKeyClassTutorialOccurrences
        addMessageI Success drSuccessMessage
      redirect drSuccess
    False ->
      redirect drAbort

  targetRoute <- fromMaybe (error "getDeleteR called from 404-handler") <$> getCurrentRoute
  let deleteForm = wrapForm' BtnDelete deleteFormWdgt def
        { formAction = Just $ SomeRoute targetRoute
        , formEncoding = deleteFormEnctype
        , formSubmit = FormSubmit
        }

  sendResponse =<<
    defaultLayout $(widgetFile "widgets/delete-confirmation/delete-confirmation")



deleteR :: (PersistEntity record, PersistEntityBackend record ~ SqlBackend)
        => DeleteRoute record -> Handler Html
deleteR dr = do
  postDeleteR $ \drRecords -> dr {drRecords}
  getDeleteR dr