Introduce deterministic studyTermCandidateIndicence to de-duplicate

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
+            studyTermCandidates = Set.fromList $ do
-              studyTermCandidateName <- termNames
+              name <- termNames
-              StudyFeatures{ studyFeaturesField = StudyTermsKey' studyTermCandidateKey } <- fs
+              StudyFeatures{ studyFeaturesField = StudyTermsKey' key } <- fs
-              return StudyTermCandidate{..}
+              return (key, name)
-          lift $ insertMany_ studyTermCandidates
+            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