summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPatrickBrisbin <>2012-04-14 00:46:55 (GMT)
committerhdiff <hdiff@luite.com>2012-04-14 00:46:55 (GMT)
commite1820e6bb2977686f778cc769db3f3848869245e (patch)
tree74310a703462bfbd6083c0943228613420c50ab4
parentbdf6d48c6817e547c0ce82a5a2e35120aec01404 (diff)
version 0.5.10.5.1
-rw-r--r--LICENSE44
-rw-r--r--Network/Gravatar.hs165
-rw-r--r--Setup.hs2
-rw-r--r--Setup.lhs3
-rw-r--r--gravatar.cabal48
-rw-r--r--tests/tests.hs12
6 files changed, 147 insertions, 127 deletions
diff --git a/LICENSE b/LICENSE
index 9a53f79..97e1553 100644
--- 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
index c9a9c3f..38867aa 100644
--- a/Network/Gravatar.hs
+++ b/Network/Gravatar.hs
@@ -1,81 +1,118 @@
---------------------------------------------------------------------
+-------------------------------------------------------------------------------
-- |
--- Module : Network.Gravatar
--- Copyright : (c) Galois, Inc. 2008
--- License : BSD3
+-- Module : Network.Gravatar
+-- Copyright : (c) Patrick Brisbin 2010
+-- License : as-is
--
--- Maintainer: Don Stewart <dons@galois.com>
--- Stability : provisional
--- Portability:
+-- Maintainer : pbrisbin@gmail.com
+-- Stability : unstable
+-- Portability : unportable
--
---------------------------------------------------------------------
---
--- Return the URL of a gravatar image - an image associated with an
--- email address.
---
--- Simple use:
---
--- > > gravatar "dons@galois.com"
--- > "http://www.gravatar.com/avatar.php?gravatar_id=f21827076a1d0725c4f4bd5a640102e9"
---
--- 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'.
+-- <http://en.gravatar.com/>.
--
+-------------------------------------------------------------------------------
+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
+
+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
+
+-- | <http://en.gravatar.com/site/implement/hash/>
+hashEmail :: Text -> String
+hashEmail = md5sum . T.toLower . T.strip
--- | 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 ]
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
index 0000000..9a994af
--- /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
index 5bde0de..0000000
--- 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
index a4451fe..570f5a0 100644
--- 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 (<http://gravatar.com>) 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:
- <http://code.haskell.org/~dons/tests/gravatar/hpc_index.html>
- .
-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: <dons@galois.com>
-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
+
+ build-depends: base >= 4 && < 5
+ , text >= 0.11 && < 0.12
+ , bytestring >= 0.9.1 && < 0.10
+ , pureMD5 < 3
+ , HTTP
+ , data-default
- if flag(small_base)
- build-depends: base >= 3, bytestring
- else
- build-depends: base < 3
- build-depends: nano-md5, network
+ 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
index 60ab08e..0000000
--- 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"
-