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

module Handler.Course.ParticipantInvite
  ( getCAddUserR, postCAddUserR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Avs

import Jobs.Queue

--import qualified Database.Esqueleto.Legacy as E

--import qualified Data.Conduit.List as C (sourceList)
--import qualified Data.Conduit.Combinators as C

import qualified Data.Aeson as Aeson
import qualified Data.CaseInsensitive as CI
--import Data.List (genericLength)
import Data.Map ((!))
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Time.Zones as TZ
import qualified Data.Set as Set

import Control.Monad.Except (MonadError(..))
--import Control.Monad.State (evalStateT)
--import Control.Monad.State.Class (modify)
--import qualified Control.Monad.State as State

import Generics.Deriving.Monoid (memptydefault, mappenddefault)


type UserSearchKey = Text
type TutorialIdent = CI Text


data ButtonCourseRegisterMode = BtnCourseRegisterAdd | BtnCourseRegisterConfirm | BtnCourseRegisterAbort
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonCourseRegisterMode
instance Finite ButtonCourseRegisterMode

embedRenderMessage ''UniWorX ''ButtonCourseRegisterMode id

nullaryPathPiece ''ButtonCourseRegisterMode $ camelToPathPiece' 1

instance Button UniWorX ButtonCourseRegisterMode where
  btnLabel x = [whamlet|_{x}|]

  btnClasses BtnCourseRegisterAdd     = [BCIsButton, BCPrimary]
  btnClasses BtnCourseRegisterConfirm = [BCIsButton, BCPrimary]
  btnClasses BtnCourseRegisterAbort   = [BCIsButton, BCDanger]

  btnValidate _ BtnCourseRegisterAbort = False
  btnValidate _ _                      = True


data CourseRegisterAction
   = CourseRegisterActionAddParticipant
   | CourseRegisterActionAddTutorialMember
-- | CourseRegisterActionUnknownPerson
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe CourseRegisterAction
instance Finite CourseRegisterAction

data CourseRegisterActionData
   = CourseRegisterActionAddParticipantData
     { crActAddParticipantIdent       :: UserSearchKey
     , crActAddParticipantUser        :: UserId
     }
   | CourseRegisterActionAddTutorialMemberData
     { crActAddTutorialMemberIdent    :: UserSearchKey
     , crActAddTutorialMemberUser     :: UserId
     , crActAddTutorialMemberTutorial :: TutorialIdent
     }
-- | CourseRegisterActionUnknownPersonData -- pseudo-action; just for display
--   { crActUnknownPersonIdent :: Text
--   }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)

makeLenses_ ''CourseRegisterActionData

instance Aeson.FromJSON CourseRegisterActionData where
  parseJSON = Aeson.genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 }

instance Aeson.ToJSON CourseRegisterActionData where
  toJSON = Aeson.genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 }
  toEncoding = Aeson.genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 2 }

_classifyRegisterAction :: CourseRegisterActionData -> CourseRegisterAction
_classifyRegisterAction = \case
  CourseRegisterActionAddParticipantData{}    -> CourseRegisterActionAddParticipant
  CourseRegisterActionAddTutorialMemberData{} -> CourseRegisterActionAddTutorialMember
--CourseRegisterActionUnknownPersonData{}     -> CourseRegisterActionUnknownPerson

courseRegisterRenderActionClass :: CourseRegisterAction -> Widget
courseRegisterRenderActionClass = \case
  CourseRegisterActionAddParticipant    -> [whamlet|_{MsgCourseParticipantsRegisterActionAddParticipants}|]
  CourseRegisterActionAddTutorialMember -> [whamlet|_{MsgCourseParticipantsRegisterActionAddTutorialMembers}|]

