module Yesod.Auth.Zendesk
( YesodZendesk(..)
, ZendeskUser(..)
, ZendeskExternalId(..)
, Zendesk
, getZendesk
, zendeskLoginRoute
) where
import Control.Applicative ((<$>))
import Control.Monad (join)
import Data.Default (Default(..))
import Data.List (intersperse)
import Data.Text (Text)
import Data.Time (getCurrentTime, formatTime)
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
import Yesod.Auth.Zendesk.Data
class YesodAuthPersist site => YesodZendesk site where
zendeskToken :: site -> B.ByteString
zendeskAuthURL :: site -> Text
zendeskUserInfo :: HandlerT site IO ZendeskUser
data ZendeskUser =
ZendeskUser
{ zuName :: Text
, zuEmail :: Text
, zuExternalId :: ZendeskExternalId
, zuOrganization :: Maybe Text
, zuTags :: [Text]
, zuRemotePhotoURL :: Maybe Text
} deriving (Eq, Ord, Show, Read)
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
}
data ZendeskExternalId =
UseYesodAuthId
| Explicit Text
| NoExternalId
deriving (Eq, Ord, Show, Read)
instance Default ZendeskExternalId where
def = UseYesodAuthId
getZendesk :: a -> Zendesk
getZendesk = const Zendesk
instance YesodZendesk site => YesodSubDispatch Zendesk (HandlerT site IO) where
yesodSubDispatch = $(mkYesodSubDispatch resourcesZendesk)
zendeskLoginRoute :: Route Zendesk
zendeskLoginRoute = ZendeskLoginR
getZendeskLoginR :: YesodZendesk site => HandlerT Zendesk (HandlerT site IO) ()
getZendeskLoginR = do
(timestamp, getParams) <- do
rawReqParams <- W.queryString <$> waiRequest
case join $ lookup "timestamp" rawReqParams of
Nothing -> do
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 ->
return (timestamp, rawReqParams)
ZendeskUser {..} <- lift zendeskUserInfo
externalId <- case zuExternalId of
UseYesodAuthId -> Just . toPathPiece <$> lift requireAuthId
Explicit x -> return (Just x)
NoExternalId -> return Nothing
let tags = T.concat $ intersperse "," zuTags
y <- lift 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
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 $
addParams getParams
redirect $ zendeskAuthURL y `T.append` TE.decodeUtf8 params