fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(test): resepect uniqueness for ldap, 2nd attempt

Browse Source
This commit is contained in:
Steffen Jost 2023-06-19 10:13:34 +00:00
parent 22426db241
commit d06448a4a8
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
test/Handler/Utils/SubmissionSpec.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de> -- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
@ -48,10 +48,10 @@ makeUsers (fromIntegral -> n) = do
users' <- liftIO . replicateM n $ generate arbitrary users' <- liftIO . replicateM n $ generate arbitrary
users <- forM users' $ \u -> do users <- forM users' $ \u -> do
i <- atomically $ readTVar userNumber <* modifyTVar userNumber succ i <- atomically $ readTVar userNumber <* modifyTVar userNumber succ
let baseid = CI.mk $ "user." <> tshow i let baseid = "user." <> tshow i
u' = u { userIdent = baseid u' = u { userIdent = CI.mk baseid
, userEmail = baseid <> "@example.com" , userEmail = CI.mk $ baseid <> "@example.com"
, userLdapPrimaryKey = baseid <> ".ldap" , userLdapPrimaryKey = Just $ baseid <> ".ldap"
} }
return u' return u'
uids <- insertMany users uids <- insertMany users
@ -102,18 +102,19 @@ distributionExample mkParameters setupHook cont = do
mapM_ (\(n, (subs, corrs)) -> setupHook n subs corrs) . zip [1..] $ map snd situations mapM_ (\(n, (subs, corrs)) -> setupHook n subs corrs) . zip [1..] $ map snd situations
situations' <- forM situations $ \(sid, (submissions, sheetCorrectors)) -> (sid, ) <$> do -- situations' <-
forM situations $ \(sid, (submissions, sheetCorrectors)) -> (sid, ) <$> do
submissions' <- mapM (fmap fromJust . getEntity . entityKey) submissions submissions' <- mapM (fmap fromJust . getEntity . entityKey) submissions
sheetCorrectors' <- mapM (fmap fromJust . getEntity . entityKey) sheetCorrectors sheetCorrectors' <- mapM (fmap fromJust . getEntity . entityKey) sheetCorrectors
return (submissions', sheetCorrectors') return (submissions', sheetCorrectors')
return situations' -- return situations'
let let
subIds :: [SubmissionId] subIds :: [SubmissionId]
subIds = concatMap (\(_, (subs, _)) -> mapMaybe (\(Entity subId Submission{..}) -> guardOn (is _Nothing submissionRatingBy) subId) subs) situations subIds = concatMap (\(_, (subs, _)) -> mapMaybe (\(Entity subId Submission{..}) -> guardOn (is _Nothing submissionRatingBy) subId) subs) situations
results <- runHandler . Yesod.runDB . mapM (\sid -> assignSubmissions sid Nothing) $ map fst situations results <- runHandler . Yesod.runDB $ mapM ((`assignSubmissions` Nothing) . fst) situations
submissions <- fmap concat . forM results $ \(assigned, unassigned) -> runDB $ selectList ([ SubmissionId <-. Set.toList assigned ] ||. [ SubmissionId <-. Set.toList unassigned ]) [] submissions <- fmap concat . forM results $ \(assigned, unassigned) -> runDB $ selectList ([ SubmissionId <-. Set.toList assigned ] ||. [ SubmissionId <-. Set.toList unassigned ]) []
@ -122,7 +123,7 @@ distributionExample mkParameters setupHook cont = do
Set.union assigned unassigned `shouldBe` Set.fromList subIds Set.union assigned unassigned `shouldBe` Set.fromList subIds
cont . Map.fromListWith mappend $ do cont . Map.fromListWith mappend $ do
Entity subId Submission{..} <- submissions Entity subId Submission{..} <- submissions
let key = listToMaybe . filter (\(Entity _ (SheetCorrector uid _ _ _)) -> Just uid == submissionRatingBy) $ concatMap (\(_, (_, corrs)) -> corrs) situations let key = find (\ (Entity _ (SheetCorrector uid _ _ _)) -> Just uid == submissionRatingBy) $ concatMap (\(_, (_, corrs)) -> corrs) situations
sheet = getFirst . foldMap (\(n, (sid, _)) -> First $ guardOn (sid == submissionSheet) n) $ zip [1..] situations sheet = getFirst . foldMap (\(n, (sid, _)) -> First $ guardOn (sid == submissionSheet) n) $ zip [1..] situations
return (entityVal <$> key, Set.singleton (subId, sheet)) return (entityVal <$> key, Set.singleton (subId, sheet))