diff --git a/Foundation.hs b/Foundation.hs index 1ef6100..5a22626 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -186,6 +186,7 @@ instance YesodAuth App where , userIsAdmin = False , userLocalId = Nothing , userIsAnonymous = False + , userAvatar = Nothing } -- You can add other plugins like BrowserID, email or OAuth here diff --git a/Handler/Discussion.hs b/Handler/Discussion.hs index 3cfff2e..08d2e2b 100644 --- a/Handler/Discussion.hs +++ b/Handler/Discussion.hs @@ -11,7 +11,7 @@ import Handler.ShowChallenge import Yesod.Form.Bootstrap3 -data TimelineItem = TimelineItem UTCTime User Markup +data TimelineItem = TimelineItem UTCTime (Entity User) Markup getTime (TimelineItem stamp _ _) = stamp @@ -19,8 +19,11 @@ class ToTimelineItem a where timelineWhen :: a -> UTCTime timelineWhoId :: a -> UserId - timelineWho :: a -> Handler User - timelineWho sItem = runDB $ get404 $ timelineWhoId sItem + timelineWho :: a -> Handler (Entity User) + timelineWho sItem = do + let userId = timelineWhoId sItem + user <- runDB $ get404 userId + return $ Entity userId user timelineWhat :: a -> Handler Markup toTimelineItem :: a -> Handler TimelineItem diff --git a/Handler/YourAccount.hs b/Handler/YourAccount.hs index d94c75a..24ead87 100644 --- a/Handler/YourAccount.hs +++ b/Handler/YourAccount.hs @@ -9,6 +9,12 @@ import Handler.Extract import Text.Regex.TDFA +import Data.Conduit +import Data.Conduit.Binary +import Control.Monad.Trans.Resource (runResourceT) +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L + getYourAccountR :: Handler Html getYourAccountR = do userId <- requireAuthId @@ -30,20 +36,21 @@ postYourAccountR = do accountData = case result of FormSuccess res -> Just res _ -> Nothing - Just (name, localId, sshPubKey) = accountData + Just (name, localId, sshPubKey, avatarFile) = accountData userId <- requireAuthId - updateUserAccount userId name localId sshPubKey + updateUserAccount userId name localId sshPubKey avatarFile user <- runDB $ get404 userId defaultLayout $ do aDomId <- newIdent setTitle "Your account" $(widgetFile "your-account") -yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form (Maybe Text, Maybe Text, Maybe Text) -yourAccountForm maybeName maybeLocalId maybeSshPubKey = renderBootstrap3 BootstrapBasicForm $ (,,) +yourAccountForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form (Maybe Text, Maybe Text, Maybe Text, Maybe FileInfo) +yourAccountForm maybeName maybeLocalId maybeSshPubKey = renderBootstrap3 BootstrapBasicForm $ (,,,) <$> aopt textField (bfs MsgAccountName) (Just maybeName) <*> aopt textField (bfs MsgId) (Just maybeLocalId) <*> aopt textField (bfs MsgSshPubKey) (Just maybeSshPubKey) + <*> fileAFormOpt (bfs MsgAvatar) localIdRegexp = makeRegexOpts defaultCompOpt{newSyntax=True} defaultExecOpt ("\\`[a-z][-a-z0-9]{0,31}\\'" ::String) @@ -58,11 +65,19 @@ isLocalIdAcceptable :: Text -> Bool isLocalIdAcceptable localId = match localIdRegexp (unpack localId) && not (localId `elem` unwantedLocalIds) -updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Handler () -updateUserAccount userId name maybeLocalId maybeSshPubKey = do +updateUserAccount :: Key User -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe FileInfo -> Handler () +updateUserAccount userId name maybeLocalId maybeSshPubKey maybeAvatarFile = do updateJustName userId name + updateAvatar userId maybeAvatarFile updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey + +updateAvatar :: Key User -> Maybe FileInfo -> Handler () +updateAvatar _ Nothing = return () +updateAvatar userId (Just avatarFile) = do + fileBytes <- runResourceT $ fileSource avatarFile $$ sinkLbs + runDB $ update userId [UserAvatar =. Just (S.pack . L.unpack $ fileBytes)] + updateLocalIdAndPubKey :: Key User -> Maybe Text -> Maybe Text -> Handler () updateLocalIdAndPubKey userId (Just localId) maybeSshPubKey = do if isLocalIdAcceptable localId @@ -99,3 +114,14 @@ updateLocalIdAndPubKey _ Nothing Nothing = return () updateJustName :: Key User -> Maybe Text -> Handler () updateJustName userId name = runDB $ update userId [UserName =. name] + + +getAvatarR :: UserId -> Handler TypedContent +getAvatarR userId = do + user <- runDB $ get404 userId + case userAvatar user of + Just avatarBytes -> do + addHeader "Content-Disposition" "attachment; filename=\"avatar.png\"" + sendResponse (typePng, toContent avatarBytes) + Nothing -> do + sendFile typeSvg "static/images/male-avatar.svg" diff --git a/config/models b/config/models index 94a1983..4f0addc 100644 --- a/config/models +++ b/config/models @@ -6,6 +6,7 @@ User isAdmin Bool default=False localId Text Maybe isAnonymous Bool default=False + avatar ByteString Maybe deriving Typeable PublicKey user UserId diff --git a/config/routes b/config/routes index d70085a..c0cdf12 100644 --- a/config/routes +++ b/config/routes @@ -26,3 +26,4 @@ /make-public/#SubmissionId MakePublicR GET /account YourAccountR GET POST +/avatar/#UserId AvatarR GET diff --git a/gonito.cabal b/gonito.cabal index ba52d02..4237345 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -123,6 +123,8 @@ library , wai-handler-fastcgi , blaze-markup , blaze-html + , conduit-extra + , resourcet executable gonito if flag(library-only) diff --git a/messages/en.msg b/messages/en.msg index 1e6d6be..c3fa682 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -23,3 +23,4 @@ Search: search GitCommitSha1: Git commit SHA1 hash CommentText: Write a comment Send: Send +Avatar: avatar diff --git a/templates/timeline-item.hamlet b/templates/timeline-item.hamlet index d7f79d1..3db6328 100644 --- a/templates/timeline-item.hamlet +++ b/templates/timeline-item.hamlet @@ -1,9 +1,9 @@ $case item - $of TimelineItem when who what + $of TimelineItem when (Entity whoId who) what