diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,19 @@ -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: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. +Copyright (c) 2015 Pat Brisbin - * 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. +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: - * 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. +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. -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. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Network/Gravatar.hs b/Network/Gravatar.hs deleted file mode 100644 --- a/Network/Gravatar.hs +++ /dev/null @@ -1,131 +0,0 @@ -------------------------------------------------------------------------------- --- | --- Module : Network.Gravatar --- Copyright : (c) Patrick Brisbin 2010 --- License : as-is --- --- Maintainer : pbrisbin@gmail.com --- Stability : unstable --- Portability : unportable --- --- . --- -------------------------------------------------------------------------------- -module Network.Gravatar - ( gravatar - - -- * Options - , GravatarOptions(..) - , Size(..) - , DefaultImg(..) - , ForceDefault(..) - , Rating(..) - , Default(..) - , defaultConfig - , Scheme (..) - ) where - -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) - -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 i) = Just ("s", show i) - --- | Always show the default image -newtype ForceDefault = ForceDefault Bool - -instance GravatarParam ForceDefault where - toParam (ForceDefault b) = if b then Just ("f", "y") else 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 - , gScheme :: Scheme - } - -data Scheme = Http | Https | None - -instance Show Scheme where - show Http = "http://" - show Https = "https://" - show None = "//" - -instance Default GravatarOptions where - def = defaultConfig - --- | Available for backwards compatability, using @def@ is advised -defaultConfig :: GravatarOptions -defaultConfig = GravatarOptions - { gSize = Nothing - , gDefault = Nothing - , gForceDefault = ForceDefault False - , gRating = Nothing - , gScheme = Https - } - --- | Return the avatar for the given email using the provided options -gravatar :: GravatarOptions -> Text -> String -gravatar opts e = (show . gScheme $ opts) ++ "www.gravatar.com/avatar/" - ++ hashEmail e `addParams` opts - --- | -hashEmail :: Text -> String -hashEmail = md5sum . T.toLower . T.strip - - where - 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/gravatar.cabal b/gravatar.cabal --- a/gravatar.cabal +++ b/gravatar.cabal @@ -1,28 +1,36 @@ -name: gravatar -version: 0.7 -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: Patrick Brisbin -maintainer: me@pbrisbin.com -category: Web, Yesod -build-type: Simple -cabal-version: >=1.6 +name: gravatar +version: 0.7.1 +author: Pat Brisbin +maintainer: Pat Brisbin +license: MIT +license-file: LICENSE +synopsis: Generate Gravatar image URLs +description: Generate Gravatar image URLs +cabal-version: >= 1.10 +build-type: Simple library - exposed-modules: Network.Gravatar + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: Network.Gravatar + build-depends: base >= 4 && < 5 + , text >= 0.11 && < 2.0 + , bytestring >= 0.9.1 && < 0.11 + , pureMD5 < 3 + , HTTP + , data-default - build-depends: base >= 4 && < 5 - , text >= 0.11 && < 2.0 - , bytestring >= 0.9.1 && < 0.11 - , pureMD5 < 3 - , HTTP - , data-default +test-suite spec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall + main-is: Spec.hs + build-depends: base + , hspec + , gravatar - ghc-options: -Wall - source-repository head - type: git - location: git://github.com/pbrisbin/gravatar.git + type: git + location: https://github.com/pbrisbin/gravatar diff --git a/src/Network/Gravatar.hs b/src/Network/Gravatar.hs new file mode 100644 --- /dev/null +++ b/src/Network/Gravatar.hs @@ -0,0 +1,118 @@ +module Network.Gravatar + ( gravatar + + -- * Options + , GravatarOptions(..) + , Size(..) + , DefaultImg(..) + , ForceDefault(..) + , Rating(..) + , Scheme (..) + , Default(..) + , defaultConfig + ) where + +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) + +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 i) = Just ("s", show i) + +-- | Always show the default image +newtype ForceDefault = ForceDefault Bool + +instance GravatarParam ForceDefault where + toParam (ForceDefault b) = if b then Just ("f", "y") else 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 + , gScheme :: Scheme + } + +data Scheme = Http | Https | None + +instance Show Scheme where + show Http = "http://" + show Https = "https://" + show None = "//" + +instance Default GravatarOptions where + def = defaultConfig + +-- | Available for backwards compatability, using @def@ is advised +defaultConfig :: GravatarOptions +defaultConfig = GravatarOptions + { gSize = Nothing + , gDefault = Nothing + , gForceDefault = ForceDefault False + , gRating = Nothing + , gScheme = Https + } + +-- | Return the avatar for the given email using the provided options +gravatar :: GravatarOptions -> Text -> String +gravatar opts e = (show . gScheme $ opts) ++ "www.gravatar.com/avatar/" + ++ hashEmail e `addParams` opts + +-- | +hashEmail :: Text -> String +hashEmail = md5sum . T.toLower . T.strip + + where + 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/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}