Add AUTO_TEAM option
This commit is contained in:
parent
96d03875d7
commit
ed06220ce0
@ -580,7 +580,9 @@ getChallengeSubmissionR challengeName = do
|
|||||||
|
|
||||||
Entity userId _ <- requireAuth
|
Entity userId _ <- requireAuth
|
||||||
|
|
||||||
(formWidget, formEnctype) <- generateFormPost $ submissionForm userId (Just defaultUrl) (defaultBranch scheme) (repoGitAnnexRemote repo)
|
defaultTeam <- fetchDefaultTeam userId
|
||||||
|
|
||||||
|
(formWidget, formEnctype) <- generateFormPost $ submissionForm userId (Just defaultUrl) (defaultBranch scheme) (repoGitAnnexRemote repo) (Just defaultTeam)
|
||||||
challengeLayout True challenge $ challengeSubmissionWidget formWidget formEnctype challenge
|
challengeLayout True challenge $ challengeSubmissionWidget formWidget formEnctype challenge
|
||||||
|
|
||||||
|
|
||||||
@ -666,7 +668,7 @@ postChallengeSubmissionJsonR challengeName = do
|
|||||||
Entity userId _ <- requireAuthPossiblyByToken
|
Entity userId _ <- requireAuthPossiblyByToken
|
||||||
|
|
||||||
challengeEnt@(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
|
challengeEnt@(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
|
||||||
((result, _), _) <- runFormPostNoToken $ submissionForm userId Nothing Nothing Nothing
|
((result, _), _) <- runFormPostNoToken $ submissionForm userId Nothing Nothing Nothing Nothing
|
||||||
let submissionData' = case result of
|
let submissionData' = case result of
|
||||||
FormSuccess res -> Just res
|
FormSuccess res -> Just res
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
@ -704,7 +706,7 @@ postChallengeSubmissionR challengeName = do
|
|||||||
userId <- requireAuthId
|
userId <- requireAuthId
|
||||||
|
|
||||||
(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
|
(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
|
||||||
((result, _), _) <- runFormPost $ submissionForm userId Nothing Nothing Nothing
|
((result, _), _) <- runFormPost $ submissionForm userId Nothing Nothing Nothing Nothing
|
||||||
let submissionData' = case result of
|
let submissionData' = case result of
|
||||||
FormSuccess res -> Just res
|
FormSuccess res -> Just res
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
@ -897,7 +899,9 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
|
|||||||
extractionOptionsExternalLinks = Nothing,
|
extractionOptionsExternalLinks = Nothing,
|
||||||
extractionOptionsDependencies = Nothing })
|
extractionOptionsDependencies = Nothing })
|
||||||
|
|
||||||
let mTeamId = challengeSubmissionDataTeam challengeSubmissionData
|
mTeamId <- case challengeSubmissionDataTeam challengeSubmissionData of
|
||||||
|
Just tid -> return $ Just tid
|
||||||
|
Nothing -> fetchDefaultTeam userId
|
||||||
|
|
||||||
submissionId <- getSubmission userId
|
submissionId <- getSubmission userId
|
||||||
mTeamId
|
mTeamId
|
||||||
@ -1079,22 +1083,34 @@ data ChallengeSubmissionData = ChallengeSubmissionData {
|
|||||||
challengeSubmissionDataTeam :: Maybe TeamId }
|
challengeSubmissionDataTeam :: Maybe TeamId }
|
||||||
|
|
||||||
|
|
||||||
|
fetchUserTeams :: (YesodPersist site, BackendCompatible SqlBackend (YesodPersistBackend site), PersistQueryRead (YesodPersistBackend site), PersistUniqueRead (YesodPersistBackend site)) => Key User -> HandlerFor site [Entity Team]
|
||||||
|
fetchUserTeams userId = runDB $ E.select $ E.from $ \(team, teamMember) -> do
|
||||||
|
E.where_ (teamMember ^. TeamMemberTeam E.==. team ^. TeamId
|
||||||
|
E.&&. teamMember ^. TeamMemberUser E.==. E.val userId)
|
||||||
|
E.orderBy [E.desc (teamMember ^. TeamMemberIsCaptain), E.asc (team ^. TeamIdent)]
|
||||||
|
return team
|
||||||
|
|
||||||
submissionForm userId defaultUrl defBranch defaultGitAnnexRemote = renderBootstrap3 BootstrapBasicForm $ ChallengeSubmissionData
|
fetchDefaultTeam :: Key User -> HandlerFor App (Maybe (Key Team))
|
||||||
|
fetchDefaultTeam userId = do
|
||||||
|
myTeams <- fetchUserTeams userId
|
||||||
|
app <- getYesod
|
||||||
|
let autoTeam = appAutoTeam $ appSettings app
|
||||||
|
if autoTeam
|
||||||
|
then
|
||||||
|
return $ entityKey <$> listToMaybe myTeams
|
||||||
|
else
|
||||||
|
return Nothing
|
||||||
|
|
||||||
|
|
||||||
|
submissionForm userId defaultUrl defBranch defaultGitAnnexRemote defaultTeam = renderBootstrap3 BootstrapBasicForm $ ChallengeSubmissionData
|
||||||
<$> aopt textField (fieldWithTooltip MsgSubmissionDescription MsgSubmissionDescriptionTooltip) Nothing
|
<$> aopt textField (fieldWithTooltip MsgSubmissionDescription MsgSubmissionDescriptionTooltip) Nothing
|
||||||
<*> aopt textField (tagsfs MsgSubmissionTags) Nothing
|
<*> aopt textField (tagsfs MsgSubmissionTags) Nothing
|
||||||
<*> (RepoSpec <$> areq textField (bfs MsgSubmissionUrl) defaultUrl
|
<*> (RepoSpec <$> areq textField (bfs MsgSubmissionUrl) defaultUrl
|
||||||
<*> areq textField (bfs MsgSubmissionBranch) defBranch
|
<*> areq textField (bfs MsgSubmissionBranch) defBranch
|
||||||
<*> aopt textField (bfs MsgSubmissionGitAnnexRemote) (Just defaultGitAnnexRemote))
|
<*> aopt textField (bfs MsgSubmissionGitAnnexRemote) (Just defaultGitAnnexRemote))
|
||||||
<*> aopt (selectField teams) (bfs MsgAsTeam) Nothing
|
<*> aopt (selectField teams) (bfs MsgAsTeam) defaultTeam
|
||||||
where teams = do
|
where teams = do
|
||||||
myTeams <- runDB $ E.select $ E.from $ \(team, teamMember) -> do
|
myTeams <- fetchUserTeams userId
|
||||||
E.where_ (teamMember ^. TeamMemberTeam E.==. team ^. TeamId
|
|
||||||
E.&&. teamMember ^. TeamMemberUser E.==. E.val userId)
|
|
||||||
E.orderBy [E.asc (team ^. TeamIdent)]
|
|
||||||
E.limit 1
|
|
||||||
return team
|
|
||||||
|
|
||||||
optionsPairs $ map (\t -> (teamIdent $ entityVal t, entityKey t)) myTeams
|
optionsPairs $ map (\t -> (teamIdent $ entityVal t, entityKey t)) myTeams
|
||||||
|
|
||||||
|
|
||||||
|
@ -110,6 +110,10 @@ data AppSettings = AppSettings
|
|||||||
-- ^ Take the team name from a given metadata field
|
-- ^ Take the team name from a given metadata field
|
||||||
-- Currently makes sense only when JWT token is used
|
-- Currently makes sense only when JWT token is used
|
||||||
, appTeamField :: Maybe Text
|
, appTeamField :: Maybe Text
|
||||||
|
-- ^ Automatically assign the team.
|
||||||
|
-- The team for which the user is the captain
|
||||||
|
-- will be preferred
|
||||||
|
, appAutoTeam :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
instance FromJSON AppSettings where
|
instance FromJSON AppSettings where
|
||||||
@ -161,6 +165,8 @@ instance FromJSON AppSettings where
|
|||||||
|
|
||||||
appTeamField <- o .:? "team-field"
|
appTeamField <- o .:? "team-field"
|
||||||
|
|
||||||
|
appAutoTeam <- o .:? "auto-team" .!= False
|
||||||
|
|
||||||
return AppSettings {..}
|
return AppSettings {..}
|
||||||
|
|
||||||
-- | Settings for 'widgetFile', such as which template languages to support and
|
-- | Settings for 'widgetFile', such as which template languages to support and
|
||||||
|
@ -76,4 +76,7 @@ json-web-key: "_env:JSON_WEB_KEY"
|
|||||||
# If one of these is set, it is not considered a part of the username.
|
# If one of these is set, it is not considered a part of the username.
|
||||||
team-field: "_env:TEAM_FIELD"
|
team-field: "_env:TEAM_FIELD"
|
||||||
|
|
||||||
|
# Whether to automatically assign teams for submissions.
|
||||||
|
auto-team: "_env:AUTO_TEAM:false"
|
||||||
|
|
||||||
#analytics: UA-YOURCODE
|
#analytics: UA-YOURCODE
|
||||||
|
Loading…
Reference in New Issue
Block a user