diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,30 @@ -Copyright (c) 2008 Don Stewart +Copyright (c)2010, Patrick Brisbin All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: +modification, are permitted provided that the following conditions are met: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. -3. Neither the name of the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. + * Neither the name of Patrick Brisbin nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, -STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN -ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Network/Gravatar.hs b/Network/Gravatar.hs --- a/Network/Gravatar.hs +++ b/Network/Gravatar.hs @@ -1,81 +1,118 @@ --------------------------------------------------------------------- +------------------------------------------------------------------------------- -- | --- Module : Network.Gravatar --- Copyright : (c) Galois, Inc. 2008 --- License : BSD3 --- --- Maintainer: Don Stewart --- Stability : provisional --- Portability: --- --------------------------------------------------------------------- --- --- Return the URL of a gravatar image - an image associated with an --- email address. --- --- Simple use: +-- Module : Network.Gravatar +-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is -- --- > > gravatar "dons@galois.com" --- > "http://www.gravatar.com/avatar.php?gravatar_id=f21827076a1d0725c4f4bd5a640102e9" +-- Maintainer : pbrisbin@gmail.com +-- Stability : unstable +-- Portability : unportable -- --- Optional arguments to specify the maximum classification rating --- allowed, a size of the image (between 1 and 80 pixels) and a default url --- to redirect to are provided by 'gravatarWith'. +-- . -- +------------------------------------------------------------------------------- +module Network.Gravatar + ( gravatar -module Network.Gravatar ( - gravatar, gravatarWith - ,Rating(..) - ,Size,size - ) where + -- * Options + , GravatarOptions(..) + , Size(..) + , DefaultImg(..) + , ForceDefault(..) + , Rating(..) + , defaultConfig + ) where -import Data.Digest.OpenSSL.MD5 -import Data.List -import Data.Char -import Network.URI -import qualified Data.ByteString.Char8 as S +import Data.Digest.Pure.MD5 (md5) +import Data.Default (Default(..)) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Network.HTTP.Base (urlEncode) ------------------------------------------------------------------------- --- Implementing the gravatar protocol +import qualified Data.ByteString.Lazy.Char8 as C8 +import qualified Data.Text as T --- | Classification ratings for gravatars -data Rating = G | PG | R | X - deriving (Eq,Ord,Bounded,Enum,Show,Read) +class GravatarParam a where + toParam :: a -> Maybe (String, String) --- | An image size in pixels from 1 to 80. +-- | Size in pixels newtype Size = Size Int - deriving (Eq,Ord,Show) --- | A smart constructor for the Size type, ensuring it is between 1 and 80 -size :: Int -> Maybe Size -size n | n >= 1 && n <= 80 = Just (Size n) - | otherwise = Nothing +instance GravatarParam Size where + toParam (Size i) = Just ("s", show i) ------------------------------------------------------------------------- +-- | Always show the default image +newtype ForceDefault = ForceDefault Bool -baseURL = "http://www.gravatar.com/avatar.php?" -gravatar_id = "gravatar_id" +instance GravatarParam ForceDefault where + toParam (ForceDefault b) = if b then Just ("f", "y") else Nothing --- | Return the url of a gravatar for an --- email address (a globally recognized avatar). --- -gravatar :: String -> String -gravatar who = gravatarWith who Nothing Nothing 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 --- | Construct the url of a gravatar with optional classification --- rating to limit to, an optional size in pixels, and optional default --- url to redirect to, should no image be found. --- -gravatarWith :: String - -> Maybe Rating - -> Maybe Size - -> Maybe String - -> String -gravatarWith who rating' sz' dflt' - = concat [baseURL ,gravatar_id ,"=" ,(md5sum (S.pack (clean who))),rating,sz,dflt ] +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" ) + +-- | Limit the returned images by rating +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 + } + +instance Default GravatarOptions where + def = defaultConfig + +defaultConfig :: GravatarOptions +defaultConfig = GravatarOptions + { gSize = Nothing + , gDefault = Nothing + , gForceDefault = ForceDefault False + , gRating = Nothing + } + +-- | Return the avatar for the given email using the provided options +gravatar :: GravatarOptions -> Text -> String +gravatar opts e = "http://www.gravatar.com/avatar/" ++ hashEmail e `addParams` opts + +-- | +hashEmail :: Text -> String +hashEmail = md5sum . T.toLower . T.strip + where - clean = let f = reverse . dropWhile isSpace in f . f - rating = maybe "" (\r -> "&rating="++show r) rating' - sz = maybe "" (\(Size n) -> "&size="++show n) sz' - dflt = maybe "" (\r -> "&default="++escapeURIString isUnreserved r) dflt' + md5sum :: Text -> String + md5sum = show . md5 . C8.pack . T.unpack +addParams :: String -> GravatarOptions -> String +addParams url opts = helper url . map (\(k,v) -> k ++ "=" ++ v) + $ catMaybes [ toParam =<< gSize opts + , toParam =<< gDefault opts + , toParam $ gForceDefault opts + , toParam =<< gRating opts + ] + where + helper :: String -> [String] -> String + helper u [] = u + helper u l = (++) u . (:) '?' $ intercalate "&" l diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env runhaskell -> import Distribution.Simple -> main = defaultMain diff --git a/gravatar.cabal b/gravatar.cabal --- a/gravatar.cabal +++ b/gravatar.cabal @@ -1,32 +1,28 @@ name: gravatar -version: 0.3 -homepage: http://code.haskell.org/~dons/code/gravatar -synopsis: Find the url of the gravatar associated with an email address. -description: - Gravatars () are globally unique images - associated with an email address, widely used in social networking - sites. This library lets you find the URL of a gravatar image - associated with an email address. - . - Test coverage data for this library is available at: - - . -category: Network +version: 0.5.1 +description: Look up gravatar image urls by email address +synopsis: Look up gravatar image urls by email address +homepage: http://github.com/pbrisbin/gravatar license: BSD3 license-file: LICENSE -author: Don Stewart -maintainer: -cabal-version: >= 1.2 -build-type: Simple - -flag small_base - description: Choose the new smaller, split-up base package. +author: Patrick Brisbin +maintainer: me@pbrisbin.com +category: Web, Yesod +build-type: Simple +cabal-version: >=1.6 library - exposed-modules: Network.Gravatar + exposed-modules: Network.Gravatar - if flag(small_base) - build-depends: base >= 3, bytestring - else - build-depends: base < 3 - build-depends: nano-md5, network + build-depends: base >= 4 && < 5 + , text >= 0.11 && < 0.12 + , bytestring >= 0.9.1 && < 0.10 + , pureMD5 < 3 + , HTTP + , data-default + + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/pbrisbin/gravatar.git diff --git a/tests/tests.hs b/tests/tests.hs deleted file mode 100644 --- a/tests/tests.hs +++ /dev/null @@ -1,12 +0,0 @@ -import Network.Gravatar - -main = do - print $ gravatar "dons@galois.com" == "http://www.gravatar.com/avatar.php?gravatar_id=f21827076a1d0725c4f4bd5a640102e9" - - print $ (gravatarWith "dons@galois.com" (Just R) Nothing (Just "http://haskell.org") ) == "http://www.gravatar.com/avatar.php?gravatar_id=f21827076a1d0725c4f4bd5a640102e9&rating=R&default=http%3A%2F%2Fhaskell.org" - - print $ (gravatarWith "dons@galois.com" (Just R) (size 20) (Just "http://haskell.org") ) == "http://www.gravatar.com/avatar.php?gravatar_id=f21827076a1d0725c4f4bd5a640102e9&rating=R&size=20&default=http%3A%2F%2Fhaskell.org" - - -- illegal size - print $ (gravatarWith "dons@galois.com" (Just R) (size 200) (Just "http://haskell.org") ) == "http://www.gravatar.com/avatar.php?gravatar_id=f21827076a1d0725c4f4bd5a640102e9&rating=R&default=http%3A%2F%2Fhaskell.org" -