From 38e82e1ff4641f59e3d954f782c13deeb5f3eb09 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Thu, 28 Mar 2019 12:35:09 +0100
Subject: [PATCH] Introduce deterministic studyTermCandidateIndicence to
 de-duplicate

---
 src/Foundation.hs | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 6ca7c5128..5e8f68dcf 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -26,8 +26,10 @@ import qualified Data.CaseInsensitive as CI
 import qualified Data.CryptoID as E
 
 import Data.ByteArray (convert)
-import Crypto.Hash (Digest, SHAKE256)
+import Crypto.Hash (Digest, SHAKE256, SHAKE128)
 import Crypto.Hash.Conduit (sinkHash)
+import qualified Data.UUID as UUID
+import qualified Data.Binary as Binary
 
 import qualified Data.ByteString.Base64.URL as Base64 (encode)
 
@@ -2122,7 +2124,6 @@ instance YesodAuth UniWorX where
                           [ UserLastAuthentication =. Just now | not isDummy ]
 
           userId <- lift $ entityKey <$> upsertBy uAuth newUser userUpdate
-          studyTermCandidateIncidence <- liftIO getRandom
 
           let
             userStudyFeatures = fmap concat . forM userStudyFeatures' $ parseStudyFeatures userId now
@@ -2143,11 +2144,27 @@ instance YesodAuth UniWorX where
           fs <- either (\err -> throwError . ServerError $ "Could not parse features of study: " <> err) return userStudyFeatures
 
           let
-            studyTermCandidates = do
-              studyTermCandidateName <- termNames
-              StudyFeatures{ studyFeaturesField = StudyTermsKey' studyTermCandidateKey } <- fs
-              return StudyTermCandidate{..}
-          lift $ insertMany_ studyTermCandidates
+            studyTermCandidates = Set.fromList $ do
+              name <- termNames
+              StudyFeatures{ studyFeaturesField = StudyTermsKey' key } <- fs
+              return (key, name)
+            studyTermCandidateIncidence
+              = fromMaybe (error "Could not convert studyTermCandidateIncidence-Hash to UUID")
+              . UUID.fromByteString
+              . fromStrict
+              . (convert :: Digest (SHAKE128 128) -> ByteString)
+              . runIdentity
+              $ sourceList (toStrict . Binary.encode <$> Set.toList studyTermCandidates) $$ sinkHash
+
+          [E.Value candidatesRecorded] <- lift . E.select . return . E.exists . E.from $ \candidate ->
+            E.where_ $ candidate E.^. StudyTermCandidateIncidence E.==. E.val studyTermCandidateIncidence
+
+          unless candidatesRecorded $ do
+            let
+              studyTermCandidates'' = do
+                (studyTermCandidateKey, studyTermCandidateName) <- Set.toList studyTermCandidates'
+                return StudyTermCandidate{..}
+            lift $ insertMany_ studyTermCandidates''
 
           lift $ E.updateWhere [StudyFeaturesUser ==. userId] [StudyFeaturesValid =. False]
           forM_ fs $ \f@StudyFeatures{..} -> do