add avatars

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

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

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"

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

config/routes

@@ -26,3 +26,4 @@
 /make-public/#SubmissionId MakePublicR GET
 
 /account YourAccountR GET POST
+/avatar/#UserId AvatarR GET

gonito.cabal

@@ -123,6 +123,8 @@ library
                  , wai-handler-fastcgi
                  , blaze-markup
                  , blaze-html
+                 , conduit-extra
+                 , resourcet
 
 executable         gonito
     if flag(library-only)

messages/en.msg

@@ -23,3 +23,4 @@ Search: search
 GitCommitSha1: Git commit SHA1 hash
 CommentText: Write a comment
 Send: Send
+Avatar: avatar

templates/timeline-item.hamlet

@@ -1,9 +1,9 @@
 $case item
-  $of TimelineItem when who what
+  $of TimelineItem when (Entity whoId who) what
     <div class="row timeline-item">
       <div class="col-sm-1">
         <div class="timeline-item-thumbnail">
-          <img class="img-responsive user-photo" src="/static/images/male-avatar.svg">
+          <img class="img-responsive user-photo" src=@{AvatarR whoId}>
       <div class="col-sm-11">
         <div .timeline-item-panel>
           <div class="timeline-item-panel-heading">

templates/your-account.hamlet

@@ -2,6 +2,7 @@
     <div id="main" role="main">
         <h2>Your account
         <hr>
+        <img style="max-width:80px;padding-bottom:30px" src=@{AvatarR userId}>
         <form method=post action=@{YourAccountR}#form enctype=#{formEnctype}>
            ^{formWidget}
            <button .btn .btn-primary type="submit">