-- SPDX-FileCopyrightText: 2022-23 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE TypeApplications #-}


-- Module for functions directly related to the AVS interface,
-- for utilities dealing with FraDrive Qualification types see Handler.Utils.Qualification

module Handler.Utils.Avs
  ( guessAvsUser
  , upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard
  -- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
  , AvsLicenceDifferences(..)
  , setLicence, setLicenceAvs, setLicencesAvs
  , retrieveDifferingLicences, retrieveDifferingLicencesStatus
  , computeDifferingLicences
  , synchAvsLicences
  , lookupAvsUser, lookupAvsUsers
  , AvsException(..)
  , updateReceivers
  , AvsPersonIdMapPersonCard
  ) where

import Import

-- import Handler.Utils
-- import qualified Database.Esqueleto.Legacy as E

import Utils.Avs
import Utils.Users

import qualified Data.Set             as Set
import qualified Data.Map             as Map
import qualified Data.Text            as Text
import qualified Data.CaseInsensitive as CI
-- import Auth.LDAP (ldapUserPrincipalName)
import Foundation.Yesod.Auth (ldapLookupAndUpsert) -- , CampusUserConversionException())

import Handler.Utils.Company
import Handler.Utils.Qualification

import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Utils        as E





--------------------
-- AVS Exceptions --
--------------------

data AvsException
  = AvsInterfaceUnavailable                   -- Interface to AVS was not configured at startup or does not respond
  | AvsUserUnassociated UserId                -- Manipulating AVS Data for a user that is not linked to AVS yet
  | AvsUserUnknownByAvs AvsPersonId           -- AvsPersonId not (or no longer) found in AVS DB
  | AvsUserAmbiguous    AvsPersonId           -- Multiple matching existing users found in our DB
  | AvsPersonSearchEmpty                      -- AvsPersonSearch returned empty result
  | AvsPersonSearchAmbiguous                  -- AvsPersonSearch returned more than one result
  | AvsSetLicencesFailed Text                 -- AvsSetLicence total failure
  deriving (Show, Eq, Ord, Generic)
instance Exception AvsException

{-
  Error Handling: in Addition to AvsException, Servant.ClientError must be expected. Maybe we should wrap it within an AvsException?
-}




------------------
-- AVS Handlers --
------------------
{-
  TODOs
    Connect AVS query to LDAP queries for automatic synchronisation:
    - add query to Auth.LDAP.campusUserMatr
    - add query to Auth.LDAP.campusLogin
    - jobs.Handler.dispatchJobSynchroniseLdap

-}

{- AVS interface only allows collecting all licences at once, thus getLicence should be avoided, see getLicenceByAvsId including a workaround
-- Do we need this?
-- getLicence :: UserId -> Handler (Maybe AvsLicence) -- with runDB
getLicence :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, WithRunDB SqlReadBackend (HandlerFor UniWorX) m ) => UserId -> m (Maybe AvsLicence)
getLicence uid = do
  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
  Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnassociated uid) $ useRunDB $ getBy $ UniqueUserAvsUser uid
  AvsResponseGetLicences licences <- throwLeftM $ avsQueryGetLicences $ AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId userAvsPersonId
  let ulicence = Set.lookupMax $ Set.filter ((userAvsPersonId ==) . avsLicencePersonID) licences
  return (avsLicenceRampLicence <$> ulicence)

getLicenceDB :: UserId -> DB (Maybe AvsLicence)
getLicenceDB uid = do
  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ liftHandler $ getsYesod $ view _appAvsQuery
  Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnassociated uid) $ getBy $ UniqueUserAvsUser uid
  AvsResponseGetLicences licences <- throwLeftM $ avsQueryGetLicences $ AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId userAvsPersonId
  let ulicence = Set.lookupMax $ Set.filter ((userAvsPersonId ==) . avsLicencePersonID) licences
  return (avsLicenceRampLicence <$> ulicence)


-- | Should be avoided, since all licences must be requested at once.
getLicenceByAvsId :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) =>
                      Set AvsPersonId -> m (Set AvsPersonLicence)
getLicenceByAvsId aids = do
  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ liftHandler $ getsYesod $ view _appAvsQuery
  AvsResponseGetLicences licences <- throwLeftM avsQueryGetAllLicences
  return $ Set.filter (\x -> avsLicencePersonID x `Set.member` aids) licences
-}

