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

module Handler.Sheet.Pseudonym
  ( getSPseudonymR, postSPseudonymR
  , ButtonGeneratePseudonym(..)
  ) where

import Import

import Handler.Utils


data ButtonGeneratePseudonym = BtnGenerate
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic)
instance Universe ButtonGeneratePseudonym
instance Finite ButtonGeneratePseudonym

nullaryPathPiece ''ButtonGeneratePseudonym (camelToPathPiece' 1)

instance Button UniWorX ButtonGeneratePseudonym where
  btnLabel BtnGenerate = [whamlet|_{MsgSheetGeneratePseudonym}|]
  btnClasses BtnGenerate = [BCIsButton, BCDefault]


getSPseudonymR, postSPseudonymR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
getSPseudonymR = postSPseudonymR
postSPseudonymR tid ssh csh shn = do
  uid <- requireAuthId
  shId <- runDB $ fetchSheetId tid ssh csh shn
  let
    genPseudonym = do
      inserted <- runExceptT . mapExceptT (runDB . setSerializable) $ do
        candidate <- liftIO getRandom
        existing <- lift . getBy $ UniqueSheetPseudonymUser shId uid
        case existing of
          Just (Entity _ SheetPseudonym{sheetPseudonymPseudonym}) -> throwE sheetPseudonymPseudonym
          Nothing
            -> lift $ fmap (const candidate) <$> insertUnique (SheetPseudonym shId candidate uid)
      case inserted of
        Right Nothing -> genPseudonym
        Right (Just ps) -> return ps
        Left ps -> return ps
  ps <- genPseudonym
  selectRep $ do
    provideRep . return $ review _PseudonymText ps
    provideJson ps
    provideRep (redirect $ CSheetR tid ssh csh shn SShowR :#: ("pseudonym" :: Text) :: Handler Html)