Dump submissions

This commit is contained in:
Gregor Kleen 2017-10-11 00:18:09 +02:00
parent 11895f6709
commit f7f7c7c592
8 changed files with 57 additions and 1 deletions

1
models
View File

@ -98,6 +98,7 @@ Submission
changed UTCTime
createdBy UserId
changedBy UserId
deriving Show
SubmissionFile
submissionId SubmissionId
fileId FileId

3
routes
View File

@ -18,5 +18,8 @@
/course/#TermIdentifier/#Text/edit CourseEditExistR GET
/course/#TermIdentifier/#Text/show CourseShowR GET
/submission SubmissionListR GET
/submission/#CryptoUUIDSubmission SubmissionR GET POST
-- For demonstration
/course/#CryptoUUIDCourse/edit CourseEditExistIDR GET

View File

@ -44,6 +44,7 @@ import Handler.Home
import Handler.Profile
import Handler.Term
import Handler.Course
import Handler.Submission
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

View File

@ -173,6 +173,8 @@ instance Yesod UniWorX where
isAuthorized CourseListR _ = return Authorized
isAuthorized (CourseShowR _ _) _ = return Authorized
isAuthorized (CourseListTermR _) _ = return Authorized
isAuthorized SubmissionListR _ = return Authorized
isAuthorized (SubmissionR _) _ = return Authorized
-- TODO: change to Assistants
isAuthorized TermEditR _ = return Authorized
isAuthorized (TermEditExistR _) _ = return Authorized
@ -232,6 +234,9 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb (CourseShowR term course) = return (course, Just $ CourseListTermR term)
breadcrumb CourseEditR = return ("Neu", Just CourseListR)
breadcrumb (CourseEditExistR _ _) = return ("Editieren", Just CourseListR)
breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
breadcrumb (SubmissionR _) = return ("Abgabe", Just SubmissionListR)
breadcrumb HomeR = return ("ReWorX", Nothing)
breadcrumb (AuthR _) = return ("Login", Just HomeR)

39
src/Handler/Submission.hs Normal file
View File

@ -0,0 +1,39 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
module Handler.Submission where
import Import
import Handler.Utils
import qualified Data.UUID.Cryptographic as UUID
getSubmissionListR :: Handler Html
getSubmissionListR = do
entityList <- runDB $ selectList [] []
cIDKey <- getsYesod appCryptoIDKey
let
cryptEntity :: Entity Submission -> Handler (CryptoUUIDSubmission, Submission)
cryptEntity (Entity key val) = (, val) <$> UUID.encrypt cIDKey (traceShowId key)
submissionList <- mapM cryptEntity entityList
defaultLayout $(widgetFile "submission-list")
getSubmissionR, postSubmissionR :: CryptoUUIDSubmission -> Handler Html
getSubmissionR = postSubmissionR
postSubmissionR cID = do
cIDKey <- getsYesod appCryptoIDKey
submissionID <- UUID.decrypt cIDKey cID
submission <- runDB $ get404 (submissionID :: Key Submission)
defaultLayout $ do
[whamlet|<pre>#{tshow submission}|]

View File

@ -12,6 +12,9 @@ import Handler.Utils.Bootstrap3 as Handler.Utils
import Handler.Utils.Form as Handler.Utils
import Handler.Utils.Table as Handler.Utils
import Handler.Utils.Zip as Handler.Utils
import Handler.Utils.Zip.Rating as Handler.Utils
tickmark :: IsString a => a
tickmark = fromString ""

View File

@ -10,7 +10,7 @@ extra-deps:
- colonnade-1.1.1
- yesod-colonnade-1.1.0
- zip-stream-0.1.0.1
- uuid-crypto-1.2.0.0
- uuid-crypto-1.3.0.0
- cryptoids-0.3.0.0
- cryptoids-types-0.0.0
resolver: lts-9.3

View File

@ -0,0 +1,4 @@
<ul>
$forall (cID, val) <- submissionList
<li>
<a href=@{SubmissionR cID}>#{tshow $ ciphertext cID}