Utils.hs

{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  Yesod.Comments.Utils
-- Copyright   :  (c) Patrick Brisbin 2010
-- License     :  as-is
--
-- Maintainer  :  pbrisbin@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-------------------------------------------------------------------------------
module Yesod.Comments.Utils
    ( commentUserDetails
    , currentUserDetails
    , requireUserDetails
    , defaultUserDetails
    , isCommentingUser
    , gravatar
    ) where

import Yesod
import Yesod.Auth
import Yesod.Comments.Core

import Data.Text  (Text)
import Data.Maybe (fromMaybe)

import Network.Gravatar hiding (gravatar)
import qualified Network.Gravatar as G

-- | Map the commenter's id to user details or return defaults.
commentUserDetails :: YesodComments m => Comment -> HandlerT m IO UserDetails
commentUserDetails c =
    return . fromMaybe (defaultUserDetails c) =<<
        case (cIsAuth c, fromPathPiece (cUserName c)) of
            (True, Just uid) -> userDetails uid
            _                -> return Nothing

-- | Returns @Nothing@ if user is not authenticated
currentUserDetails :: YesodComments m => HandlerT m IO (Maybe UserDetails)
currentUserDetails = do
    muid <- maybeAuthId
    case muid of
        Just uid -> userDetails uid
        _        -> return Nothing

-- | Halts with @permissionDenied@ if user is not authenticated
requireUserDetails :: YesodComments m => HandlerT m IO (UserDetails)
requireUserDetails = do
    mudetails <- currentUserDetails
    case mudetails of
        Just udetails -> return udetails
        _             -> permissionDenied "you must be logged in"

-- | For a comment that was not authenticated or cannot be mapped, the
--   default details are the id and email stored directly on the comment.
defaultUserDetails :: Comment -> UserDetails
defaultUserDetails c = UserDetails (cUserName c) (cUserName c) (cUserEmail c)

-- | Given pixel size and email, return the gravatar url
gravatar :: Int -> Text -> String
gravatar s = G.gravatar defaultConfig { gDefault = Just MM, gSize = Just $ Size s }

isCommentingUser :: YesodComments m => Comment -> HandlerT m IO Bool
isCommentingUser comment = do
    mudetails <- currentUserDetails
    cudetails <- commentUserDetails comment

    return $ maybe False (== cudetails) mudetails