diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -3,6 +3,30 @@ +libravatar 0.3.0.0 -- 2015-12-17 +================================ + +General, build and documentation changes: + +* (None) + +New APIs, features and enhancements: + +* Make the `AvatarOptions` type abstract, so that new fields don't break API +* Allow gravatar fallbacl to be disabled through `optTryGravatar` + +Bug fixes: + +* (none) + +Dependency changes: + +* Add data-default-class + + + + + libravatar 0.2.0.0 -- 2015-12-08 ================================ diff --git a/libravatar.cabal b/libravatar.cabal --- a/libravatar.cabal +++ b/libravatar.cabal @@ -1,5 +1,5 @@ name: libravatar -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Use Libravatar, the decentralized avatar delivery service description: This package is a Haskell library for . @@ -23,15 +23,16 @@ exposed-modules: Network.Libravatar -- other-modules: -- other-extensions: - build-depends: base >=4.7 && <5 + build-depends: base >=4.7 && <5 , bytestring - , crypto-api >=0.13.2 - , dns >=2 - , network-uri >=2.6 - , pureMD5 >=2.1.2 - , random >=1.1 - , SHA >=1.6.4 - , url >=2.1.3 - , utf8-string >=1 + , crypto-api >=0.13.2 + , data-default-class + , dns >=2 + , network-uri >=2.6 + , pureMD5 >=2.1.2 + , random >=1.1 + , SHA >=1.6.4 + , url >=2.1.3 + , utf8-string >=1 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Network/Libravatar.hs b/src/Network/Libravatar.hs --- a/src/Network/Libravatar.hs +++ b/src/Network/Libravatar.hs @@ -18,17 +18,20 @@ , SpecialImage (..) , DefaultImage (..) , Size (..) - , AvatarOptions (..) + , AvatarOptions () + , defOpts + , optSecure + , optDefault + , optSize + , optTryGravatar , avatarUrl ) where import Control.Monad (liftM) import Crypto.Classes (hash') -import qualified Data.ByteString.Char8 as BC -import Data.ByteString.UTF8 as BU (fromString) -import Data.ByteString.Lazy.UTF8 as BLU (fromString) import Data.Char (toLower) +import Data.Default.Class import Data.Digest.Pure.MD5 (MD5Digest) import Data.Digest.Pure.SHA (sha256) import Data.List (partition) @@ -40,6 +43,10 @@ import Network.URL import System.Random (randomRIO) +import qualified Data.ByteString.UTF8 as BU (fromString) +import qualified Data.ByteString.Lazy.UTF8 as BLU (fromString) +import qualified Data.ByteString.Char8 as BC + defaultHost = Host (HTTP False) "cdn.libravatar.org" Nothing defaultHostSecure = Host (HTTP True) "seccdn.libravatar.org" Nothing serviceBase = "_avatars._tcp" @@ -97,6 +104,9 @@ -- | Use the given image URL as the default. | ImgCustom String +instance Default DefaultImage where + def = ImgLibravatarLogo + -- | Image size in pixels. data Size -- | Use the given size. Acceptable values are between 1 and 512. Note that @@ -106,37 +116,68 @@ -- | Use the default size, which is 80 pixels. | DefaultSize --- | Avatar details in addition to the user address itself. +instance Default Size where + def = DefaultSize + +-- | Avatar details in addition to the user address itself. Define by starting +-- with 'defOpts' and override fields using record syntax. data AvatarOptions = AvatarOptions { -- | Whether the avatar URL should be secure (use HTTPS). - optSecure :: Bool + optSecure :: Bool -- | What to do if the user address isn't found in the Libravatar -- database. - , optDefault :: DefaultImage + , optDefault :: DefaultImage -- | Image size in pixels. - , optSize :: Size + , optSize :: Size + -- | If an image is not found in the Libravatar database, it can first + -- redirect to gravatar in case the image exists there, and only then + -- honour the 'optDefault' parameter. This option sets whether Libravatar + -- should try gravatar or go straight to the 'optDefault' when an image + -- isn't found. + , optTryGravatar :: Bool } --- Hash emails with MD5, I think it's faster than SHA256 -hashMail :: String -> String -hashMail = +instance Default AvatarOptions where + def = AvatarOptions + { optSecure = False + , optDefault = def + , optSize = def + , optTryGravatar = True + } + +-- | A default 'AvatarOptions' value in which you can override fields. It is +-- simply a convenience wrapper of 'def', i.e. this is the same as using the +-- 'Default' instance. +defOpts :: AvatarOptions +defOpts = def + +hashMD5 :: String -> String +hashMD5 = let h :: String -> MD5Digest h = hash' . BU.fromString in show . h +hashSHA256 :: String -> String +hashSHA256 = show . sha256 . BLU.fromString + +-- Hash email using MD5 or SHA256 depending on whether gr4va7ar should be used +hashMail :: Bool -> String -> String +hashMail True = hashMD5 +hashMail False = hashSHA256 + -- OpenIDs must be hashed with SHA256 hashOpenid :: String -> String -hashOpenid = show . sha256 . BLU.fromString +hashOpenid = hashSHA256 -- From email or openid, generate avatar hash and get the relevant domain -parseUserAddress :: UserAddress -> Maybe (String, String) -parseUserAddress (Email email) = +parseUserAddress :: UserAddress -> Bool -> Maybe (String, String) +parseUserAddress (Email email) grav = let lowEmail = map toLower email d = dropWhile (/= '@') lowEmail domain = if null d then d else tail d - hash = hashMail lowEmail + hash = hashMail grav lowEmail in Just (hash, domain) -parseUserAddress (OpenID openid) = do +parseUserAddress (OpenID openid) _ = do uri <- parseAbsoluteURI openid auth <- uriAuthority uri let lower = map toLower @@ -272,7 +313,7 @@ -- Email, HTTP, default fallback image (the libravatar logo), -- default size (80): -- --- >>> avatarUrl (Email "john@doe.org") AvatarOptions +-- >>> avatarUrl (Email "john@doe.org") defOpts -- >>> { optSecure = False -- >>> , optDefault = ImgLibravatarLogo -- >>> , optSize = DefaultSize @@ -282,7 +323,7 @@ -- Email, HTTPS, default fallback image, size 100. But now use an email with a -- domain which has SRV records for avatars: -- --- >>> avatarUrl (Email "fr33domlover@rel4tion.org") AvatarOptions +-- >>> avatarUrl (Email "fr33domlover@rel4tion.org") defOpts -- >>> { optSecure = True -- >>> , optDefault = ImgLibravatarLogo -- >>> , optSize = Size 100 @@ -292,7 +333,7 @@ -- OpenID, HTTPS, specified fallback (special value \"retro\"), default -- size (80): -- --- >>> avatarUrl (OpenID "https://examplibre.org/accounts/xyz/id") AvatarOptions +-- >>> avatarUrl (OpenID "https://examplibre.org/accounts/xyz/id") defOpts -- >>> { optSecure = True -- >>> , optDefault = ImgSpecial SpecialRetro -- >>> , optSize = DefaultSize @@ -304,7 +345,8 @@ -- the specific URL here will probably result with 404.) avatarUrl :: UserAddress -> AvatarOptions -> IO (Maybe String) avatarUrl address options = - let (hash, domain) = fromMaybe ("", "") $ parseUserAddress address + let grav = optTryGravatar options + (hash, domain) = fromMaybe ("", "") $ parseUserAddress address grav params = buildParams (optDefault options) (optSize options) https = optSecure options in if null domain