courseRegisterRenderAction :: CourseRegisterActionData -> Widget
courseRegisterRenderAction = \case
  CourseRegisterActionAddParticipantData{..}    -> [whamlet|TODO USER (#{crActAddParticipantIdent})|]
  CourseRegisterActionAddTutorialMemberData{..} -> [whamlet|TODO USER (#{crActAddTutorialMemberIdent})|]

--data CourseRegisterActionClass
--   = CourseRegisterActionClassNew
--   | CourseRegisterActionClassExisting
--   | CourseRegisterActionClassMissing
--   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
--instance Universe CourseRegisterActionClass
--instance Finite CourseRegisterActionClass

--courseRegisterCoarsenActionClass :: CourseRegisterAction -> CourseRegisterActionClass
--courseRegisterCoarsenActionClass = \case
--  CourseRegisterActionAddParticipant    -> CourseRegisterActionClassNew
--  CourseRegisterActionAddTutorialMember -> CourseRegisterActionClassExisting
--  CourseRegisterActionUnknownPerson     -> CourseRegisterActionClassMissing
--
--data CourseRegisterActionDiff -- old new key
--   = CourseRegisterActionDiffNew
--     { crActKey         :: Text
--     , crActNewUser     :: UserId              -- crActNewKey :: Maybe key
--     , crActNewTutorial :: Maybe TutorialIdent -- crActNew    :: new
--     }
--   | CourseRegisterActionDiffExisting
--     { crActKey         :: Text
--     , crActOldUser     :: UserId              -- crActOldKey :: key
--     , crActOldTutorial :: TutorialIdent       -- crActOld    :: old
--     , crActNewTutorial :: Maybe TutorialIdent -- crActNew    :: new
--     }
--   | CourseRegisterActionDiffMissing
--     { crActKey         :: Text
--   --{ crActOldKey :: key
--   --, crActOld    :: old
--     }
--
--makeLenses_ ''CourseRegisterActionDiff
--makePrisms ''CourseRegisterActionDiff

--data CourseRegisterException
--   = CourseRegisterExceptionDuplicateIdent
--     { crExcptDuplicateIdent :: Text
--     }
--   | CourseRegisterException
--     { crExcpt :: Text
--     }
--   deriving (Show, Typeable)
--
--makeLenses_ ''CourseRegisterException
--
--instance Exception CourseRegisterException

--courseRegisterRenderException :: CourseRegisterException -> DB Text
--courseRegisterRenderException = ap getMessageRender . pure
--
--registerActionDefaultChecked :: CourseRegisterAction -> Bool
--registerActionDefaultChecked = (/=) CourseRegisterActionUnknownPerson
--
--registerActionDisabled :: CourseRegisterAction -> Bool
--registerActionDisabled = (==) CourseRegisterActionUnknownPerson


data AddUserRequest = AddUserRequest
  { auReqUsers    :: Set UserSearchKey
  , auReqTutorial :: Maybe TutorialIdent
  } deriving (Eq, Ord, Read, Show, Generic, Typeable)

--data AddUser = AddUser
--  { addUserIdent    :: Text
--  , addUserTutorial :: Maybe TutorialIdent
--  } deriving (Eq, Ord, Read, Show, Generic, Typeable)


data AddParticipantsResult = AddParticipantsResult
  { aurNotFound              :: Set UserSearchKey
  , aurAlreadyRegistered
  , aurAlreadyTutorialMember
  , aurRegisterSuccess
  , aurTutorialSuccess       :: Set UserId
  } deriving (Read, Show, Generic, Typeable)

instance Semigroup AddParticipantsResult where
  (<>) = mappenddefault

instance Monoid AddParticipantsResult where
  mempty = memptydefault
  mappend = (<>)


getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCAddUserR = postCAddUserR
postCAddUserR tid ssh csh = do
  _cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
  today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
  currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute

  ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
    let
      cfCommaSeparatedSet :: forall m. Functor m => Field m Text -> Field m (Set Text)
      cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.splitOn ",") (Text.intercalate ", " . Set.toList)
    auReqUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
    auReqTutorial <- optionalActionW
      ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting
      ( fslI MsgCourseParticipantsRegisterTutorialOption )
      ( Just True )
    return $ AddUserRequest <$> auReqUsers <*> auReqTutorial

  formResult usersToAdd $ \AddUserRequest{..} -> do
    avsUsers :: Map UserSearchKey (Maybe UserId) <- sequenceA $ Map.fromSet upsertAvsUser auReqUsers
    let (usersFound, usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
    unless (null usersNotFound) $
      let msgContent = [whamlet|
            $newline never
            <ul>
              $forall (usr,_) <- usersNotFound
                <li>#{usr}
            |]
       in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
    when (null usersFound) $
      redirect currentRoute

    liftHandler . (>>= sendResponse) $
      siteLayoutMsg MsgCourseParticipantsRegisterHeading $ do
        setTitleI MsgCourseParticipantsRegisterHeading

        actionMap :: Map CourseRegisterAction (Set CourseRegisterActionData) <- fmap Map.unions . forM usersFound $ \case
          (_, Nothing) -> error "Found user in AVS, but response is Nothing!" -- this should not be possible
          (ukey, Just uid) -> do
            -- isParticipant <- exists [CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive]
            case auReqTutorial of
              Nothing -> return . Map.singleton CourseRegisterActionAddParticipant . Set.singleton $ CourseRegisterActionAddParticipantData ukey uid
              Just crActAddTutorialMemberTutorial -> return . Map.singleton CourseRegisterActionAddTutorialMember . Set.singleton $ CourseRegisterActionAddTutorialMemberData ukey uid crActAddTutorialMemberTutorial

        let
          precomputeIdents :: forall f m. (Eq (Element f), MonoFoldable f, MonadHandler m) => f -> m (Element f -> Text)
          precomputeIdents = foldM (\f act -> (\id' x -> bool (f x) id' $ act == x) <$> newIdent) (\_ -> error "No id precomputed")
        actionClassIdent <- precomputeIdents $ Map.keys actionMap
        actionIdent <- precomputeIdents . Set.unions $ Map.elems actionMap

        let
          confirmCheckBox :: [(Text,Text)] -> CourseRegisterActionData -> Widget
          confirmCheckBox vAttrs act = do
            let
              sJsonField :: Field (HandlerFor UniWorX) CourseRegisterActionData
              sJsonField = secretJsonField' $ \theId name attrs val _isReq ->
                [whamlet|
                  $newline never
                  <input id=#{theId} *{attrs} type=checkbox name=#{name} value=#{either id id val} checked>
                |]
            fieldView sJsonField (actionIdent act) (toPathPiece PostCourseUserAddConfirmAction) vAttrs (Right act) False
          availableActs :: Widget
          availableActs = fieldView (secretJsonField :: Field Handler (Set CourseRegisterActionData)) "" (toPathPiece PostCourseUserAddConfirmAvailableActions) [] (Right . Set.unions $ Map.elems actionMap) False
        (confirmForm', confirmEnctype) <- generateFormPost . withButtonForm' [BtnCourseRegisterConfirm, BtnCourseRegisterAbort] . identifyForm FIDCourseRegisterConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "course/add-user/confirmation"))
        let confirmForm = wrapForm confirmForm' FormSettings
              { formMethod   = POST
              , formAction   = Just . SomeRoute $ CourseR tid ssh csh CAddUserR
              , formEncoding = confirmEnctype
              , formAttrs    = []
              , formSubmit   = FormNoSubmit
              , formAnchor   = Nothing :: Maybe Text
              }
        $(widgetFile "course/add-user/confirmation-wrapper")

        --registeredUsers <- registerUsers cid avsUsers
        --case auReqTutorial of
        --  Nothing -> redirect $ CourseR tid ssh csh CUsersR
        --  Just tutorialName -> do
        --    tutId <- upsertNewTutorial cid tutorialName
        --    registerTutorialMembers tutId registeredUsers
        --    redirect $ CTutorialR tid ssh csh tutorialName TUsersR

  let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading

  siteLayoutMsg heading $ do
    setTitleI heading
    wrapForm formWgt def
      { formEncoding
      , formAction = Just . SomeRoute $ CourseR tid ssh csh CAddUserR
      }

--getRowKey :: AddUser -> MaybeT DB UserId
--getRowKey AddUser{..} = MaybeT . liftHandler $ upsertAvsUser addUserIdent

--confirmAddUser :: SomeRoute UniWorX -> Handler Html
--confirmAddUser srcRoute = do
--  let
--    existing = Map.fromList $ zip currentKeys rows
--    sourceDiff :: ConduitT () CourseRegisterActionDiff (StateT (Map CourseRegisterActionClass CourseRegisterActionData) DB) ()
--    sourceDiff = do
--      let
--        toDiff :: CourseRegisterActionData -> StateT (Map CourseRegisterActionClass CourseRegisterActionData) DB CourseRegisterActionDiff
--        toDiff row = do
--          rowKey <- lift $ handle (throwM . (CourseRegisterException :: Text -> CourseRegisterException) <=< courseRegisterRenderException) . runMaybeT $ getRowKey row
--          seenKeys <- State.get
--          (<* modify (maybe id (flip Map.insert row) rowKey)) $ if
--            | Just rowKey' <- rowKey
--            , Just oldRow <- Map.lookup rowKey' seenKeys
--              -> throwM $ CourseRegisterExceptionDuplicateIdent rowKey'
--            | Just rowKey' <- rowKey
--            , Just oldRow <- Map.lookup rowKey' existing
--              -> return $ CourseRegisterActionDiffExisting rowKey' oldRow row
--            | otherwise
--              -> return $ CourseRegisterActionDiffNew rowKey' oldRow row
--      transPipe liftHandler blubb .| C.mapM toDiff
--      seen <- State.get
--      forM_ (Map.toList existing) $ \(rowKey, oldRow) -> if
--        | Map.member rowKey seen -> return ()
--        | otherwise -> yield $ CourseRegisterActionDiffMissing rowKey
--
--    accActionMap :: Map CourseRegisterActionClass (Set CourseRegisterActionData) -> CourseRegisterActionData -> Map CourseRegisterActionClass (Set CourseRegisterActionData)
--    accActionMap acc act = Map.insertWith Set.union (courseRegisterCoarsenActionClass $ classifyRegisterAction act) (Set.singleton act) acc
--
--    courseRegisterComputeActions :: CourseRegisterActionDiff -> ConduitT () CourseRegisterActionData DB ()
--    courseRegisterComputeActions = \case
--      CourseRegisterActionDiffNew{..} -> return () -- crActKey, crActNewUser, crActNewTutorial
--        -- TODO: fetch course participant, if any
--        -- TODO: if course participant was found, fetch tutorial member and (if yes) yield CourseRegisterActionAddTutorialMemberData
--        -- TODO: if no course participant was found, yield CourseRegisterActionAddParticipantData
--      CourseRegisterActionDiffExisting{..} -> return () -- TODO
--      CourseRegisterActionDiffMissing{} -> return () -- pseudo-action; no deletion -- TODO: yield smth?
--    courseRegisterComputeActions' :: ConduitT CourseRegisterActionDiff Void DB (Map CourseRegisterActionClass (Set CourseRegisterActionData))
--    courseRegisterComputeActions' = do
--      let innerAct = awaitForever $ \x
--            -> let doHandle = handle $ throwM CourseRegisterException <=< courseRegisterRenderException
--                in C.sourceList <=< lift . doHandle . runConduit $ courseRegisterComputeActions x .| C.foldMap pure
--      innerAct .| C.foldl accActionMap Map.empty
--  actionMap <- flip evalStateT Map.empty . runConduit $ sourceDiff .| transPipe lift courseRegisterComputeActions'
--
--  when (Map.null actionMap) $
--    addMessageI Info MsgCourseParticipantsRegisterUnnecessary
--    redirect srcRoute
--
--  E.transactionSave -- Commit side-effects of courseRegisterComputeActions
--
--  liftHandler . (>>= sendResponse) $
--    siteLayoutMsg MsgCourseParticipantsRegisterConfirmationHeading $ do
--      setTitleI MsgCourseParticipantsRegisterConfirmationHeading
--      let precomputeIdents :: forall f m. (Eq (Element f), MonoFoldable f, MonadHandler m) => f -> m (Element f -> Text)
--          precomputeIdents = foldM (\f act -> (\id' x -> bool (f x) id' $ act == x) <$> newIdent) (\_ -> error "No id precomputed")
--      actionClassIdent <- precomputeIdents $ Map.keys actionMap
--      actionIdent <- precomputeIdents . Set.union $ Map.elems actionMap
--      let
--        --defaultChecked actClass = case courseRegisterCoarsenActionClass actClass of
--        --  CourseRegisterActionDiffMissing -> False
--        --  _other                          -> True
--        defaultChecked = const True
--        confirmCheckBox :: [(Text,Text)] -> CourseRegisterActionData -> Widget
--        confirmCheckBox vAttrs act = do
--          let sJsonField :: Field (HandlerFor UniWorX) CourseRegisterAction
--              sJsonField = secretJsonField' $ \theId name attrs val _isReq ->
--                [whamlet|
--                  $newline never
--                  <input id=#{theId} *{attrs} type=checkbox name=#{name} value=#{either id id val} :registerActionDefaultChecked (classifyRegisterAction act):checked :registerActionDisabled (classifyRegisterAction act):disabled>
--                |]
--          fieldView sJsonField act mempty vAttrs (Right act) False
--        availableActs :: Widget
--        availableActs = fieldView (secretJsonField :: Field Handler (Set CourseRegisterAction)) "" mempty [] (Right . Set.unions $ Map.elems actionMap) False
--      (confirmForm', confirmEnctype) <- liftHandler . generateFormPost . withButtonForm' [BtnCourseRegisterConfirm, BtnCourseRegisterAbort] . identifyForm FIDCourseRegisterConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "course/add-user/confirmation"))
--      let confirmForm = wrapForm confirmForm' FormSettings
--            { formMethod   = POST
--            , formAction   = Just $ tblLink id
--            , formEncoding = confirmEnctype
--            , formAttrs    = []
--            , formSubmit   = FormNoSubmit
--            , formAnchor   = Nothing :: Maybe Text
--            }
--      $(widgetFile "course/add-user/confirmation-wrapper")


_registerUsers :: CourseId -> Map UserSearchKey (Maybe UserId) -> Handler (Set UserId) -- WriterT [Message] (YesodJobDB UniWorX) ()
_registerUsers cid users
  | Map.null users = do
    addMessageI Error MsgCourseParticipantsRegisterNoneGiven
    return Set.empty
  | otherwise = do
    (mconcat -> AddParticipantsResult{..}) <- runDBJobs . mapM (_registerUser cid) $ Map.toList users
    unless (Set.null aurRegisterSuccess) $
      addMessageI Success . MsgCourseParticipantsRegistered $ Set.size aurRegisterSuccess
    unless (Set.null aurAlreadyRegistered) $
      addMessageI Info . MsgCourseParticipantsAlreadyRegistered $ Set.size aurAlreadyRegistered
    return $ aurRegisterSuccess `Set.union` aurAlreadyRegistered

_upsertNewTutorial :: CourseId -> TutorialIdent -> Handler TutorialId
_upsertNewTutorial cid tutorialName = do
  now <- liftIO getCurrentTime
  Entity tutId _ <- runDB $ upsert
    Tutorial
      { tutorialCourse = cid
      , tutorialType = CI.mk mempty -- TODO: remove type? unneeded?
      , tutorialCapacity = Nothing
      , tutorialRoom = Nothing
      , tutorialRoomHidden = False
      , tutorialTime = Occurrences mempty mempty
      , tutorialRegGroup = Nothing -- TODO: remove
      , tutorialRegisterFrom = Nothing
      , tutorialRegisterTo = Nothing
      , tutorialDeregisterUntil = Nothing
      , tutorialLastChanged = now
      , tutorialTutorControlled = False
      , ..
      }
    [ TutorialName        =. tutorialName
    , TutorialLastChanged =. now
    ]
  return tutId

_registerTutorialMembers :: TutorialId -> Set UserId -> Handler ()
_registerTutorialMembers tutId (Set.toList -> users) = runDB $ do
  prevParticipants <- fmap Set.fromList $ selectList [TutorialParticipantUser <-. users, TutorialParticipantTutorial ==. tutId] []
  participants <- fmap Set.fromList . for users $ \tutorialParticipantUser -> upsert
    TutorialParticipant
      { tutorialParticipantTutorial = tutId
      , ..
      }
    []
  let newParticipants = participants Set.\\ prevParticipants
  unless (Set.null newParticipants) $
    addMessageI Success . MsgCourseParticipantsRegisteredTutorial $ Set.size newParticipants
  unless (Set.null prevParticipants) $
    addMessageI Info . MsgCourseParticipantsAlreadyTutorialMember $ length prevParticipants

--addParticipantsResultMessages :: (MonadHandler m, HandlerSite m ~ UniWorX)
--                              => AddParticipantsResult
--                              -> ReaderT (YesodPersistBackend UniWorX) m [Message]
--addParticipantsResultMessages AddParticipantsResult{..} = execWriterT $ do
--  unless (null aurNotFound) $ do
--    let modalTrigger = [whamlet|_{MsgCourseParticipantsRegisterNotFoundInAvs (length aurNotFound)}|]
--        modalContent = $(widgetFile "messages/courseInvitationNotFoundInAvs")
--    tell . pure <=< messageWidget Error $ msgModal modalTrigger (Right modalContent)
--
--  aurAlreadyRegistered'     <- fmap sort (lift . mapM getJust $ Set.toList aurAlreadyRegistered)
--  aurAlreadyTutorialMember' <- fmap sort (lift . mapM getJust $ Set.toList aurAlreadyTutorialMember)
--
--  unless (null aurAlreadyRegistered) $ do
--    let modalTrigger = [whamlet|_{MsgCourseParticipantsAlreadyRegistered (length aurAlreadyRegistered)}|]
--        modalContent = $(widgetFile "messages/courseInvitationAlreadyRegistered")
--    tell . pure <=< messageWidget Info $ msgModal modalTrigger (Right modalContent)
--  unless (null aurAlreadyTutorialMember) $ do
--    let modalTrigger = [whamlet|_{MsgCourseParticipantsAlreadyTutorialMember (length aurAlreadyTutorialMember)}|]
--        modalContent = $(widgetFile "messages/courseInvitationAlreadyTutorialMember")
--    tell . pure <=< messageWidget Info $ msgModal modalTrigger (Right modalContent)
--
--  unless (null aurRegisterSuccess) $
--    tell . pure <=< messageI Success . MsgCourseParticipantsRegistered $ length aurRegisterSuccess
--  unless (null aurTutorialSuccess) $
--    tell . pure <=< messageI Success . MsgCourseUsersTutorialRegistered . genericLength $ Set.toList aurTutorialSuccess


_registerUser :: CourseId
             -> (UserSearchKey, Maybe UserId)
             -> YesodJobDB UniWorX AddParticipantsResult
             -- -> WriterT AddParticipantsResult (YesodJobDB UniWorX) ()
_registerUser _cid ( avsIdent, Nothing ) = return $ mempty { aurNotFound = Set.singleton avsIdent } -- tell $ mempty { aurNotFound = Set.singleton avsIdent }
_registerUser  cid (_avsIdent, Just uid) = exceptT return return $ do
  whenM (lift $ exists [CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive]) $
    throwError $ mempty { aurAlreadyRegistered = Set.singleton uid }

  courseParticipantRegistration <- liftIO getCurrentTime
  void . lift $ upsert
    CourseParticipant -- TODO: use participantId instead of userId for aurRegisterSuccess
      { courseParticipantCourse = cid
      , courseParticipantUser = uid
      , courseParticipantAllocated = Nothing
      , courseParticipantState = CourseParticipantActive
      , ..
      }
    [ CourseParticipantRegistration =. courseParticipantRegistration
    , CourseParticipantAllocated =. Nothing
    , CourseParticipantState =. CourseParticipantActive
    ]
  lift . audit $ TransactionCourseParticipantEdit cid uid
  lift . queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid -- TODO: send Notification at all?

  return $ mempty { aurRegisterSuccess = Set.singleton uid }