From e80f72d7416a8f998564aec68307a8ce9c719595 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Tue, 3 May 2016 10:21:40 +0200
Subject: [PATCH] add avatars

---
 Foundation.hs                  |  1 +
 Handler/Discussion.hs          |  9 +++++---
 Handler/YourAccount.hs         | 38 ++++++++++++++++++++++++++++------
 config/models                  |  1 +
 config/routes                  |  1 +
 gonito.cabal                   |  2 ++
 messages/en.msg                |  1 +
 templates/timeline-item.hamlet |  4 ++--
 templates/your-account.hamlet  |  1 +
 9 files changed, 47 insertions(+), 11 deletions(-)

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
     <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">
diff --git a/templates/your-account.hamlet b/templates/your-account.hamlet
index e363350..7247125 100644
--- a/templates/your-account.hamlet
+++ b/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">