Libravatar support \o/

src/Vervis/Avatar.hs

@@ -0,0 +1,38 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Avatar
+    ( getAvatarUrl
+    )
+where
+
+import Prelude
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Default.Class (def)
+import Data.Text (Text)
+import Network.Libravatar
+import Network.Wai (isSecure)
+import Yesod.Core (MonadHandler)
+import Yesod.Core.Handler (waiRequest)
+
+getAvatarUrl :: MonadHandler m => Text -> m (Maybe Text)
+getAvatarUrl email = do
+    secure <- isSecure <$> waiRequest
+    let opts = def
+            { optSecure      = secure
+            , optTryGravatar = False
+            }
+    liftIO $ avatarUrl (Email email) opts

src/Vervis/Handler/Person.hs

@@ -31,6 +31,7 @@ import Text.Blaze.Html (toHtml)
 import Yesod.Auth.HashDB (setPassword)
 
 import Vervis.Model.Ident
+import Vervis.Widget (avatarW)
 
 -- | Get list of users
 getPeopleR :: Handler Html

src/Vervis/Widget.hs

@@ -17,6 +17,7 @@
 module Vervis.Widget
     ( breadcrumbsW
     , revisionW
+    , avatarW
     )
 where
 
@@ -33,6 +34,7 @@ import qualified Data.Text as T (take)
 
 import Data.Revision.Local
 import Development.DarcsRev (darcsTotalPatches, darcsRevision)
+import Vervis.Avatar (getAvatarUrl)
 import Vervis.Settings (widgetFile)
 import Vervis.Style
 import Vervis.Time (showDate)
@@ -50,3 +52,14 @@ revisionW =
         repo = "vervis" :: Text
         changes = $darcsTotalPatches :: Int
     in  $(widgetFile "widget/revision")
+
+avatarW :: Text -> WidgetT site IO ()
+avatarW email = do
+    murl <- getAvatarUrl email
+    [whamlet|
+        <div>
+          $maybe url <- murl
+            <img src=#{url}>
+          $nothing
+            <p>INVALID EMAIL
+    |]

stack.yaml

@@ -20,6 +20,7 @@ extra-deps:
   - hit-graph-0.1
   - hit-harder-0.1
   - hit-network-0.1
+  - libravatar-0.4
   - monad-hash-0.1
   - SimpleAES-0.4.2
 #  - ssh-0.3.2

templates/person.hamlet

@@ -12,6 +12,9 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
+$maybe avatar <- avatarW <$> personEmail person
+  ^{avatar}
+
 <ul>
   <li>
     <a href=@{ProjectsR ident}>Projects

vervis.cabal

@@ -74,6 +74,7 @@ library
                        Yesod.Paginate.Local
 
                        Vervis.Application
+                       Vervis.Avatar
                        Vervis.BinaryBody
                        Vervis.Changes
                        Vervis.Content
@@ -205,6 +206,7 @@ library
                      , hourglass
                      , http-conduit
                      , http-types
+                     , libravatar
                        -- for converting Darcs patch hash Digest to ByteString
                      , memory
                      , monad-control