From: fr33domlover <[email protected]>
Until now, if there is no avatar URL, no other source is used to display an
avatar. With this commit, if there is no avatar URL but the user does have a
verified email address, the email address is passed through libravatar to get
an avatar URL from it.
Things to consider modifying:
- Fallback URL (currently none is specified)
- Size (currently it's the default, 80)
- HTTPS (currently an HTTP URL is generated)
---
Snowdrift.cabal | 1 +
View/User.hs | 11 +++++++++++
stack.yaml | 2 ++
templates/user.hamlet | 2 +-
4 files changed, 15 insertions(+), 1 deletion(-)
diff --git a/Snowdrift.cabal b/Snowdrift.cabal
index 8e3c553..d610cd6 100644
--- a/Snowdrift.cabal
+++ b/Snowdrift.cabal
@@ -200,6 +200,7 @@ library
, http-types
-- Oh yeah!
, lens
+ , libravatar
, lifted-base
, mime-mail
, monad-logger
diff --git a/View/User.hs b/View/User.hs
index 7fbbc24..51ec69a 100644
--- a/View/User.hs
+++ b/View/User.hs
@@ -26,6 +26,8 @@ import Widgets.ProjectPledges
import qualified Data.Map as M
import qualified Data.Set as S
import Data.String (fromString)
+import qualified Data.Text as T
+import Network.Libravatar (avatarUrl)
createUserForm :: Maybe Text -> Form (Text, Text, Maybe Text, Maybe Text,
Maybe Text, Maybe Text)
createUserForm ident extra = do
@@ -142,6 +144,15 @@ renderUser mviewer_id user_id user projects_and_roles = do
then Just <$> handlerToWidget (generateFormPost establishUserForm)
else return Nothing
+ let libravatar email = avatarUrl (Left email) False Nothing Nothing
+ avatarFinal <- liftIO $
+ case (userAvatar user, userEmail user, userEmail_verified user) of
+ (Just url, _, _) -> return $ Just url
+ (Nothing, Just email, True) -> do
+ murl <- libravatar $ T.unpack email
+ return $ murl >>= return . fromString
+ _ -> return Nothing
+
$(widgetFile "user")
setPasswordForm :: Form SetPassword
diff --git a/stack.yaml b/stack.yaml
index c8d430f..045b906 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -5,8 +5,10 @@ packages:
- '.'
extra-deps:
# Absent from LTS 2.13
+- dns-2.0.0
- mime-0.4.0.2
- github-0.13.2
+- libravatar-0.1.0.1
- titlecase-0.1.0.1
- yesod-markdown-0.9.4
# Transitive dep of github
diff --git a/templates/user.hamlet b/templates/user.hamlet
index cfe91e6..1b56936 100644
--- a/templates/user.hamlet
+++ b/templates/user.hamlet
@@ -21,7 +21,7 @@ $if Just user_id == mviewer_id
<h1>
#{userDisplayName user_entity}
<div .row>
- $maybe avatar <- userAvatar user
+ $maybe avatar <- avatarFinal
<div .col-sm-5>
<figure>
<img .headshot src=#{avatar}>
--
1.9.1
_______________________________________________
Dev mailing list
[email protected]
https://lists.snowdrift.coop/mailman/listinfo/dev