From 1195231bc3d3502fa4f77db64d30f2138cd7fa20 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 16 Jun 2020 12:15:56 +0200
Subject: [PATCH] feat(ratings): i18n rating file names

---
 messages/uniworx/de-de-formal.msg |  4 ++-
 messages/uniworx/en-eu.msg        |  2 ++
 src/Handler/Utils/Rating.hs       | 46 ++++++++++++++++++-------------
 3 files changed, 32 insertions(+), 20 deletions(-)

diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 496e65092..3a21c6d4d 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -2614,4 +2614,6 @@ TestDownloadInTransaction: Generierung während Datenbank-Transaktion
 TestDownloadFromDatabase: Generierung während Download aus Datenbank
 
 ValueRequiredLabeledSimple fieldLabel@Text: #{fieldLabel} wird benötigt
-ValueRequiredLabeledMultiWord fieldLabel@Text: „#{fieldLabel}“ wird benötigt
\ No newline at end of file
+ValueRequiredLabeledMultiWord fieldLabel@Text: „#{fieldLabel}“ wird benötigt
+
+RatingFileTitle subId@CryptoFileNameSubmission: bewertung_#{toPathPiece subId}.txt
\ No newline at end of file
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index eef83a3a3..54a6c5340 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -2615,3 +2615,5 @@ TestDownloadFromDatabase: Generate while streaming from database
 
 ValueRequiredLabeledSimple fieldLabel: #{fieldLabel} is required
 ValueRequiredLabeledMultiWord fieldLabel: “#{fieldLabel}” is required
+
+RatingFileTitle subId: rating_#{toPathPiece subId}.txt
diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs
index 1a605e49f..16b82dc03 100644
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@@ -17,14 +17,15 @@ import qualified Data.Text as Text
 
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 
-import qualified System.FilePath.Cryptographic as FilePath (decrypt)
-
 import qualified Database.Esqueleto as E
 
 import qualified Data.Conduit.List as Conduit
 
 import Handler.Utils.Rating.Format
 
+import qualified Data.Set as Set
+import qualified Data.CaseInsensitive as CI
+
 
 validateRating :: SheetType -> Rating' -> [RatingException]
 validateRating ratingSheetType Rating'{ ratingPoints=Just rp, .. }
@@ -76,13 +77,21 @@ getRating submissionId = runMaybeT $ do
 
   return Rating{ ratingValues = Rating'{..}, .. }
 
-ratingFile :: MonadIO m => CryptoFileNameSubmission -> Rating -> m File
+extensionRating :: String
+extensionRating = "txt"
+
+ratingFile :: ( MonadHandler m
+              , HandlerSite m ~ UniWorX
+              )
+           => CryptoFileNameSubmission -> Rating -> m File
 ratingFile cID rating@Rating{ ratingValues = Rating'{..}, .. } = do
+  MsgRenderer mr <- getMsgRenderer
   fileModified <- maybe (liftIO getCurrentTime) return ratingTime
   let
-    fileTitle = "bewertung_" <> Text.unpack (toPathPiece cID) <.> "txt"
+    fileTitle = ensureExtension extensionRating . unpack . mr $ MsgRatingFileTitle cID
     fileContent = Just . Lazy.ByteString.toStrict $ formatRating cID rating
   return File{..}
+  where ensureExtension ext fName = bool (`addExtension` ext) id (ext `isExtensionOf` fName) fName
 
 type SubmissionContent = Either File (SubmissionId, Rating')
 
@@ -98,27 +107,26 @@ extractRatings = Conduit.mapM $ \f@File{..} -> do
         -> handle (throwM . RatingFileException fileTitle) $ Right . (sId, ) <$> parseRating f
       | otherwise -> return $ Left f
 
-isRatingFile :: ( MonadHandler m
+isRatingFile :: forall m.
+                ( MonadHandler m
                 , HandlerSite m ~ UniWorX
-                , MonadCatch m
                 ) => FilePath -> m (Maybe SubmissionId)
-isRatingFile fName
-  | Just cID <- isRatingFile' fName = do
-      cIDKey <- getsYesod appCryptoIDKey
-      (Just <$> FilePath.decrypt cIDKey cID) `catch` decryptErrors
-  | otherwise = return Nothing
+isRatingFile fName = liftHandler $
+  fmap getFirst . flip foldMapM segments' $ fmap First . tryDecrypt
   where
+    tryDecrypt :: Text -> Handler (Maybe SubmissionId)
+    tryDecrypt ciphertext
+      | Just cID <- fromPathPiece ciphertext
+      = (Just <$> decrypt (cID :: CryptoFileNameSubmission)) `catch` decryptErrors
+      | otherwise
+      = return Nothing
 
     decryptErrors (CiphertextConversionFailed _) = return Nothing
     decryptErrors InvalidNamespaceDetected       = return Nothing
     decryptErrors DeserializationError           = return Nothing
     decryptErrors err                            = throwM err
 
-isRatingFile' :: FilePath -> Maybe CryptoFileNameSubmission
-isRatingFile' (takeFileName -> fName)
-  | (bName, ".txt") <- splitExtension fName
-  , Just piece <- stripPrefix "bewertung_" bName
-  , Just cID <- fromPathPiece $ Text.pack piece
-  = Just cID
-  | otherwise
-  = Nothing
+    segments' = filter (not . Text.null) . Text.split (flip Set.notMember cryptoIdChars . CI.mk) . Text.pack $ takeFileName fName
+
+    cryptoIdChars :: Set (CI Char)
+    cryptoIdChars = Set.fromList . map CI.mk $ "uwa" ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"