80 lines
2.2 KiB
Haskell
80 lines
2.2 KiB
Haskell
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)
|