libravatar 0.2.0.0 → 0.3.0.0

raw patch · 3 files changed

+97/−30 lines, 3 filesdep +data-default-classPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default-class

API changes (from Hackage documentation)

Files

• NEWS +24/−0
• libravatar.cabal +11/−10
• src/Network/Libravatar.hs +62/−20

@@ -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 ================================ 

@@ -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                      <http://libravatar.org Libravatar>.@@ -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

@@ -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