fix(avs): import avs users without ldap entry

messages/uniworx/categories/admin/de-de-formal.msg

@@ -52,7 +52,7 @@ BearerTokenAuthorityUsers: Token-Authorität (Benutzer:innen)
 BearerTokenAuthorityUsersTip: Alle angegebenen Benutzer:innen müssen Zugriff auf eine Route haben, damit das Token den Zugriff auf diese Route erlaubt. Der Aussteller muss, bei mit diesem Benutzerinterface erzeugten Tokens, auch Zugriff auf die Route haben (er wird automatisch der Menge von Token-Authoritäten hinzugefügt).
 BearerTokenAuthorityUnknownUser email@UserEmail: Nutzer:in mit E-Mail #{email} ist dem System nicht bekannt
 BearerTokenRoutes: Erlaubte Routen
-BearerTokenRoutesTip: Wenn die Token-Validität nach Routen eingeschränkt und keine Routen angegeben werden, ist das Token nirgends gültig.
+BearerTokenRoutesTip: Wenn die Token-Validität nach Routen eingeschränkt und keine Routen angegeben werden, ist das Token nirgends gültig. Es dürfen nur vollständige, absolute Routen angegeben werden.
 BearerTokenRouteMissing: Route wird benötigt
 BearerTokenRestrictions: Routen-spezifische Einschränkungen
 BearerTokenRestrictRoutes: Token-Validität nach Routen einschränken

messages/uniworx/categories/admin/en-eu.msg

@@ -52,7 +52,7 @@ BearerTokenAuthorityUsers: Authority (users)
 BearerTokenAuthorityUsersTip: All users listed here need to have the requisite permissions to access a route in order for the created token to grant permission to do so as well. The user issuing the token using this interface also needs to have permission to access that route (they are automatically added to the list of authorities).
 BearerTokenAuthorityUnknownUser email: Could not find any user with email #{email}
 BearerTokenRoutes: Permitted routes
-BearerTokenRoutesTip: If the token is restricted to certain routes and no routes are listed, the token is valid nowhere.
+BearerTokenRoutesTip: If the token is restricted to certain routes and no routes are listed, the token is valid nowhere. Routes must be complete and absolute.
 BearerTokenRouteMissing: Route is required
 BearerTokenRestrictions: Route-specific restrictions
 BearerTokenRestrictRoutes: Restrict token to certain routes

models/avs.model

@@ -19,7 +19,7 @@ UserAvs
   noPerson        Int         default=0 -- only needed for manual communication with personnel from Ausweisverwaltungsstelle
   UniqueUserAvsUser user
   UniqueUserAvsId   personId
-  deriving Generic
+  deriving Generic Show
 
 -- Multiple UserAvsCards per UserAvs is possible and not too uncommon.
 -- Purpose of saving cards is to detect external changes in qualifications and postal addresses

src/Handler/Admin/Avs.hs

@@ -325,10 +325,11 @@ getProblemAvsSynchR = do
     Nothing -> return ()
     (Just BtnImportUnknownAvsIds)  -> catchAllAvs $ do 
       res <- forM unknownLicenceOwners $ try . upsertAvsUserById
-      let procRes (Right _)                         = (Sum 1, mempty, mempty, mempty)
+      let procRes (Right _)                           = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
-          procRes (Left (AvsUserAmbiguous api))     = (Sum 0, Set.singleton api, mempty, mempty)
+          --TODO: continue here!
-          procRes (Left (AvsUserUnknownByAvs api))  = (Sum 0, mempty, Set.singleton api, mempty)
+          --procRes (Left (AvsUserAmbiguous api))     = (Sum 0, Set.singleton api, mempty, mempty)
-          procRes (Left err)                        = (Sum 0, mempty, mempty, Set.singleton err)
+          --procRes (Left (AvsUserUnknownByAvs api))  = (Sum 0, mempty, Set.singleton api, mempty)
+          procRes (Left (err :: SomeException))       = (Sum 0, mempty, mempty, Set.singleton $ tshow err)
           (Sum oks, ambis, unkns, errs) = foldMap procRes res
           ms = if oks == numUnknownLicenceOwners then Success else Warning      
       unless (null ambis) $ addMessageModal Error (i18n $ MsgAvsImportAmbiguous $ length ambis) (Right (text2widget $ tshow ambis))

src/Handler/Utils/Avs.hs

@@ -30,7 +30,7 @@ import qualified Data.Map           as Map
 
 import qualified Data.CaseInsensitive as CI
 -- import Auth.LDAP (ldapUserPrincipalName)
-import Foundation.Yesod.Auth (ldapLookupAndUpsert, CampusUserConversionException())
+import Foundation.Yesod.Auth (ldapLookupAndUpsert) -- , CampusUserConversionException())
 
 import Handler.Utils.Company
 import Handler.Users.Add
@@ -335,13 +335,16 @@ upsertAvsUserById api = do
               [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo)
               (_:_) -> throwM $ AvsUserAmbiguous api
               [] -> do
-                upsRes :: Either CampusUserConversionException (Entity User)
+                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 -- pin/addr are updated in next step anyway
-                  _other -> return mbuid -- ==Nothing -- user could not be created somehow
+                  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
       _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{..}) -> do                               -- No LDAP User, but found in AVS; create new user