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