-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.ExternalExam.StaffInvite
  ( externalExamStaffInvitationConfig
  , getEEStaffInviteR, postEEStaffInviteR
  , InvitableJunction(..), InvitationDBData(..), InvitationTokenData(..)
  ) where

import Import

import Handler.Utils.Invitations

import Data.Aeson hiding (Result(..))

import qualified Data.HashSet as HashSet


instance IsInvitableJunction ExternalExamStaff where
  type InvitationFor ExternalExamStaff = ExternalExam
  data InvitableJunction ExternalExamStaff = JunctionExternalExamStaff
    deriving (Eq, Ord, Read, Show, Generic)
  data InvitationDBData ExternalExamStaff = InvDBDataExternalExamStaff
    deriving (Eq, Ord, Read, Show, Generic)
  data InvitationTokenData ExternalExamStaff = InvTokenDataExternalExamStaff
    deriving (Eq, Ord, Read, Show, Generic)

  _InvitableJunction = iso
    (\ExternalExamStaff{..} -> (externalExamStaffUser, externalExamStaffExam, JunctionExternalExamStaff))
    (\(externalExamStaffUser, externalExamStaffExam, JunctionExternalExamStaff{}) -> ExternalExamStaff{..})

instance ToJSON (InvitableJunction ExternalExamStaff) where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
instance FromJSON (InvitableJunction ExternalExamStaff) where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }

instance ToJSON (InvitationDBData ExternalExamStaff) where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
instance FromJSON (InvitationDBData ExternalExamStaff) where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }

instance ToJSON (InvitationTokenData ExternalExamStaff) where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
instance FromJSON (InvitationTokenData ExternalExamStaff) where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }

externalExamStaffInvitationConfig :: InvitationConfig ExternalExamStaff
externalExamStaffInvitationConfig = InvitationConfig{..}
  where
    invitationRoute (Entity _ ExternalExam{..}) _ = return $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEStaffInviteR
    invitationResolveFor _ = do
      cRoute <- getCurrentRoute
      case cRoute of
        Just (EExamR tid ssh coursen examn EEStaffInviteR) ->
          getKeyBy404 $ UniqueExternalExam tid ssh coursen examn
        _other -> error "externalExamStaffInvitationConfig called from unsupported route"
    invitationSubject (Entity _ ExternalExam{..}) _ = return . SomeMessage $ MsgMailSubjectExternalExamStaffInvitation externalExamCourseName externalExamExamName
    invitationHeading (Entity _ ExternalExam{..}) _ = return . SomeMessage $ MsgExternalExamStaffInviteHeading externalExamCourseName externalExamExamName
    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExternalExamStaffInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- HashSet.singleton . Right <$> liftHandler requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing (Just Nothing) Nothing
    invitationRestriction _ _ = return Authorized
    invitationForm _ (InvDBDataExternalExamStaff, _) _ = pure (JunctionExternalExamStaff, ())
    invitationInsertHook invEmail _ _ ExternalExamStaff{..} _ act = do
      res <- act

      audit $ TransactionExternalExamStaffInviteDelete externalExamStaffExam invEmail
      audit $ TransactionExternalExamStaffEdit externalExamStaffExam externalExamStaffUser
      return res
    invitationSuccessMsg (Entity _ ExternalExam{..}) (Entity _ ExternalExamStaff{})
      = return . SomeMessage $ MsgExternalExamStaffInvitationAccepted externalExamCourseName externalExamExamName
    invitationUltDest (Entity _ ExternalExam{..}) _ = return . SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR


getEEStaffInviteR, postEEStaffInviteR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEEStaffInviteR = postEEStaffInviteR
postEEStaffInviteR = invitationR externalExamStaffInvitationConfig