module Network.Gravatar
( gravatar
, GravatarOptions(..)
, Size(..)
, DefaultImg(..)
, ForceDefault(..)
, Rating(..)
, Scheme (..)
, Default(def)
, defaultConfig
) where
import Data.Default (Default(..))
import Data.Digest.Pure.MD5 (md5)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Network.HTTP.Base (urlEncode)
import qualified Data.ByteString.Lazy.Char8 as C8
import qualified Data.Text as T
class GravatarParam a where
toParam :: a -> Maybe (String, String)
newtype Size = Size Int
instance GravatarParam Size where
toParam (Size i) = Just ("s", show i)
newtype ForceDefault = ForceDefault Bool
instance GravatarParam ForceDefault where
toParam (ForceDefault True) = Just ("f", "y")
toParam (ForceDefault False) = Nothing
data DefaultImg
= Custom String
| NotFound
| MM
| Identicon
| MonsterId
| Wavatar
| Retro
instance GravatarParam DefaultImg where
toParam (Custom s) = Just ("d", urlEncode s)
toParam NotFound = Just ("d", "404")
toParam MM = Just ("d", "mm")
toParam Identicon = Just ("d", "identicon")
toParam MonsterId = Just ("d", "monsterid")
toParam Wavatar = Just ("d", "wavatar")
toParam Retro = Just ("d", "retro")
data Rating = G | PG | R | X
instance GravatarParam Rating where
toParam G = Just ("r", "g")
toParam PG = Just ("r", "pg")
toParam R = Just ("r", "r")
toParam X = Just ("r", "x")
data GravatarOptions = GravatarOptions
{ gSize :: Maybe Size
, gDefault :: Maybe DefaultImg
, gForceDefault :: ForceDefault
, gRating :: Maybe Rating
, gScheme :: Scheme
}
data Scheme
= Http
| Https
| None
instance Show Scheme where
show Http = "http://"
show Https = "https://"
show None = "//"
instance Default GravatarOptions where
def = defaultConfig
defaultConfig :: GravatarOptions
defaultConfig = GravatarOptions
{ gSize = Nothing
, gDefault = Nothing
, gForceDefault = ForceDefault False
, gRating = Nothing
, gScheme = Https
}
gravatar :: GravatarOptions -> Text -> String
gravatar opts e = concat
[ show $ gScheme opts
, "www.gravatar.com/avatar/"
, hashEmail e
, queryString opts
]
hashEmail :: Text -> String
hashEmail = show . md5 . C8.pack . T.unpack . T.toLower . T.strip
queryString :: GravatarOptions -> String
queryString opts = case queryParts of
[] -> ""
ps -> "?" ++ intercalate "&" (map queryPart ps)
where
queryParts :: [(String, String)]
queryParts = catMaybes
[ toParam =<< gSize opts
, toParam =<< gDefault opts
, toParam $ gForceDefault opts
, toParam =<< gRating opts
]
queryPart :: (String, String) -> String
queryPart (k, v) = k ++ "=" ++ v