From e98d7849f6cf789de0d9d43aa413f93fa6a289a4 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 18 Jul 2018 16:52:10 +0200
Subject: [PATCH] Additional info in sinkSubmission-Exceptions

---
 src/Handler/Utils/Submission.hs | 32 +++++++++++++++++++++++++++-----
 1 file changed, 27 insertions(+), 5 deletions(-)

diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index a337f59d3..0bed9cd36 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -186,7 +186,7 @@ instance Monoid SubmissionSinkState where
 data SubmissionSinkException = DuplicateFileTitle FilePath
                              | DuplicateRating
                              | RatingWithoutUpdate
-                             | ForeignRating
+                             | ForeignRating CryptoFileNameSubmission
   deriving (Typeable, Show)
 
 instance Exception SubmissionSinkException
@@ -277,7 +277,9 @@ sinkSubmission userId mExists isUpdate = do
       Right (submissionId', Rating'{..}) -> do
         $logDebugS "sinkSubmission" $ tshow submissionId'
 
-        unless (submissionId' == submissionId) $ throwM ForeignRating
+        unless (submissionId' == submissionId) $ do
+          cID <- encrypt submissionId'
+          throwM $ ForeignRating cID
         
         alreadySeen <- gets $ getAny . sinkSeenRating
         when alreadySeen $ throwM DuplicateRating
@@ -373,6 +375,16 @@ sinkSubmission userId mExists isUpdate = do
               , SubmissionRatingComment =. Nothing
               ]
 
+data SubmissionMultiSinkException
+  = SubmissionSinkException
+    { submissionSinkId :: CryptoFileNameSubmission
+    , submissionSinkFedFile :: Maybe FilePath
+    , submissionSinkException :: SubmissionSinkException
+    }                                   
+  deriving (Typeable, Show)
+
+instance Exception SubmissionMultiSinkException
+
 sinkMultiSubmission :: UserId
                     -> Bool {-^ Are these corrections -}
                     -> Sink SubmissionContent (YesodDB UniWorX) (Set SubmissionId)
@@ -411,7 +423,10 @@ sinkMultiSubmission userId isUpdate = do
         Left _ -> error "sinkSubmission returned prematurely"
         Right nSink -> modify $ Map.insert sId nSink
   sinks <- execStateLC Map.empty . awaitForever $ \case
-    v@(Right (sId, _)) -> lift $ feed sId v
+    v@(Right (sId, _)) -> do
+      cID <- encrypt sId
+      handle (throwM . SubmissionSinkException cID Nothing) $
+        lift $ feed sId v
     (Left f@File{..})  -> do
       let
         tryDecrypt :: FilePath -> _ (Either SomeException SubmissionId)
@@ -422,8 +437,15 @@ sinkMultiSubmission userId isUpdate = do
           return . either (const id) (set _1 . Just) msId $ (Nothing, fp)
       (msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
       $logDebugS "sinkMultiSubmission" $ tshow (splitDirectories fileTitle, msId, fileTitle')
-      lift . maybe (const $ return ()) feed msId $ Left f{ fileTitle = fileTitle' }
-  fmap Map.keysSet . lift $ mapM (void . closeResumableSink) sinks
+      case msId of
+        Nothing -> $logDebugS "sinkMultiSubmission" "Dropped"
+        Just sId -> do
+          cID <- encrypt sId
+          handle (throwM . SubmissionSinkException cID (Just fileTitle)) $
+            lift . feed sId $ Left f{ fileTitle = fileTitle' }
+  fmap Map.keysSet . lift . sequence $ flip Map.mapWithKey sinks $ \sId sink -> do
+    cID <- encrypt sId
+    handle (throwM . SubmissionSinkException cID Nothing) . void $ closeResumableSink sink
 
 submissionMatchesSheet :: TermId -> Text -> Text -> CryptoFileNameSubmission -> DB ()
 submissionMatchesSheet tid csh shn cid = do