feat(ratings): i18n rating file names

This commit is contained in:
Gregor Kleen 2020-06-16 12:15:56 +02:00
parent 69c61a4bb4
commit 1195231bc3
3 changed files with 32 additions and 20 deletions

View File

@ -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
ValueRequiredLabeledMultiWord fieldLabel@Text: „#{fieldLabel}“ wird benötigt
RatingFileTitle subId@CryptoFileNameSubmission: bewertung_#{toPathPiece subId}.txt

View File

@ -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

View File

@ -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"