-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor@kleen.consulting>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Winnie Ros <winnie.ros@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -O0 -fno-ignore-interface-pragmas -fno-omit-interface-pragmas #-}

module Handler.Users.Add
  ( getAdminUserAddR, postAdminUserAddR
  ) where


import Import
import Utils.Users
import Handler.Utils
import Jobs


adminUserForm :: Maybe AddUserData -> Form AddUserData
adminUserForm template = renderAForm FormStandard
   $  AddUserData
  <$> aopt (textField & cfStrip)        (fslI MsgAdminUserTitle)            (audTitle <$> template)
  <*> areq (textField & cfStrip)        (fslI MsgAdminUserFirstName)        (audFirstName <$> template)
  <*> areq (textField & cfStrip)        (fslI MsgAdminUserSurname)          (audSurname <$> template)
  <*> areq (textField & cfStrip)        (fslI MsgAdminUserDisplayName)      (audDisplayName <$> template)
  <*> areq (emailField & cfCI)          (fslI MsgAdminUserDisplayEmail)     (audDisplayEmail <$> template)
  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserMatriculation)    (audMatriculation <$> template)
  <*> aopt (selectField optionsFinite)  (fslI MsgAdminUserSex)              (audSex <$> template)
  <*> aopt dayField                     (fslI MsgAdminUserBirthday)         (audBirthday <$> template)
  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserMobile)           (audMobile <$> template)
  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserTelephone)        (audTelephone <$> template)
  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserFPersonalNumber)  (audFPersonalNumber <$> template)
  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserFDepartment)      (audFDepartment <$> template)
  <*> aopt htmlField                    (fslI MsgAdminUserPostAddress)      (audPostAddress   <$> template)
  <*> areq checkBoxField                (fslI MsgAdminUserPrefersPostal)    (audPrefersPostal <$> template)
  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserPinPassword)      (audPinPassword <$> template)
  <*> areq (emailField & cfCI)          (fslI MsgAdminUserEmail)            (audEmail <$> template)
  <*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent)            (audIdent <$> template)
  <*> aopt passwordField                (fslI MsgAdminUserPassword)         (audPassword <$> template)

-- | Like `addNewUser`, but starts background jobs and tries to notify users
addNewUserNotify :: AddUserData -> Handler (Maybe UserId)
addNewUserNotify aud = do
  mbUid <- addNewUser aud
  case mbUid of
    Nothing -> return Nothing
    Just uid -> runDBJobs $ do
      queueDBJob $ JobSynchroniseUser uid
      when (is _Just $ audPassword aud) $ do
        queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid
        queueDBJob $ JobSendPasswordReset uid
      return $ Just uid

getAdminUserAddR, postAdminUserAddR :: Handler Html
getAdminUserAddR = postAdminUserAddR
postAdminUserAddR = do
  ((userRes, userView), userEnctype) <- runFormPost $ adminUserForm Nothing
  formResult userRes $ addNewUserNotify >=> \case
      (Just uid) -> do
        addMessageI Success MsgUserAdded
        cID <- encrypt uid
        redirect $ AdminUserR cID
      Nothing ->
        addMessageI Error MsgUserCollision

  siteLayoutMsg MsgHeadingUserAdd $ do
    setTitleI MsgHeadingUserAdd
    wrapForm userView def
        { formAction = Just $ SomeRoute AdminUserAddR
        , formEncoding = userEnctype
        }