Libravatar support \o/

This commit is contained in:
fr33domlover 2016-05-25 21:10:41 +00:00
parent 16d33da4de
commit ec49a4c424
6 changed files with 58 additions and 0 deletions

38
src/Vervis/Avatar.hs Normal file
View file

@ -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

View file

@ -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

View file

@ -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
|]

View file

@ -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

View file

@ -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

View file

@ -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