-- setLicence :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) => UserId -> AvsLicence -> m Bool
setLicence :: (PersistUniqueRead backend, MonadThrow m,
                     MonadHandler m, HandlerSite m ~ UniWorX,
                     BaseBackend backend ~ SqlBackend) =>
                    UserId -> AvsLicence -> ReaderT backend m Bool
setLicence uid lic = do
  Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnassociated uid) $ getBy $ UniqueUserAvsUser uid
  setLicenceAvs userAvsPersonId lic

setLicenceAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
                  AvsPersonId -> AvsLicence -> m Bool
setLicenceAvs apid lic = do
  let req = Set.singleton $ AvsPersonLicence { avsLicenceRampLicence = lic, avsLicencePersonID = apid }
  (1 ==) <$> setLicencesAvs req


--setLicencesAvs :: Set AvsPersonLicence -> Handler Bool
setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
                  Set AvsPersonLicence -> m Int
setLicencesAvs persLics = do -- exceptT (return 0 <$ addMessage Error . text2Html . tshow) return $ do
    AvsQuery{avsQuerySetLicences=aqsl} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
    aux aqsl 0 persLics
  where
    aux aqsl batch0_ok pls
      | Set.null pls = return batch0_ok
      | otherwise = do
        let (batch1, batch2) = Set.splitAt avsMaxSetLicenceAtOnce pls
        response <- throwLeftM $ aqsl $ AvsQuerySetLicences batch1
        case response of
          AvsResponseSetLicencesError{..} -> do
            let msg = "Set AVS licences failed utterly: " <> avsResponseSetLicencesStatus <> ". Details: " <> cropText avsResponseSetLicencesMessage
            $logErrorS "AVS" msg
            throwM $ AvsSetLicencesFailed avsResponseSetLicencesStatus

          AvsResponseSetLicences msgs -> do
            let (ok,bad') = Set.partition (sloppyBool . avsResponseSuccess) msgs
                ok_ids = Set.map avsResponsePersonID ok
                bad = Map.withoutKeys (setToMap avsResponsePersonID bad') ok_ids -- it is possible to receive an id multiple times, with only one success, but this is sufficient
                batch1_ok = Set.size ok
            forM_ bad $ \AvsLicenceResponse { avsResponsePersonID=api, avsResponseMessage=msg} ->
              $logErrorS "AVS" $ "Set AVS Licence failed for " <> tshow api <> " due to " <> cropText msg
              -- TODO: Admin Error page
            aux aqsl (batch0_ok + batch1_ok) batch2 -- yay for tail recursion (TODO: maybe refactor?)


-- | Retrieve all currently valid driving licences and check against our database
--   Only react to changes as compared to last seen status in avs.model
--   TODO: run in a background job, once the interface is actually available
synchAvsLicences :: Handler Bool
synchAvsLicences = do
  AvsQuery{..}  <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
  allLicences   <- throwLeftM avsQueryGetAllLicences
  deltaLicences <- computeDifferingLicences allLicences
  setResponse   <- setLicencesAvs deltaLicences
  let setOk = setResponse == Set.size deltaLicences
  if setOk
    then $logInfoS "AVS" "FRADrive Licences written to AVS successfully."
    else $logWarnS "AVS" "Writing FRADrive Licences to AVS incomplete."
  return setOk

data AvsLicenceDifferences = AvsLicenceDifferences
    { avsLicenceDiffRevokeAll      :: Set AvsPersonId   -- revoke all driving licences in AVS (set 0)
    , avsLicenceDiffGrantVorfeld   :: Set AvsPersonId   -- grant apron driving licence in AVS (set 1, upgrade from 0)
    , avsLicenceDiffRevokeRollfeld :: Set AvsPersonId   -- revoke maneuvering area driving licence, but retain apron driving licence (set 1, downgrade from 2)
    , avsLicenceDiffGrantRollfeld  :: Set AvsPersonId   -- grant maneuvering area driving licence (set 2)
    }
  deriving (Show)

#ifdef DEVELOPMENT
-- avsLicenceDifferences2LicenceIds is not used in DEVELOPMENT build
#else
avsLicenceDifferences2LicenceIds :: AvsLicenceDifferences -> Set AvsPersonId
avsLicenceDifferences2LicenceIds AvsLicenceDifferences{..} = Set.unions 
  [ avsLicenceDiffRevokeAll     
  , avsLicenceDiffGrantVorfeld  
  , avsLicenceDiffRevokeRollfeld
  , avsLicenceDiffGrantRollfeld 
  ]
#endif 

avsLicenceDifferences2personLicences :: AvsLicenceDifferences -> Set AvsPersonLicence
avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
     Set.map (AvsPersonLicence AvsNoLicence)       avsLicenceDiffRevokeAll
  <> Set.map (AvsPersonLicence AvsLicenceVorfeld)  avsLicenceDiffGrantVorfeld
  <> Set.map (AvsPersonLicence AvsLicenceVorfeld)  avsLicenceDiffRevokeRollfeld
  <> Set.map (AvsPersonLicence AvsLicenceRollfeld) avsLicenceDiffGrantRollfeld

computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDifferingLicences

type AvsPersonIdMapPersonCard = Map AvsPersonId (Set AvsDataPersonCard)

avsResponseStatusMap :: AvsResponseStatus -> AvsPersonIdMapPersonCard
avsResponseStatusMap (AvsResponseStatus status) = Map.fromDistinctAscList [(avsStatusPersonID,avsStatusPersonCardStatus) | AvsStatusPerson{..}<- Set.toAscList status]

retrieveDifferingLicences :: Handler AvsLicenceDifferences
retrieveDifferingLicences = fst <$> retrieveDifferingLicences' False

retrieveDifferingLicencesStatus :: Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
retrieveDifferingLicencesStatus = retrieveDifferingLicences' True

retrieveDifferingLicences' :: Bool -> Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
retrieveDifferingLicences' getStatus = do  
#ifdef DEVELOPMENT
  avsUsrs <- runDB $ selectList [] [LimitTo 444]
  let allLicences = AvsResponseGetLicences $ Set.fromList $
        [ AvsPersonLicence AvsLicenceVorfeld  $ AvsPersonId 77         -- AVS:1 FD:2
        , AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678   -- AVS:2 FD:1
        , AvsPersonLicence AvsLicenceVorfeld  $ AvsPersonId 5          -- AVS:1 FD:0 (nichts)
        , AvsPersonLicence AvsLicenceVorfeld  $ AvsPersonId 2          -- AVS:1 FD:0 (ungültig)
        -- , AvsPersonLicence AvsLicenceVorfeld  $ AvsPersonId 4          -- AVS:1 FD:1
        ] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
#else
  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
  allLicences  <- throwLeftM avsQueryGetAllLicences
#endif
  lDiff <- getDifferingLicences allLicences  
#ifdef DEVELOPMENT
  let mkAdpc valid color = AvsDataPersonCard valid Nothing Nothing color (Set.singleton 'F') Nothing Nothing Nothing Nothing (AvsCardNo "1234") "5"
      lStat = AvsResponseStatus $ bool mempty fakes getStatus -- not really needed, but avoids unused variable error
      fakes = Set.fromList $ 
              [ AvsStatusPerson (AvsPersonId 77      ) $ Set.singleton $ mkAdpc True AvsCardColorGelb
              , AvsStatusPerson (AvsPersonId 12345678) $ Set.fromList [mkAdpc False AvsCardColorGrün, mkAdpc True  AvsCardColorGelb, mkAdpc False AvsCardColorBlau, mkAdpc True  AvsCardColorRot, mkAdpc True $ AvsCardColorMisc "Violett"]
              , AvsStatusPerson (AvsPersonId 5       ) $ Set.fromList [mkAdpc True  AvsCardColorGrün, mkAdpc False AvsCardColorGelb, mkAdpc True  AvsCardColorBlau, mkAdpc False AvsCardColorRot, mkAdpc True $ AvsCardColorMisc "Pink"]
              , AvsStatusPerson (AvsPersonId 2       ) $ Set.singleton $ mkAdpc True AvsCardColorGrün
              ] <> 
              [ AvsStatusPerson  avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
#else
  let statQry = avsLicenceDifferences2LicenceIds lDiff
  lStat <- if getStatus && notNull statQry 
            then -- throwLeftM $ avsQueryStatus $ AvsQueryStatus statQry -- don't throw up here, licence differences are too important! TODO: Warn in Problem-Handler
              avsQueryStatus (AvsQueryStatus statQry) >>= \case 
                Left err -> do
                  addMessage Error $ toHtml $ "avsQueryStatus failed for " <> tshow (length statQry) <> " requests with: \n" <> tshow err <> "\nREQUEST:\n" <> tshow statQry
                  return $ AvsResponseStatus mempty 
                Right res -> return res
            else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
#endif
  return (lDiff, avsResponseStatusMap lStat)

  
getDifferingLicences :: AvsResponseGetLicences -> Handler AvsLicenceDifferences
getDifferingLicences (AvsResponseGetLicences licences) = do
  now <- liftIO getCurrentTime
  --let (vorfeld, nonvorfeld) = Set.partition (`avsPersonLicenceIs` AvsLicenceVorfeld)  licences
  --     rollfeld             = Set.filter    (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
  -- Note: FRADrive users with 'R' also own 'F' qualification, but AvsGetResponseGetLicences yields only either
  let vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence)      licences
      rollfeld'      = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) vorORrollfeld'
      vorORrollfeld  = Set.map avsLicencePersonID vorORrollfeld'
      rollfeld       = Set.map avsLicencePersonID rollfeld'

      antijoinAvsLicences :: AvsLicence -> Set AvsPersonId -> DB (Set AvsPersonId,Set AvsPersonId)
      antijoinAvsLicences lic avsLics = fmap unwrapIds $
       E.select $ do
        ((_qauli :& _qualUser :& usrAvs) :& excl) <-
          E.from $ (      E.table @Qualification
            `E.innerJoin` E.table @QualificationUser
            `E.on` ( \(quali :& qualUser) ->
                    (quali E.^. QualificationId         E.==. qualUser E.^. QualificationUserQualification)
                -- NOTE: filters on the innerJoin must be part of ON-condition in order for anti-join to work!
              E.&&. (quali E.^. QualificationAvsLicence E.==. E.justVal lic)                  -- correct type of licence
              E.&&. (now `validQualification` qualUser)                                       -- currently valid and not blocked              
              )
            `E.innerJoin` E.table @UserAvs
            `E.on` (\(_ :& qualUser :& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
          ) `E.fullOuterJoin` E.toValues (set2NonEmpty avsPersonIdZero avsLics) -- left-hand side produces all currently valid matching qualifications
            `E.on` (\((_ :& _ :& usrAvs) :& excl) -> usrAvs E.?. UserAvsPersonId E.==. excl)
        E.where_ $ E.isNothing excl E.||. E.isNothing (usrAvs E.?. UserAvsPersonId)           -- anti join
        return (usrAvs E.?. UserAvsPersonId, excl)

      unwrapIds :: [(E.Value (Maybe AvsPersonId), E.Value (Maybe AvsPersonId))] -> (Set AvsPersonId, Set AvsPersonId)
      unwrapIds = mapBoth (Set.delete avsPersonIdZero) . foldr aux mempty
        where
          aux (_, E.Value(Just api)) (l,r) = (l, Set.insert api r) -- we may assume here that each pair contains precisely one Just constructor
          aux (E.Value(Just api), _) (l,r) = (Set.insert api l, r)
          aux _ acc = acc -- should never occur

  ((vorfGrant, vorfRevoke), (rollGrant, rollRevoke)) <- runDB $ (,)
    <$> antijoinAvsLicences AvsLicenceVorfeld  vorORrollfeld
    <*> antijoinAvsLicences AvsLicenceRollfeld rollfeld
  let setTo0      = vorfRevoke                    -- revoke driving licences 
      setTo1up    = vorfGrant Set.\\ rollGrant    -- grant apron driving licence
      setTo1down  = rollRevoke Set.\\ vorfRevoke  -- revoke maneuvering area licence, but retain apron driving licence 
      setTo2      = (rollGrant Set.\\ vorfRevoke) `Set.intersection` (vorfGrant `Set.union` vorORrollfeld) -- grant maneuvering driving licence
  return AvsLicenceDifferences
    { avsLicenceDiffRevokeAll      = setTo0
    , avsLicenceDiffGrantVorfeld   = setTo1up
    , avsLicenceDiffRevokeRollfeld = setTo1down
    , avsLicenceDiffGrantRollfeld  = setTo2
    } 
    {- Cases to consider (AVS_Licence,has_valid_F, has_valid_R) -> (vorfeld@(toset,unset), rollfeld@(toset,unset)) :
        A (0,0,0)  -> ((_,_),(_,_)) : nop; avs_id not returned from queries, no problem
        B (0,0,1)  -> ((_,_),(x,_)) : nop; do nothing     -- CHECK since id is returned by roll-query
        C (0,1,0)  -> ((x,_),(_,_)) : set F for id
        D (0,1,1)  -> ((x,_),(x,_)) : set R for id
        E (1,0,0)  -> ((_,x),(_,_)) : set 0 for id
        F (1,0,1)  -> ((_,x),(x,_)) : set 0 for id
        G (1,1,0)  -> ((_,_),(_,_)) : nop
        H (1,1,1)  -> ((_,_),(x,_)) : set R for id
        I (2,0,0)  -> ((_,x),(_,x)) : set 0 for id
        J (2,0,1)  -> ((_,x),(_,_)) : set 0 for id
        K (2,1,0)  -> ((_,_),(_,x)) : set F for id
        L (2,1,1)  -> ((_,_),(_,_)) : nop

        PROBLEM: B & H in conflict! (Note that nop is automatic except for case B)
        Results:
            set to 0: determined by vorfeld-unset -- zuerst
            set to 1: vorfeld-set && nicht in rollfeld-set || rollfeld-unset && nicht in vorfeld-unset
            set to 2: rollfeld-set && nicht in vorfeld-unset && (in vorfeld-set || AVS_Licence>0 == vorORrollfeld)
    -}

-- | Find or upsert User by AvsCardId (with dot), Fraport PersonalNumber, Fraport Email-Address or by prefixed AvsId or prefixed AvsNo; fail-safe, may or may not update existing users, may insert new users
--   If an existing User with internal number is found, an AVS query is executed
guessAvsUser :: Text -> Handler (Maybe UserId)
guessAvsUser (Text.splitAt 6 -> ("AVSID:", avsidTxt)) = ifMaybeM (readMay avsidTxt) Nothing $ \avsidNr -> 
    let avsid = AvsPersonId avsidNr
        maybeAvsUpsert = maybeCatchAll $ upsertAvsUserById avsid
        extractUid (Entity _ UserAvs{userAvsUser=uid}) = return $ Just uid
    in maybeM maybeAvsUpsert extractUid $ runDB $ getBy $ UniqueUserAvsId avsid
guessAvsUser (Text.splitAt 6 -> ("AVSNO:", avsnoTxt)) = ifMaybeM (readMay avsnoTxt) Nothing $ \avsno ->
    runDB (selectList [UserAvsNoPerson ==. avsno] []) <&> \case 
      [Entity _ UserAvs{userAvsUser=uid}] -> Just uid
      _ -> Nothing
guessAvsUser someid = do 
  let maybeUpsertAvsUserByCard = maybeCatchAll . upsertAvsUserByCard      
  case discernAvsCardPersonalNo someid of    
    Just cid@(Left _cardNo) -> maybeUpsertAvsUserByCard cid
      -- NOTE: card validity might be outdated, so we must always check with avs
      -- maybeM (maybeUpsertAvsUserByCard cid) extractUid $ runDB $ do
      --   let extractUid     (Entity _ UserAvs{userAvsUser=uid}) = return $ Just uid
      --       extractUidCard UserAvsCard{userAvsCardPersonId=avid} = getBy $ UniqueUserAvsId avid
      --   cards <- selectList [UserAvsCardCardNo ==. cardNo] []
      --   case [c | cent <- cards, let c = entityVal cent, avsDataValid (userAvsCardCard c)] of 
      --     [justOneCard] -> maybeM (return Nothing) extractUidCard (return $ Just justOneCard)
      --     _ -> return Nothing
    Just cid@(Right _wholeNumber) -> 
      maybeUpsertAvsUserByCard cid >>= \case
        Nothing -> 
          runDB (selectList [UserCompanyPersonalNumber ==. Just someid] []) >>= \case
            [Entity uid _] -> return $ Just uid
            _              -> return Nothing
        uid -> return uid
    Nothing -> try (runDB $ ldapLookupAndUpsert someid) >>= \case
      Right Entity{entityKey=uid, entityVal=User{userCompanyPersonalNumber=Just persNo}} -> 
        maybeM (return $ Just uid) (return . Just) (maybeUpsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo))
      Right Entity{entityKey=uid} -> return $ Just uid
      other -> do -- attempt to recover by trying other ids
        whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all      
        runDB . runMaybeT $ 
          let someIdent = stripCI someid
          in    MaybeT (getKeyBy $ UniqueEmail          someIdent)
            <|> MaybeT (getKeyBy $ UniqueAuthentication someIdent)

-- | Always update AVS Data, accepts AvsCardId (with dot), Fraport PersonalNumber or Fraport Email-Address
upsertAvsUser :: Text -> Handler (Maybe UserId) -- TODO: change to Entity
upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = maybeCatchAll $ upsertAvsUserByCard someid    -- Note: Right case is any number; it could be AvsCardNumber or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users!
upsertAvsUser otherId = -- attempt LDAP lookup to find by eMail
  try (runDB $ ldapLookupAndUpsert otherId) >>= \case
    Right Entity{entityVal=User{userCompanyPersonalNumber=Just persNo}} -> maybeCatchAll $ upsertAvsUserByCard (Right $ mkAvsInternalPersonalNo persNo)
    other -> do -- attempt to recover by trying other ids
      whenIsLeft other (\(err::SomeException) -> $logInfoS "AVS" $ "upsertAvsUser LDAP error " <> tshow err) -- this line primarily forces exception type to catch-all      
      apid <- runDB . runMaybeT $ do
        let someIdent = stripCI otherId
        uid <-  MaybeT (getKeyBy $ UniqueEmail          someIdent)
            <|> MaybeT (getKeyBy $ UniqueAuthentication someIdent)
        MaybeT $ view (_entityVal . _userAvsPersonId) <<$>> getBy (UniqueUserAvsUser uid)
      ifMaybeM apid Nothing upsertAvsUserById
            

-- | Given CardNo or internal Number, retrieve UserId. Create non-existing users, if possible. Always update.
--   Throws errors if the avsInterface in unavailable or the user is non-unique within external AVS DB.
upsertAvsUserByCard :: Either AvsFullCardNo AvsInternalPersonalNo -> Handler (Maybe UserId) -- Idee: Eingabe ohne Punkt is AvsInternalPersonalNo mit Punkt is Ausweisnummer?!
upsertAvsUserByCard persNo = do
  let qry = case persNo of
              Left AvsFullCardNo{..} -> def{ avsPersonQueryCardNo = Just avsFullCardNo, avsPersonQueryVersionNo = Just avsFullCardVersion }
              Right fpn -> def{ avsPersonQueryInternalPersonalNo = Just fpn }
  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
  AvsResponsePerson adps <- throwLeftM $ avsQueryPerson qry
  case Set.elems adps of
    []      -> throwM AvsPersonSearchEmpty
    (_:_:_) -> throwM AvsPersonSearchAmbiguous
    [AvsDataPerson{avsPersonPersonID=api}] -> upsertAvsUserById api -- always trigger an update
      -- do
        -- mbuid <- runDB $ getBy $ UniqueUserAvsId api
        -- case mbuid of
          -- (Just (Entity _ UserAvs{userAvsUser=uau})) -> return $ Just uau
          -- Nothing -> upsertAvsUserById api



-- | Retrieve and _always_ update user by AvsPersonId. Non-existing users are created. Ignore AVS Licence status! Updates Company, Address, PinPassword
--   Throws errors if the avsInterface in unavailable or the user is non-unique within external AVS DB (should never happen).
upsertAvsUserById :: AvsPersonId -> Handler (Maybe UserId)
upsertAvsUserById api = do
  mbapd <- lookupAvsUser api
  now <- liftIO getCurrentTime
  mbuid <- runDB $ do
    mbuid <- getBy (UniqueUserAvsId api)
    case (mbuid, mbapd) of
      (Nothing, Just AvsDataPerson{..})                         -- FRADriver User does not exist yet, but found in AVS and has Internal Personal Number
        | Just (avsInternalPersonalNo -> persNo) <- canonical avsPersonInternalPersonalNo -> do
            $logInfoS "AVS" $ "Creating new user with avsInternalPersonalNo " <> tshow persNo
            candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] []
            case candidates of
              [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo now Nothing)
              (_:_) -> throwM $ AvsUserAmbiguous api
              [] -> do
                upsRes :: Either SomeException (Entity User)
                  <- try $ ldapLookupAndUpsert persNo
                $logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes
                case upsRes of
                  Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo now Nothing -- pin/addr are updated in next step anyway
                  Left err -> do 
                    $logWarnS "AVS" $ "AVS user with avsInternalPersonalNo " <> tshow persNo <> " not found in LDAP: " <> tshow err
                    return mbuid -- == Nothing -- user could not be created somehow
      (Just Entity{ entityKey = uaid }, _) -> do
        update uaid [ UserAvsLastSynch =. now, UserAvsLastSynchError =. Nothing ] -- mark as updated early, to prevent failed users to clog the synch
        return mbuid
      _other -> return mbuid
  $logInfoS "AVS" $ "upsert prestep result: " <> tshow mbuid <> " --- " <> tshow mbapd
  case (mbuid, mbapd) of
    ( _     , Nothing               ) -> throwM $ AvsUserUnknownByAvs api -- User not found in AVS at all, i.e. no valid card exists yet
    (Nothing, Just AvsDataPerson{avsPersonFirstName= Text.strip -> avsFirstName, avsPersonLastName= Text.strip -> avsSurname, ..}) -> do                               -- No LDAP User, but found in AVS; create new user
      let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
          userFirmAddr= plaintextToStoredMarkup <$> mbCoFirmAddr
          pinCard     = Set.lookupMax avsPersonPersonCards
          userPin     = personCard2pin <$> pinCard
          fakeIdent   = CI.mk $ "AVSID:" <> tshow api
          fakeNo      = CI.mk $ "AVSNO:" <> tshow avsPersonPersonNo          
          newUsr = AddUserData
            { audTitle            = Nothing
            , audFirstName        = avsFirstName
            , audSurname          = avsSurname
            , audDisplayName      = avsFirstName <> Text.cons ' ' avsSurname
            , audDisplayEmail     = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
            , audMatriculation    = Just $ tshow avsPersonPersonNo
            , audSex              = Nothing
            , audBirthday         = Nothing
            , audMobile           = Nothing
            , audTelephone        = Nothing
            , audFPersonalNumber  = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
            , audFDepartment      = Nothing
            , audPostAddress      = userFirmAddr
            , audPrefersPostal    = True
            , audPinPassword      = userPin
            , audEmail = fakeNo    -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
            , audIdent = fakeIdent -- use AvsPersonId instead
            , audAuth  = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personnel number is known
            }
      mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
      whenIsJust mbUid $ \uid -> runDB $ do        
        insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo now Nothing
        forM_ avsPersonPersonCards $ -- save all cards for later comparisons whether an update occurred
        -- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
        -- forM_ cs $  -- only save used cards for the postal address update detection
            \avsCard -> insert_ $ UserAvsCard avsPersonPersonID (getFullCardNo avsCard) avsCard now
        upsertUserCompany uid mbCompany userFirmAddr
      return mbUid

    (Just (Entity _ UserAvs{userAvsUser=uid})
      , Just AvsDataPerson{avsPersonPersonCards, avsPersonInternalPersonalNo, avsPersonPersonNo, avsPersonFirstName= Text.strip -> avsFirstName, avsPersonLastName= Text.strip -> avsSurname}) -> do -- known user, update address and pinPassword
      let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards          
          userFirmAddr    = plaintextToStoredMarkup <$> mbCoFirmAddr
          pinCard         = Set.lookupMax avsPersonPersonCards
          userPin         = personCard2pin <$> pinCard                          
      runDB $ do        
        update uid  [ UserFirstName             =. avsFirstName      -- update in case of name changes via AVS; might be changed again through LDAP
                    , UserSurname               =. avsSurname
                    , UserDisplayName           =. avsFirstName <> Text.cons ' ' avsSurname
                    , UserMatrikelnummer        =. Just (tshow avsPersonPersonNo)  -- TODO: Deactivate this update after Q2/2023; this is only needed since UserMatrikelnummer was used for AVSNO later
                    , UserCompanyPersonalNumber =. avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
                    ]     
        oldCards <- selectList [UserAvsCardPersonId ==. api] []
        let oldAddrs = Set.fromList $ mapMaybe (snd3 . getCompanyAddress . userAvsCardCard . entityVal) oldCards
        unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do  -- update postal address, unless the exact address had been seen before
          encRecipient :: CryptoUUIDUser <- encrypt uid
          $logInfoS "AVS" $ "Postal address updated for" <> tshow encRecipient
          updateWhere [UserId ==. uid] [UserPostAddress =. userFirmAddr, UserPostLastUpdate =. Just now]
        whenIsJust pinCard $ \pCard -> -- update pin, but only if it was unset or set to the value of an old card
          unlessM (exists [UserAvsCardCardNo ==. getFullCardNo pCard]) $ do
            let oldPins = Just . personCard2pin . userAvsCardCard . entityVal <$> oldCards
            updateWhere [UserId ==. uid, UserPinPassword !=. userPin, UserPinPassword <-. oldPins] -- check for old pin ensures that unset/manually set passwords remain unchanged
                        [UserPinPassword =. userPin]
            insert_ $ UserAvsCard api (getFullCardNo pCard) pCard now
        upsertUserCompany uid mbCompany userFirmAddr
        forM_ avsPersonPersonCards $ \aCard -> do
          let fcn = getFullCardNo aCard
          -- probably not efficient, but fixes the problem that AvsCardNo is not unique as assumed before and may get reused
          deleteWhere [UserAvsCardCardNo ==. fcn]
          insert_ $ UserAvsCard
            { userAvsCardPersonId  = api
            , userAvsCardCardNo    = fcn
            , userAvsCardCard      = aCard
            , userAvsCardLastSynch = now
            }
      return $ Just uid


lookupAvsUser :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) =>
                  AvsPersonId -> m (Maybe AvsDataPerson)
lookupAvsUser api = Map.lookup api <$> lookupAvsUsers (Set.singleton api)

-- | retrieves complete avs user records for given AvsPersonIds.
--   Note that this requires several AVS-API queries, since
--    - avsQueryPerson does not support querying an AvsPersonId directly
--    - avsQueryStatus only provides limited information
--   avsQuery is used to obtain all card numbers, which are then queried separately an merged
--   May throw Servant.ClientError or AvsExceptions
--   Does not write to our own DB!
lookupAvsUsers :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX ) =>
                   Set AvsPersonId -> m (Map AvsPersonId AvsDataPerson)
lookupAvsUsers apis = do
  AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
  AvsResponseStatus statuses <- throwLeftM . avsQueryStatus $ AvsQueryStatus apis
  let forFoldlM = $(permuteFun [3,2,1]) foldlM
  forFoldlM statuses mempty $ \acc1 AvsStatusPerson{avsStatusPersonCardStatus=cards} ->
    forFoldlM cards acc1 $ \acc2 AvsDataPersonCard{avsDataCardNo, avsDataVersionNo} -> do
      AvsResponsePerson adps <- throwLeftM . avsQueryPerson $ def{avsPersonQueryCardNo = Just avsDataCardNo, avsPersonQueryVersionNo = Just avsDataVersionNo}
      return $ mergeByPersonId adps acc2


-- | Like `Handler.Utils.getReceivers`, but calls upsertAvsUserById on each user to ensure that postal address is up-to-date
updateReceivers :: UserId -> Handler  (Entity User, [Entity User], Bool)
updateReceivers uid = do
  -- First perform AVS update for receiver
  runDB (getBy (UniqueUserAvsUser uid)) >>= \case 
      Just Entity{entityVal=UserAvs{userAvsPersonId = apid}} -> void . maybeCatchAll $ upsertAvsUserById apid
      Nothing -> return ()    
  -- Retrieve updated user and supervisors now
  (underling :: Entity User, avsSupers :: [(E.Value UserId, E.Value (Maybe AvsPersonId))]) <- runDB $ (,)
    <$> getJustEntity uid    
    <*> (E.select $ do
          (usrSuper :& usrAvs) <-
            E.from $     E.table @UserSupervisor            
            `E.leftJoin` E.table @UserAvs
            `E.on` (\(usrSuper :& userAvs) -> usrSuper E.^. UserSupervisorSupervisor E.=?. userAvs E.?. UserAvsUser)
          E.where_ $ (usrSuper E.^. UserSupervisorUser E.==. E.val uid)
              E.&&.  (usrSuper E.^. UserSupervisorRerouteNotifications)
          pure (usrSuper E.^. UserSupervisorSupervisor, usrAvs E.?. UserAvsPersonId)
        )
  let (superVs, avsIds) = unzip avsSupers
      receiverIDs :: [UserId] = E.unValue <$> superVs      
      toUpdate = Set.fromList $ mapMaybe E.unValue avsIds
      directResult = return (underling, pure underling, True)     -- already contains updated address
  forM_ toUpdate (void . maybeCatchAll . upsertAvsUserById)       -- attempt to update postaddress from AVS  
  if null receiverIDs 
    then directResult
    else do 
      receivers <- runDB $ selectList [UserId <-. receiverIDs] [] -- due to possible address updates, we must runDB once more and cannot join above
      if null receivers
        then directResult
        else return (underling, receivers, uid `elem` (entityKey <$> receivers))
