diff --git a/config/mimetypes b/config/mimetypes
index 5d3158e6e..552a57179 100644
--- a/config/mimetypes
+++ b/config/mimetypes
@@ -736,6 +736,7 @@ text/vnd.in3d.spot spot
text/vnd.sun.j2me.app-descriptor jad
text/vnd.wap.wml wml
text/vnd.wap.wmlscript wmls
+text/vnd.yaml yaml yml
text/x-asm s asm
text/x-c hh h dic cc
text/x-component htc
diff --git a/frontend/src/utils/alerts/alerts.sass b/frontend/src/utils/alerts/alerts.sass
index 937ddc42f..c55829aab 100644
--- a/frontend/src/utils/alerts/alerts.sass
+++ b/frontend/src/utils/alerts/alerts.sass
@@ -98,10 +98,10 @@
padding: 8px 0
min-height: 40px
position: relative
- display: flex
font-weight: 600
align-items: center
text-align: left
+ overflow: auto
.alert__icon
text-align: right
diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 190b73635..361eff638 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -704,6 +704,7 @@ RatingSubmissionException smid@CryptoFileNameSubmission: Beim Verarbeiten der Be
RatingYAMLExceptionBeforeComment: Beim Interpretieren des YAML-Teils (zum Abtrennen des Kommentars) ist folgender Fehler aufgetreten:
RatingYAMLException: Beim Interpretieren des YAML-Teils ist folgender Fehler aufgetreten:
RatingYAMLCommentNotUnicode: Der enthaltene Kommentar konnte nicht als UTF-8 dekodiert werden:
+RatingYAMLNotUnicode: Der enthaltene YAML-Teil konnte nicht als UTF-8 dekodiert werden:
RatingYAMLStreamTerminatedUnexpectedly: Event-Stream unerwartet abgebrochen
RatingYAMLDocumentEndIllDefined: Position des Endes des YAML-Teils nicht wohldefiniert
RatingSubmissionIDIncorrect: Die in der Bewertungsdatei enthaltene Abgabenummer passt nicht zum Dateinamen
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index 7a37a0cae..f2635b4ba 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -701,6 +701,7 @@ RatingSubmissionException smid: While processing the rating file for the submiss
RatingYAMLExceptionBeforeComment: While parsing the YAML part (to separate out the rating comment) the following error occurred:
RatingYAMLException: While parsing the YAML part the following error occurred:
RatingYAMLCommentNotUnicode: The contained rating comment could not be UTF-8 decoded:
+RatingYAMLNotUnicode: The contained YAML part could not be decoded as UTF-8:
RatingYAMLStreamTerminatedUnexpectedly: Event stream terminated unexpectedly
RatingYAMLDocumentEndIllDefined: End of YAML part has no well defined position
RatingSubmissionIDIncorrect: The submission id contained within the rating file does not match it's name
diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs
index 2d845e0d8..ec622fad0 100644
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@@ -26,6 +26,8 @@ import Handler.Utils.Rating.Format
import qualified Data.Set as Set
import qualified Data.CaseInsensitive as CI
+import qualified Data.Char as Char
+
validateRating :: SheetType -> Rating' -> [RatingValidityException]
validateRating ratingSheetType Rating'{ ratingPoints=Just rp, .. }
@@ -104,6 +106,7 @@ type SubmissionContent = Either File (SubmissionId, Rating')
extractRatings :: ( MonadHandler m
, HandlerSite m ~ UniWorX
+
) => ConduitT File SubmissionContent m ()
extractRatings = Conduit.mapM $ \f@File{..} -> liftHandler $ do
msId <- isRatingFile fileTitle
@@ -121,13 +124,16 @@ isRatingFile :: forall m.
( MonadHandler m
, HandlerSite m ~ UniWorX
) => FilePath -> m (Maybe SubmissionId)
-isRatingFile fName = liftHandler $
- fmap getFirst . flip foldMapM segments' $ fmap First . tryDecrypt
+isRatingFile (takeFileName -> fName) = liftHandler . runMaybeT $ do
+ app <- getYesod
+ (cID, subId) <- MaybeT . fmap getFirst . flip foldMapM segments' $ fmap First . tryDecrypt
+ guard $ isRatingFileName app cID
+ return subId
where
- tryDecrypt :: Text -> Handler (Maybe SubmissionId)
+ tryDecrypt :: Text -> Handler (Maybe (CryptoFileNameSubmission, SubmissionId))
tryDecrypt ciphertext
| Just cID <- fromPathPiece ciphertext
- = (Just <$> decrypt (cID :: CryptoFileNameSubmission)) `catch` decryptErrors
+ = (Just . (cID, ) <$> decrypt cID) `catch` decryptErrors
| otherwise
= return Nothing
@@ -140,3 +146,19 @@ isRatingFile fName = liftHandler $
cryptoIdChars :: Set (CI Char)
cryptoIdChars = Set.fromList . map CI.mk $ "uwa" ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
+
+ isRatingFileName app cID = is _Just $ do
+ [CI.mk -> dWord, number, CI.mk -> extension] <- pure . filter (not . Text.null) . Text.split (not . Char.isAlphaNum) $ Text.pack fName
+ guard $ Text.all (flip Set.member cryptoIdChars . CI.mk) number
+ cID' <- fromPathPiece number
+ guard $ cID' == cID
+ let ratingTexts = map (flip (renderMessage app) (MsgRatingFileTitle cID) . pure) $ toList appLanguages
+ ratingWords = Set.fromList $ do
+ (pack . ensureExtension extensionRating . unpack -> ratingText) <- ratingTexts
+ (CI.mk -> dWord') : _ <- pure . filter (not . Text.null) . Text.split (not . Char.isAlphaNum) $ Text.pack ratingText
+ return dWord'
+ guard $ dWord `Set.member` ratingWords
+ let canonExtension = Set.singleton $ CI.mk (pack extensionRating)
+ validExtensions = foldMap (Set.map CI.mk . mimeExtensions) ["application/json", "text/vnd.yaml"]
+ guard $ extension `Set.member` Set.union canonExtension validExtensions
+ where ensureExtension ext fName' = bool (`addExtension` ext) id (ext `isExtensionOf` fName') fName'
diff --git a/src/Handler/Utils/Rating/Format.hs b/src/Handler/Utils/Rating/Format.hs
index a34391a45..b26e022fa 100644
--- a/src/Handler/Utils/Rating/Format.hs
+++ b/src/Handler/Utils/Rating/Format.hs
@@ -35,6 +35,8 @@ import Control.Monad.Trans.State.Lazy (evalState)
import qualified System.FilePath.Cryptographic as Explicit
+import Control.Exception (ErrorCall(..))
+
data PrettifyState
= PrettifyInitial
@@ -191,7 +193,7 @@ instance ns ~ CryptoIDNamespace (CI FilePath) SubmissionId => YAML.FromYAML (May
parseRating :: MonadCatch m => File -> m (Rating', Maybe CryptoFileNameSubmission)
-parseRating f@File{ fileContent = Just (fromStrict -> input), .. } = handle onFailure . handle (throwM . RatingParseException) $ do
+parseRating f@File{ fileContent = Just (fromStrict -> input), .. } = handle onFailure . handle (throwM . RatingParseException) . handleIf isYAMLUnicodeError (\(ErrorCall msg) -> throwM $ RatingYAMLNotUnicode msg) $ do
let evStream = YAML.Event.parseEvents input
delimitDocument = do
ev <- maybe (throwM RatingYAMLStreamTerminatedUnexpectedly) return =<< await
@@ -207,12 +209,14 @@ parseRating f@File{ fileContent = Just (fromStrict -> input), .. } = handle onFa
Left err -> throwM $ RatingYAMLCommentNotUnicode err
Right ct -> return . assertM' (not . Text.null) . Text.strip $ toStrict ct
let yamlInput = Lazy.ByteString.take documentEnd input
- case YAML.decode1 yamlInput of
+ res <- case YAML.decode1 yamlInput of
Left (pos, errStr) -> throwM . RatingYAMLException $ YAML.prettyPosWithSource pos yamlInput errStr
Right cb -> return $ cb (Just fileModified) ratingComment
+ return $!! res
where
onFailure (e :: RatingException)
= ((, Nothing) <$> Legacy.parseRating f) `catch` \case
RatingParseLegacyException _ -> throwM e
other -> throwM other
+ isYAMLUnicodeError (ErrorCall msg) = "UTF" `isPrefixOf` msg
parseRating _ = throwM RatingFileIsDirectory
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index 6612c6f16..f36a1158f 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -485,6 +485,11 @@ msgSubmissionErrors = flip catches
#{tshow unicodeErr}
+ $of RatingYAMLNotUnicode unicodeErr
+ _{MsgRatingYAMLNotUnicode}
+
+
+ #{unicodeErr}
|]
RatingParseLegacyException pExc
-> [whamlet|
diff --git a/src/Model/Rating.hs b/src/Model/Rating.hs
index d1ca14da4..c0a89ec82 100644
--- a/src/Model/Rating.hs
+++ b/src/Model/Rating.hs
@@ -16,6 +16,7 @@ data Rating = Rating
, ratingSheetType :: SheetType
, ratingValues :: Rating'
} deriving (Read, Show, Eq, Generic, Typeable)
+ deriving anyclass (NFData)
data Rating' = Rating'
{ ratingPoints :: Maybe Points
@@ -23,6 +24,7 @@ data Rating' = Rating'
, ratingTime :: Maybe UTCTime
, ratingDone :: Bool
} deriving (Read, Show, Eq, Generic, Typeable)
+ deriving anyclass (NFData)
data RatingValidityException
= RatingNegative -- ^ Rating points must be non-negative
@@ -47,6 +49,7 @@ data RatingParseException
| RatingYAMLExceptionBeforeComment String -- ^ Could not parse YAML to determine where rating comments begin
| RatingYAMLException String -- ^ Could not parse YAML
| RatingYAMLCommentNotUnicode UnicodeException
+ | RatingYAMLNotUnicode String
deriving (Show, Eq, Generic, Typeable)
deriving anyclass (Exception)
diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs
index db1a8f9d7..16942e98a 100644
--- a/src/Model/Types/DateTime.hs
+++ b/src/Model/Types/DateTime.hs
@@ -27,8 +27,7 @@ import Data.Aeson.Types as Aeson
data Season = Summer | Winter
deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic, Typeable)
-
-instance Binary Season
+ deriving anyclass (Binary, Universe, Finite, NFData)
seasonToChar :: Season -> Char
seasonToChar Summer = 'S'
@@ -47,8 +46,7 @@ data TermIdentifier = TermIdentifier
{ year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
, season :: Season
} deriving (Show, Read, Eq, Ord, Generic, Typeable)
-
-instance Binary TermIdentifier
+ deriving anyclass (Binary, NFData)
instance Enum TermIdentifier where
-- ^ Do not use for conversion – Enumeration only
diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs
index 99b5e521d..a35553fa9 100644
--- a/src/Model/Types/Sheet.hs
+++ b/src/Model/Types/Sheet.hs
@@ -29,6 +29,7 @@ data SheetGrading
| PassBinary -- non-zero means passed
| PassAlways
deriving (Eq, Ord, Read, Show, Generic)
+ deriving anyclass (NFData)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece
@@ -115,6 +116,7 @@ data SheetType
| Bonus { grading :: SheetGrading }
| Informational { grading :: SheetGrading }
deriving (Eq, Ord, Read, Show, Generic)
+ deriving anyclass (NFData)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece