A solution can be submitted as team

Handler/ShowChallenge.hs

@@ -434,7 +434,9 @@ getChallengeSubmissionR challengeName = do
    let defaultUrl = fromMaybe (defaultRepo scheme repoHost challenge repo maybeUser)
                               ((<> challengeName) <$> (join $ userAltRepoScheme <$> entityVal <$> maybeUser))
 
-   (formWidget, formEnctype) <- generateFormPost $ submissionForm (Just defaultUrl) (defaultBranch scheme) (repoGitAnnexRemote repo)
+   Entity userId _ <- requireAuth
+
+   (formWidget, formEnctype) <- generateFormPost $ submissionForm userId (Just defaultUrl) (defaultBranch scheme) (repoGitAnnexRemote repo)
    challengeLayout True challenge $ challengeSubmissionWidget formWidget formEnctype challenge
 
 
@@ -520,7 +522,7 @@ postChallengeSubmissionJsonR challengeName = do
     Entity userId _ <- requireAuthPossiblyByToken
 
     challengeEnt@(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
-    ((result, _), _) <- runFormPostNoToken $ submissionForm Nothing Nothing Nothing
+    ((result, _), _) <- runFormPostNoToken $ submissionForm userId Nothing Nothing Nothing
     let submissionData' = case result of
           FormSuccess res -> Just res
           _ -> Nothing
@@ -558,7 +560,7 @@ postChallengeSubmissionR challengeName = do
     userId <- requireAuthId
 
     (Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
-    ((result, _), _) <- runFormPost $ submissionForm Nothing Nothing Nothing
+    ((result, _), _) <- runFormPost $ submissionForm userId Nothing Nothing Nothing
     let submissionData' = case result of
           FormSuccess res -> Just res
           _ -> Nothing
@@ -750,7 +752,10 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
                                                                 extractionOptionsExternalLinks = Nothing,
                                                                 extractionOptionsDependencies = Nothing })
 
+      let mTeamId = challengeSubmissionDataTeam challengeSubmissionData
+
       submissionId <- getSubmission userId
+                                   mTeamId
                                    repoId
                                    (repoCurrentCommit repo)
                                    challengeId
@@ -876,8 +881,8 @@ getScoreForOut mainTestId out = do
              Just evaluation -> evaluationScore $ entityVal evaluation
              Nothing -> Nothing
 
-getSubmission :: UserId -> Key Repo -> SHA1 -> Key Challenge -> Text -> Channel -> Handler (Key Submission)
+getSubmission :: UserId -> Maybe TeamId -> Key Repo -> SHA1 -> Key Challenge -> Text -> Channel -> Handler (Key Submission)
-getSubmission userId repoId commit challengeId subDescription chan = do
+getSubmission userId mTeamId repoId commit challengeId subDescription chan = do
   challenge <- runDB $ get404 challengeId
   maybeSubmission <- runDB $ getBy $ UniqueSubmissionRepoCommitChallenge repoId commit challengeId
   case maybeSubmission of
@@ -897,7 +902,7 @@ getSubmission userId repoId commit challengeId subDescription chan = do
         submissionIsPublic=False,
         submissionIsHidden=False,
         submissionVersion=challengeVersion challenge,
-        submissionTeam=Nothing }
+        submissionTeam=mTeamId }
 
 getSubmissionRepo :: UserId -> Key Challenge -> RepoSpec -> Channel -> Handler (Maybe (Key Repo))
 getSubmissionRepo userId challengeId repoSpec chan = getPossiblyExistingRepo checkRepoAvailibility userId challengeId repoSpec chan
@@ -925,16 +930,28 @@ challengeSubmissionWidget formWidget formEnctype challenge = $(widgetFile "chall
 data ChallengeSubmissionData = ChallengeSubmissionData {
   challengeSubmissionDataDescription :: Maybe Text,
   challengeSubmissionDataTags :: Maybe Text,
-  challengeSubmissionDataRepo :: RepoSpec }
+  challengeSubmissionDataRepo :: RepoSpec,
+  challengeSubmissionDataTeam :: Maybe TeamId }
 
 
-submissionForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form ChallengeSubmissionData
+
-submissionForm defaultUrl defBranch defaultGitAnnexRemote = renderBootstrap3 BootstrapBasicForm $ ChallengeSubmissionData
+submissionForm userId defaultUrl defBranch defaultGitAnnexRemote = renderBootstrap3 BootstrapBasicForm $ ChallengeSubmissionData
     <$> aopt textField (fieldWithTooltip MsgSubmissionDescription MsgSubmissionDescriptionTooltip) Nothing
     <*> aopt textField (tagsfs MsgSubmissionTags) Nothing
     <*> (RepoSpec <$> areq textField (bfs MsgSubmissionUrl) defaultUrl
                   <*> areq textField (bfs MsgSubmissionBranch) defBranch
                   <*> aopt textField (bfs MsgSubmissionGitAnnexRemote) (Just defaultGitAnnexRemote))
+    <*> aopt (selectField teams) (bfs MsgAsTeam) Nothing
+    where teams = do
+            myTeams <- 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.asc (team ^. TeamIdent)]
+              E.limit 1
+              return team
+
+            optionsPairs $ map (\t -> (teamIdent $ entityVal t, entityKey t)) myTeams
+
 
 getUserInfoR :: Handler Value
 getUserInfoR = do

Handler/Team.hs

@@ -0,0 +1,79 @@
+module Handler.Team where
+
+import Import
+
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
+
+import Handler.Shared (fieldWithTooltip)
+
+import PersistTeamActionType
+
+import Data.Conduit.Binary
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+
+getMyTeamsR :: Handler Html
+getMyTeamsR = do
+  _ <- requireAuth
+  doMyTeams
+
+data TeamCreationData = TeamCreationData {
+  teamCreationTeamIdent :: Text,
+  teamCreationTeamAvatar :: Maybe FileInfo }
+
+postCreateTeamR :: Handler Html
+postCreateTeamR = do
+  Entity userId _ <- requireAuth
+  ((result, _), _) <- runFormPost createTeamForm
+  case result of
+    FormSuccess teamCreationData -> do
+      runDB $ createTeam userId teamCreationData
+    _ -> do
+      return ()
+  doMyTeams
+
+createTeam :: (PersistStoreWrite backend, MonadUnliftIO m, BaseBackend backend ~ SqlBackend)
+             => Key User -> TeamCreationData -> ReaderT backend m ()
+createTeam userId teamCreationData = do
+  let theIdent = teamCreationTeamIdent teamCreationData
+  let theAvatar = teamCreationTeamAvatar teamCreationData
+
+  avatarBytes <- case theAvatar of
+                  Just avatarFile -> do
+                     fileBytes <- runResourceT $ fileSource avatarFile $$ sinkLbs
+                     return $ Just (S.pack . L.unpack $ fileBytes)
+                  Nothing -> return Nothing
+
+  newTeamId <- insert Team {
+    teamIdent = theIdent,
+    teamAvatar = avatarBytes }
+
+  _ <- insert TeamMember {
+    teamMemberUser = userId,
+    teamMemberTeam = newTeamId,
+    teamMemberIsCaptain = True
+  }
+
+  theNow <- liftIO getCurrentTime
+
+  _ <- insert TeamLog {
+     teamLogStamp = theNow,
+     teamLogActionType = TeamCreation,
+     teamLogAgens = userId,
+     teamLogPatiens = Nothing,
+     teamLogVerificationKey = Nothing
+  }
+
+  return ()
+
+doMyTeams :: Handler Html
+doMyTeams = do
+  (formWidget, formEnctype) <- generateFormPost createTeamForm
+  defaultLayout $ do
+    setTitle "Teams"
+    $(widgetFile "my-teams")
+
+createTeamForm :: Form TeamCreationData
+createTeamForm = renderBootstrap3 BootstrapBasicForm $ TeamCreationData
+    <$> areq textField (fieldWithTooltip MsgTeamIdent MsgTeamIdentTooltip) Nothing
+    <*> fileAFormOpt (bfs MsgAvatar)

config/models

@@ -104,7 +104,7 @@ Submission
     isHidden Bool default=False
     -- challenge version present when the submission was done
     version SHA1
-    team UserId Maybe
+    team TeamId Maybe
     UniqueSubmissionRepoCommitChallenge repo commit challenge
 Variant
     submission SubmissionId

messages/en.msg

@@ -102,3 +102,4 @@ Heal: Heal
 TeamIdent: Team name
 TeamIdentTooltip: Note that it cannot be changed later
 YourTeams: your teams
+AsTeam: As team