diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Felipe Lessa + +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. + + * 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. + + * Neither the name of Felipe Lessa 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 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/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/src/Yesod/Auth/Zendesk.hs b/src/Yesod/Auth/Zendesk.hs new file mode 100644 --- /dev/null +++ b/src/Yesod/Auth/Zendesk.hs @@ -0,0 +1,227 @@ +module Yesod.Auth.Zendesk + ( YesodZendesk(..) + , ZendeskUser(..) + , ZendeskExternalId(..) + , Zendesk + , getZendesk + , zendeskLoginRoute + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (join) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Default (Default(..)) +import Data.List (intersperse) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Time (getCurrentTime, formatTime) +import Language.Haskell.TH.Syntax (Pred(ClassP), Type(VarT), mkName) +import Yesod.Auth +import Yesod.Core +import qualified Crypto.Hash.MD5 as MD5 +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Network.HTTP.Types as H +import qualified Network.Wai as W + + +-- | Type class that you need to implement in order to support +-- Zendesk remote authentication. +-- +-- /Minimal complete definition:/ all functions are required. +class YesodAuth master => YesodZendesk master where + -- | Shared secret between Zendesk and your site. + zendeskToken :: master -> B.ByteString + + -- | URL on your Zendesk's site where users should be + -- redirected to when logging in. + zendeskAuthURL :: master -> Text + + -- | Gather information that should be given to Zendesk about + -- an user. Please see 'ZendeskUser' for more information + -- about what these fields mean. + -- + -- Simple example: + -- + -- @ + -- zendeskUserInfo = do + -- Entity uid user <- 'requireAuth' + -- return 'def' { 'zuName' = userName user + -- , 'zuEmail' = userEmail user } + -- @ + -- + -- Advanced example: + -- + -- @ + -- zendeskUserInfo = do + -- uid <- 'requireAuthId' + -- render <- 'getUrlRender' + -- runDB $ do + -- Just user <- get uid + -- Just org <- get (userOrganization user) + -- return 'def' { 'zuName' = userName user + -- , 'zuEmail' = userEmail user + -- , 'zuOrganization' = Just (organizationName org) + -- , 'zuRemotePhotoURL' = Just (render $ UserPhotoR uid) + -- } + -- @ + -- + -- /Note:/ although I don't recomend this and I don't see any + -- reason why you would do it, it /is/ possible to use + -- 'maybeAuth' instead of 'requireAuth' and login on Zendesk + -- with some sort of guest user should the user not be logged + -- in. + zendeskUserInfo :: GHandler Zendesk master ZendeskUser + + +-- | Information about a user that is given to 'Zendesk'. Please +-- see Zendesk's documentation +-- () +-- in order to see more details of how theses fields are +-- interpreted. +-- +-- Only 'zuName' and 'zuEmail' are required. +data ZendeskUser = + ZendeskUser + { zuName :: Text + -- ^ User name, at least two characters. (required) + , zuEmail :: Text + -- ^ E-mail address. (required) + , zuExternalId :: ZendeskExternalId + -- ^ An external (to Zendesk) ID that identifies this user. + -- Defaults to 'UseYesodAuthId'. + , zuOrganization :: Maybe Text + -- ^ Organization the user belongs to. + , zuTags :: [Text] + -- ^ List of tags. + , zuRemotePhotoURL :: Maybe Text + -- ^ Public URL with the user's profile picture. + } deriving (Eq, Ord, Show, Read) + +-- | Fields 'zuName' and 'zuEmail' are required, so 'def' will be +-- 'undefined' for them. +instance Default ZendeskUser where + def = ZendeskUser + { zuName = error "ZendeskUser's zuName is a required field." + , zuEmail = error "ZendeskUser's zuEmail is a required field." + , zuExternalId = def + , zuOrganization = Nothing + , zuTags = [] + , zuRemotePhotoURL = Nothing + } + + +-- | Which external ID should be given to Zendesk. +data ZendeskExternalId = + UseYesodAuthId + -- ^ Use the user ID from @persistent@\'s database. This is + -- the recommended and default value. + | Explicit Text + -- ^ Use this given value. + | NoExternalId + -- ^ Do not give an external ID. + deriving (Eq, Ord, Show, Read) + +-- | Default is 'UseYesodAuthId'. +instance Default ZendeskExternalId where + def = UseYesodAuthId + + +---------------------------------------------------------------------- + + +-- | Data type for @yesod-auth-zendesk@\'s subsite. +data Zendesk = Zendesk + + +-- | Create a new 'Zendesk', use this on your @config/routes@ file. +getZendesk :: a -> Zendesk +getZendesk = const Zendesk + + +mkYesodSub "Zendesk" + [ClassP ''YesodZendesk [VarT $ mkName "master"]] + [parseRoutes| + / ZendeskLoginR GET +|] + + +-- | Redirect the user to Zendesk such that they're already +-- logged in when they arrive. For example, you may use +-- @zendeskLoginRoute@ when the user clicks on a \"Support\" item +-- on a menu. +zendeskLoginRoute :: Route Zendesk +zendeskLoginRoute = ZendeskLoginR + + +-- | Route used by the Zendesk remote authentication. Works both +-- when Zendesk call us and when we call them. +getZendeskLoginR :: YesodZendesk master => GHandler Zendesk master () +getZendeskLoginR = do + -- Get the timestamp and the request params. + (timestamp, getParams) <- do + rawReqParams <- W.queryString <$> waiRequest + case join $ lookup "timestamp" rawReqParams of + Nothing -> do + -- Doesn't seem to be a request from Zendesk, create our + -- own timestamp. + now <- liftIO getCurrentTime + let timestamp = B8.pack $ formatTime locale "%s" now + locale = error "yesod-auth-zendesk: never here (locale not needed)" + return (timestamp, [("timestamp", Just timestamp)]) + Just timestamp -> + -- Seems to be a request from Zendesk. + -- + -- They ask us to reply to them with all the request + -- parameters they gave us, and at first it seems that + -- this could create a security problem: we can't confirm + -- that the request really came from Zendesk, and a + -- malicious person could include a parameter such as + -- "email=foo@bar.com". These attacks would foiled by + -- the hash, however. + return (timestamp, rawReqParams) + + -- Get information about the currently logged user. + ZendeskUser {..} <- zendeskUserInfo + externalId <- case zuExternalId of + UseYesodAuthId -> Just . toPathPiece <$> requireAuthId + Explicit x -> return (Just x) + NoExternalId -> return Nothing + let tags = T.concat $ intersperse "," zuTags + + -- Calculate hash + y <- getYesod + let hash = + let toBeHashed = B.concat . cons zuName + . cons zuEmail + . mcons externalId + . mcons zuOrganization + . cons tags + . mcons zuRemotePhotoURL + . (:) (zendeskToken y) + . (:) timestamp + $[] + cons = (:) . TE.encodeUtf8 + mcons = maybe id cons + in Base16.encode $ MD5.hash toBeHashed + + -- Encode information into parameters + let addParams = paramT "name" (Just zuName) + . paramT "email" (Just zuEmail) + . paramBS "hash" (Just hash) + . paramT "external_id" externalId + . paramT "organization" zuOrganization + . paramT "tags" (Just tags) + . paramT "remote_photo_url" zuRemotePhotoURL + where + paramT name = paramBS name . fmap TE.encodeUtf8 + paramBS name (Just t) | not (B.null t) = (:) (name, Just t) + paramBS _ _ = id + params = H.renderQuery True {- add question mark -} $ + addParams getParams + + -- Redirect to Zendesk + redirect $ zendeskAuthURL y <> TE.decodeUtf8 params diff --git a/yesod-auth-zendesk.cabal b/yesod-auth-zendesk.cabal new file mode 100644 --- /dev/null +++ b/yesod-auth-zendesk.cabal @@ -0,0 +1,58 @@ +Name: yesod-auth-zendesk +Version: 0.1.0.1 +Synopsis: Zendesk remote authentication support for Yesod apps. +Homepage: https://github.com/meteficha/yesod-auth-zendesk +License: BSD3 +License-file: LICENSE +Author: Felipe Lessa +Maintainer: Felipe Lessa +Category: Web +Build-type: Simple +Cabal-version: >= 1.6 + +Description: + This package allows users of your website to login into Zendesk + automatically using Zendesk's remote authentication + (). + . + Note that this is an unusual @yesod-auth-*@ package. We do not + define an @AuthPlugin@ because the user can't log in to your + website via Zendesk (it's the opposite, they login in Zendesk + via your website). Instead, this plugin defines an Yesod + subsite that you may include on your site; the subsite defines + a route that accepts incoming users from Zendesk and + authenticates them. + +Source-repository head + type: git + location: git://github.com/meteficha/yesod-auth-zendesk.git + +Library + hs-source-dirs: src + + Build-depends: base >= 4.3 && < 5 + , time >= 1.1 && < 2 + , bytestring + , text >= 0.7 && < 0.12 + , data-default >= 0.2 && < 0.5 + , template-haskell + , cryptohash >= 0.6 + , base16-bytestring + , http-types + , yesod-core >= 0.10 && < 0.11 + , yesod-auth >= 0.8 && < 0.9 + , wai + , http-conduit + , transformers >= 0.1.3 && < 0.3 + + Exposed-modules: Yesod.Auth.Zendesk + Extensions: + FlexibleInstances + GADTs + MultiParamTypeClasses + OverloadedStrings + QuasiQuotes + RecordWildCards + TemplateHaskell + TypeFamilies + GHC-options: -Wall