diff --git a/Foundation.hs b/Foundation.hs index 43f942b..779175c 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -163,6 +163,10 @@ instance Yesod App where isAuthorized CreateResetLinkR _ = isAdmin isAuthorized (ScoreR _) _ = isAdmin + isAuthorized ListArchivedChallengesR _ = isAdmin + isAuthorized (ArchiveR _) _ = isAdmin + isAuthorized (UnarchiveR _) _ = isAdmin + isAuthorized MyScoreR _ = return Authorized isAuthorized (ResetPasswordR _) _ = return Authorized diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs index 4d4098a..bdede88 100644 --- a/Handler/CreateChallenge.hs +++ b/Handler/CreateChallenge.hs @@ -120,7 +120,8 @@ addChallenge name publicRepoId privateRepoId chan = do challengeDescription=(T.pack $ description), challengeStamp=time, challengeImage=mImage, - challengeStarred=False} + challengeStarred=False, + challengeArchived=Just False} updateTests challengeId chan return () diff --git a/Handler/ListChallenges.hs b/Handler/ListChallenges.hs index 3ef1b60..8ca727c 100644 --- a/Handler/ListChallenges.hs +++ b/Handler/ListChallenges.hs @@ -3,8 +3,13 @@ module Handler.ListChallenges where import Import getListChallengesR :: Handler Html -getListChallengesR = do - challenges <- runDB $ selectList [] [Desc ChallengeStarred, Desc ChallengeStamp] +getListChallengesR = generalListChallenges [ChallengeArchived !=. Just True] + +getListArchivedChallengesR :: Handler Html +getListArchivedChallengesR = generalListChallenges [ChallengeArchived ==. Just True] + +generalListChallenges filterExpr = do + challenges <- runDB $ selectList filterExpr [Desc ChallengeStarred, Desc ChallengeStamp] defaultLayout $ do setTitle "List challenges" $(widgetFile "list-challenges") diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 0542eba..b7b8630 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -18,6 +18,7 @@ import Handler.Tables import Handler.TagUtils import Handler.MakePublic import Handler.Dashboard +import Handler.Common import Gonito.ExtractMetadata (ExtractionOptions(..), extractMetadataFromRepoDir, @@ -54,11 +55,10 @@ getShowChallengeR name = do app <- getYesod let leaderboardStyle = appLeaderboardStyle $ appSettings app - (Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name + challengeEnt@(Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name Just repo <- runDB $ get $ challengePublicRepo challenge (leaderboard, (entries, tests)) <- getLeaderboardEntries leaderboardStyle challengeId mauth <- maybeAuth - let muserId = (\(Entity uid _) -> uid) <$> mauth let params = getNumericalParams entries @@ -66,8 +66,9 @@ getShowChallengeR name = do challengeRepo <- runDB $ get404 $ challengePublicRepo challenge - challengeLayout True challenge (showChallengeWidget muserId - challenge scheme + challengeLayout True challenge (showChallengeWidget mauth + challengeEnt + scheme challengeRepo repo leaderboard @@ -89,8 +90,8 @@ challengeReadme name = do contents <- liftIO $ System.IO.readFile readmeFilePath return $ markdown def $ TL.pack contents -showChallengeWidget :: Maybe UserId - -> Challenge +showChallengeWidget :: Maybe (Entity User) + -> Entity Challenge -> RepoScheme -> Repo -> Repo @@ -98,8 +99,8 @@ showChallengeWidget :: Maybe UserId -> [Text] -> [Entity Test] -> WidgetFor App () -showChallengeWidget muserId - challenge +showChallengeWidget mUserEnt + (Entity challengeId challenge) scheme challengeRepo repo @@ -111,6 +112,7 @@ showChallengeWidget muserId maybeRepoLink = getRepoLink repo delta = Number 4 higherTheBetterArray = getIsHigherTheBetterArray $ map entityVal tests + mUserId = entityKey <$> mUserEnt getRepoLink :: Repo -> Maybe Text getRepoLink repo @@ -180,6 +182,22 @@ challengeHowTo challenge settings repo shownId isIDSet isSSHUploaded mToken = $( SelfHosted -> "master" :: Text _ -> "my-brilliant-branch" +postArchiveR :: ChallengeId -> Handler Html +postArchiveR challengeId = doSetArchive True challengeId + +postUnarchiveR :: ChallengeId -> Handler Html +postUnarchiveR challengeId = doSetArchive False challengeId + +doSetArchive :: Bool -> ChallengeId -> Handler Html +doSetArchive status challengeId = do + runDB $ update challengeId [ChallengeArchived =. Just status] + challenge <- runDB $ get404 challengeId + getShowChallengeR $ challengeName challenge + + +archiveForm :: ChallengeId -> Form ChallengeId +archiveForm challengeId = renderBootstrap3 BootstrapBasicForm $ areq hiddenField "" (Just challengeId) + getChallengeSubmissionR :: Text -> Handler Html getChallengeSubmissionR name = do (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name @@ -235,14 +253,20 @@ trigger userId challengeName url mBranch mGitAnnexRemote = do Just (Entity challengeId _) -> runOpenViewProgress $ doCreateSubmission userId challengeId Nothing Nothing RepoSpec {repoSpecUrl=url, - repoSpecBranch=branch, - repoSpecGitAnnexRemote=mGitAnnexRemote} + repoSpecBranch=branch, + repoSpecGitAnnexRemote=mGitAnnexRemote} Nothing -> return $ toTypedContent (("Unknown challenge `" ++ (Data.Text.unpack challengeName) ++ "`. Cannot be triggered, must be submitted manually at Gonito.net!\n") :: String) doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler () doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do - maybeRepoKey <- getSubmissionRepo userId challengeId repoSpec chan - case maybeRepoKey of + challenge <- runDB $ get404 challengeId + doCreateSubmission' (challengeArchived challenge) userId challengeId mDescription mTags repoSpec chan + +doCreateSubmission' :: Maybe Bool -> UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler () +doCreateSubmission' (Just True) _ _ _ _ _ chan = msg chan "This challenge is archived, you cannot submit to it. Ask the site admin to unarchive it." +doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do + maybeRepoKey <- getSubmissionRepo userId challengeId repoSpec chan + case maybeRepoKey of Just repoId -> do challenge <- runDB $ get404 challengeId diff --git a/config/models b/config/models index 00557ce..71d52d9 100644 --- a/config/models +++ b/config/models @@ -39,6 +39,7 @@ Challenge stamp UTCTime default=now() image ByteString Maybe starred Bool + archived Bool Maybe Test challenge ChallengeId metric Metric diff --git a/config/routes b/config/routes index de38217..f67f04a 100644 --- a/config/routes +++ b/config/routes @@ -10,6 +10,7 @@ /view-progress/#Int ViewProgressR GET /open-view-progress/#Int OpenViewProgressR GET /list-challenges ListChallengesR GET +/list-archived-challenges ListArchivedChallengesR GET /challenge-image/#ChallengeId ChallengeImageR GET /challenge/#Text ShowChallengeR GET @@ -36,6 +37,9 @@ /hide-submission/#SubmissionId HideSubmissionR GET /restore-submission/#SubmissionId RestoreSubmissionR GET +/challenge-archive/#ChallengeId ArchiveR POST +/challenge-unarchive/#ChallengeId UnarchiveR POST + /account YourAccountR GET POST /avatar/#UserId AvatarR GET /create-reset-link CreateResetLinkR GET POST diff --git a/messages/en.msg b/messages/en.msg index 05d6f8d..1b7bff0 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -76,3 +76,4 @@ TargetValue: target value to be reached before the target date Test: test Dashboard: dashboard TargetName: target name +ShowArchivedChallenges: show archived challenges diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index b079e18..4d09fa4 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -27,6 +27,7 @@
  • _{MsgCreateChallenge}
  • _{MsgCreateResetLink}
  • _{MsgAddExtraPoints} +
  • _{MsgShowArchivedChallenges}