module Network.Gravatar
    ( gravatar

    -- * Options
    , 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)

-- | Size in pixels
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)

-- | Always show the default image
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

-- | Image to show when an avatar is not available
data DefaultImg
    = Custom String -- ^ supply your own url
    | NotFound      -- ^ do not load an image return a 404
    | MM            -- ^ mystery man
    | Identicon     -- ^ geometric pattern based on the hash
    | MonsterId     -- ^ a generated monster
    | Wavatar       -- ^ generated faces
    | Retro         -- ^ generated, 8-bit arcade style pixelated face

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")

-- | Limit the returned images by rating
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           -- ^ default @Nothing@
    , GravatarOptions -> Maybe DefaultImg
gDefault :: Maybe DefaultImg  -- ^ default @Nothing@
    , GravatarOptions -> ForceDefault
gForceDefault :: ForceDefault -- ^ default @False@
    , GravatarOptions -> Maybe Rating
gRating :: Maybe Rating       -- ^ default @Nothing@
    , GravatarOptions -> Scheme
gScheme :: Scheme             -- ^ default @Https@
    }

-- | Scheme to use for image URLs
data Scheme
    = Http  -- ^ @http://@
    | Https -- ^ @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

-- | Available for backwards compatability, using @def@ is advised
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
    }

-- | Return the avatar for the given email using the provided options
--
-- >>> gravatar def "pbrisbin@gmail.com"
-- "https://www.gravatar.com/avatar/2be502055b6c21ff470730beead2a998"
--
-- Whitespace is trimmed.
--
-- >>> gravatar def " pbrisbin@gmail.com   "
-- "https://www.gravatar.com/avatar/2be502055b6c21ff470730beead2a998"
--
-- Case is ignored.
--
-- >>> gravatar def "PBrisbin@GMAIL.com"
-- "https://www.gravatar.com/avatar/2be502055b6c21ff470730beead2a998"
--
-- Options are supported.
--
-- >>> :{
--   let opts = GravatarOptions
--           { gSize = Just $ Size 24
--           , gDefault = Just NotFound
--           , gForceDefault = ForceDefault True
--           , gRating = Just G
--           , gScheme = Http
--           }
--   in gravatar opts "pbrisbin@gmail.com"
-- :}
-- "http://www.gravatar.com/avatar/2be502055b6c21ff470730beead2a998?s=24&d=404&f=y&r=g"
--
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
    ]

-- | <http://en.gravatar.com/site/implement/hash/>
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