diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 3fff5527e..59614fd5a 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -86,7 +86,7 @@ getAdminProblemsR = do
getProblemUnreachableR :: Handler Html
getProblemUnreachableR = do
- unreachables <- runDB retrieveUnreachableUsers'
+ unreachables <- runDB retrieveUnreachableUsers
siteLayoutMsg MsgProblemsUnreachableHeading $ do
setTitleI MsgProblemsUnreachableHeading
[whamlet|
@@ -95,7 +95,7 @@ getProblemUnreachableR = do
$forall usr <- unreachables
-
- ^{linkUserWidget ForProfileR usr} (#{usr ^. _userDisplayEmail} / #{usr ^. _userEmail})
+ ^{linkUserWidget ForProfileDataR usr} (#{usr ^. _userDisplayEmail} / #{usr ^. _userEmail})
|]
getProblemFbutNoR :: Handler Html
@@ -142,31 +142,30 @@ mkUnreachableUsersTable = do
-}
areAllUsersReachable :: DB Bool
--- areAllUsersReachable = isNothing <$> E.selectOne retrieveUnreachableUsers
-areAllUsersReachable = E.selectNotExists retrieveUnreachableUsers
+-- areAllUsersReachable = isNothing <$> E.selectOne retrieveUnreachableUsers'
+-- areAllUsersReachable = E.selectNotExists retrieveUnreachableUsers'
+areAllUsersReachable = null <$> retrieveUnreachableUsers
+
+-- retrieveUnreachableUsers' :: E.SqlQuery (E.SqlExpr (Entity User))
+-- retrieveUnreachableUsers' = do
+-- user <- E.from $ E.table @User
+-- E.where_ $ E.isNothing (user E.^. UserPostAddress)
+-- E.&&. (E.isNothing (user E.^. UserCompanyDepartment) E.||. user E.^. UserCompanyPersonalNumber `E.ilike` E.justVal "E%")
+-- E.&&. E.not_ ((user E.^. UserDisplayEmail) `E.like` E.val "%@%.%")
+-- E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%")
+-- return user
-retrieveUnreachableUsers :: E.SqlQuery (E.SqlExpr (Entity User))
-retrieveUnreachableUsers = do
- user <- E.from $ E.table @User
- E.where_ $ E.isNothing (user E.^. UserPostAddress)
- E.&&. E.isNothing (user E.^. UserCompanyDepartment)
- E.&&. E.not_ ((user E.^. UserDisplayEmail) `E.like` E.val "%@%.%")
- E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%")
- return user
-
-retrieveUnreachableUsers' :: DB [Entity User]
-retrieveUnreachableUsers' = do
- obviousUnreachable <- E.select retrieveUnreachableUsers
- emailUsers <- E.select $ do
- user <- E.from $ E.table @User
- E.where_ $ E.isNothing (user E.^. UserPostAddress)
- E.&&. E.isNothing (user E.^. UserCompanyDepartment)
- E.&&. ( ((user E.^. UserDisplayEmail) `E.like` E.val "%@%.%")
- E.||. ((user E.^. UserEmail) `E.like` E.val "%@%.%"))
- pure user
- let hasInvalidEmail = isNothing . getEmailAddress . entityVal
- invaldEmail = filter hasInvalidEmail emailUsers
- return $ obviousUnreachable ++ invaldEmail
+retrieveUnreachableUsers :: DB [Entity User]
+retrieveUnreachableUsers = do
+ emailOnlyUsers <- E.select $ do
+ user <- E.from $ E.table @User
+ E.where_ $ E.isNothing (user E.^. UserPostAddress)
+ E.&&. (E.isNothing (user E.^. UserCompanyDepartment) E.||. user E.^. UserCompanyPersonalNumber `E.ilike` E.justVal "E%")
+ return user
+ return $ filter hasInvalidEmail emailOnlyUsers
+ where
+ hasInvalidEmail = isNothing . getEmailAddress . entityVal
+
allDriversHaveAvsId :: Day -> DB Bool
-- allDriversHaveAvsId = fmap isNothing . E.selectOne . retrieveDriversWithoutAvsId
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 183a051ae..c9dd1dbca 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -358,7 +358,126 @@ fillDb = do
, userExamOfficeGetSynced = False
, userExamOfficeGetLabels = True
}
-
+ _stranger1 <- insert User
+ { userIdent = "AVSID:996699"
+ , userAuthentication = AuthLDAP
+ , userLastAuthentication = Nothing
+ , userTokensIssuedAfter = Nothing
+ , userMatrikelnummer = Nothing
+ , userEmail = "E996699@fraport.de"
+ , userDisplayEmail = ""
+ , userDisplayName = "Stranger One"
+ , userSurname = "One"
+ , userFirstName = "Stranger"
+ , userTitle = Nothing
+ , userMaxFavourites = userDefaultMaxFavourites
+ , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
+ , userTheme = ThemeMossGreen
+ , userDateTimeFormat = userDefaultDateTimeFormat
+ , userDateFormat = userDefaultDateFormat
+ , userTimeFormat = userDefaultTimeFormat
+ , userDownloadFiles = userDefaultDownloadFiles
+ , userWarningDays = userDefaultWarningDays
+ , userLanguages = Nothing
+ , userNotificationSettings = def
+ , userCreated = now
+ , userLastLdapSynchronisation = Nothing
+ , userLdapPrimaryKey = Nothing
+ , userCsvOptions = def
+ , userSex = Just SexMale
+ , userBirthday = Nothing
+ , userShowSex = userDefaultShowSex
+ , userTelephone = Nothing
+ , userMobile = Nothing
+ , userCompanyPersonalNumber = Just "E996699"
+ , userCompanyDepartment = Just "AVN-Strange"
+ , userPinPassword = Nothing
+ , userPostAddress = Nothing
+ , userPostLastUpdate = Nothing
+ , userPrefersPostal = False
+ , userExamOfficeGetSynced = False
+ , userExamOfficeGetLabels = True
+ }
+ _stranger2 <- insert User
+ { userIdent = "AVSID:669966"
+ , userAuthentication = AuthLDAP
+ , userLastAuthentication = Nothing
+ , userTokensIssuedAfter = Nothing
+ , userMatrikelnummer = Nothing
+ , userEmail = "E669966@fraport.de"
+ , userDisplayEmail = ""
+ , userDisplayName = "Stranger Two"
+ , userSurname = "Stranger"
+ , userFirstName = "Two"
+ , userTitle = Nothing
+ , userMaxFavourites = userDefaultMaxFavourites
+ , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
+ , userTheme = ThemeMossGreen
+ , userDateTimeFormat = userDefaultDateTimeFormat
+ , userDateFormat = userDefaultDateFormat
+ , userTimeFormat = userDefaultTimeFormat
+ , userDownloadFiles = userDefaultDownloadFiles
+ , userWarningDays = userDefaultWarningDays
+ , userLanguages = Nothing
+ , userNotificationSettings = def
+ , userCreated = now
+ , userLastLdapSynchronisation = Nothing
+ , userLdapPrimaryKey = Nothing
+ , userCsvOptions = def
+ , userSex = Just SexMale
+ , userBirthday = Nothing
+ , userShowSex = userDefaultShowSex
+ , userTelephone = Nothing
+ , userMobile = Nothing
+ , userCompanyPersonalNumber = Just "669966"
+ , userCompanyDepartment = Just "AVN-Strange"
+ , userPinPassword = Nothing
+ , userPostAddress = Nothing
+ , userPostLastUpdate = Nothing
+ , userPrefersPostal = False
+ , userExamOfficeGetSynced = False
+ , userExamOfficeGetLabels = True
+ }
+ _stranger3 <- insert User
+ { userIdent = "AVSID:6969"
+ , userAuthentication = AuthLDAP
+ , userLastAuthentication = Nothing
+ , userTokensIssuedAfter = Nothing
+ , userMatrikelnummer = Nothing
+ , userEmail = "E6969@fraport.de"
+ , userDisplayEmail = ""
+ , userDisplayName = "Stranger 3 Three"
+ , userSurname = "Three"
+ , userFirstName = "Stranger"
+ , userTitle = Nothing
+ , userMaxFavourites = userDefaultMaxFavourites
+ , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
+ , userTheme = ThemeMossGreen
+ , userDateTimeFormat = userDefaultDateTimeFormat
+ , userDateFormat = userDefaultDateFormat
+ , userTimeFormat = userDefaultTimeFormat
+ , userDownloadFiles = userDefaultDownloadFiles
+ , userWarningDays = userDefaultWarningDays
+ , userLanguages = Nothing
+ , userNotificationSettings = def
+ , userCreated = now
+ , userLastLdapSynchronisation = Nothing
+ , userLdapPrimaryKey = Nothing
+ , userCsvOptions = def
+ , userSex = Just SexMale
+ , userBirthday = Nothing
+ , userShowSex = userDefaultShowSex
+ , userTelephone = Nothing
+ , userMobile = Nothing
+ , userCompanyPersonalNumber = Just "E996699"
+ , userCompanyDepartment = Just "AVN-Strange"
+ , userPinPassword = Nothing
+ , userPostAddress = Just $ markdownToStoredMarkup ("Kartoffelweg 12 \n666 Höllensumpf \nFreiland"::Text)
+ , userPostLastUpdate = Nothing
+ , userPrefersPostal = False
+ , userExamOfficeGetSynced = False
+ , userExamOfficeGetLabels = True
+ }
let
firstNames = [ "James", "John", "Robert", "Michael"
, "William", "David", "Mary", "Richard"
@@ -419,8 +538,8 @@ fillDb = do
, userShowSex = userDefaultShowSex
, userTelephone = Nothing
, userMobile = Nothing
- , userCompanyPersonalNumber = Nothing
- , userCompanyDepartment = Nothing
+ , userCompanyPersonalNumber = bool Nothing (Just "E123" ) (even $ length firstName)
+ , userCompanyDepartment = bool Nothing (Just "AVN-A") (even $ length userSurname)
, userPinPassword = Nothing
, userPostAddress = Nothing
, userPostLastUpdate = Nothing