{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} ---------------------------------------------------------------------- -- | -- Module: Web.Slack -- Description: Provides Slack's Web API functions. -- *Since 0.4.0.0*: The API functions is now more intuitive for newbies -- than before. If you need compatiblity with the previous version, use -- 'Web.Slack.Classy' instead. -- ---------------------------------------------------------------------- module Web.Slack ( SlackConfig(..) , mkSlackConfig , apiTest , authTest , chatPostMessage , conversationsList , conversationsHistory , conversationsHistoryAll , conversationsReplies , repliesFetchAll , getUserDesc , usersList , userLookupByEmail , authenticateReq , Response , LoadPage ) where -- aeson import Data.Aeson -- base import Control.Arrow ((&&&)) import Data.Maybe import Data.Proxy (Proxy(..)) -- containers import qualified Data.Map as Map -- http-client import Network.HTTP.Client (Manager, newManager) -- http-client-tls import Network.HTTP.Client.TLS (tlsManagerSettings) -- mtl import Control.Monad.Reader -- servant import Servant.API hiding (addHeader) -- servant-client import Servant.Client hiding (Response, baseUrl) #if MIN_VERSION_servant(0,16,0) import Servant.Client.Core (AuthClientData, AuthenticatedRequest, Request, mkAuthenticatedRequest, addHeader) #else import Servant.Client.Core.Internal.Auth import Servant.Client.Core (Request, addHeader) #endif -- slack-web import qualified Web.Slack.Api as Api import qualified Web.Slack.Auth as Auth import qualified Web.Slack.Conversation as Conversation import qualified Web.Slack.Chat as Chat import qualified Web.Slack.Common as Common import qualified Web.Slack.User as User import Web.Slack.Pager -- text import Data.Text (Text) #if !MIN_VERSION_servant(0,13,0) mkClientEnv :: Manager -> BaseUrl -> ClientEnv mkClientEnv = ClientEnv #endif data SlackConfig = SlackConfig { slackConfigManager :: Manager , slackConfigToken :: Text } -- contains errors that can be returned by the slack API. -- constrast with 'SlackClientError' which additionally -- contains errors which occured during the network communication. data ResponseSlackError = ResponseSlackError Text deriving (Eq, Show) -- | -- Internal type! -- newtype ResponseJSON a = ResponseJSON (Either ResponseSlackError a) instance FromJSON a => FromJSON (ResponseJSON a) where parseJSON = withObject "Response" $ \o -> do ok <- o .: "ok" ResponseJSON <$> if ok then Right <$> parseJSON (Object o) else Left . ResponseSlackError <$> o .: "error" -- | -- -- type Api = "api.test" :> ReqBody '[FormUrlEncoded] Api.TestReq :> Post '[JSON] (ResponseJSON Api.TestRsp) :<|> "auth.test" :> AuthProtect "token" :> Post '[JSON] (ResponseJSON Auth.TestRsp) :<|> "conversations.list" :> AuthProtect "token" :> ReqBody '[FormUrlEncoded] Conversation.ListReq :> Post '[JSON] (ResponseJSON Conversation.ListRsp) :<|> "conversations.history" :> AuthProtect "token" :> ReqBody '[FormUrlEncoded] Conversation.HistoryReq :> Post '[JSON] (ResponseJSON Conversation.HistoryRsp) :<|> "conversations.replies" :> AuthProtect "token" :> ReqBody '[FormUrlEncoded] Conversation.RepliesReq :> Post '[JSON] (ResponseJSON Conversation.HistoryRsp) :<|> "chat.postMessage" :> AuthProtect "token" :> ReqBody '[FormUrlEncoded] Chat.PostMsgReq :> Post '[JSON] (ResponseJSON Chat.PostMsgRsp) :<|> "users.list" :> AuthProtect "token" :> Post '[JSON] (ResponseJSON User.ListRsp) :<|> "users.lookupByEmail" :> AuthProtect "token" :> ReqBody '[FormUrlEncoded] User.Email :> Post '[JSON] (ResponseJSON User.UserRsp) -- | -- -- Check API calling code. -- -- apiTest :: Manager -> Api.TestReq -> IO (Response Api.TestRsp) apiTest mgr req = run (apiTest_ req) mgr apiTest_ :: Api.TestReq -> ClientM (ResponseJSON Api.TestRsp) -- | -- -- Check authentication and identity. -- -- authTest :: SlackConfig -> IO (Response Auth.TestRsp) authTest = do authR <- mkSlackAuthenticateReq run (authTest_ authR) . slackConfigManager authTest_ :: AuthenticatedRequest (AuthProtect "token") -> ClientM (ResponseJSON Auth.TestRsp) -- | -- -- Retrieve conversations list. -- -- conversationsList :: SlackConfig -> Conversation.ListReq -> IO (Response Conversation.ListRsp) conversationsList = flip $ \listReq -> do authR <- mkSlackAuthenticateReq run (conversationsList_ authR listReq) . slackConfigManager conversationsList_ :: AuthenticatedRequest (AuthProtect "token") -> Conversation.ListReq -> ClientM (ResponseJSON Conversation.ListRsp) -- | -- -- Retrieve ceonversation history. -- Consider using 'historyFetchAll' in combination with this function. -- -- conversationsHistory :: SlackConfig -> Conversation.HistoryReq -> IO (Response Conversation.HistoryRsp) conversationsHistory = flip $ \histReq -> do authR <- mkSlackAuthenticateReq run (conversationsHistory_ authR histReq) . slackConfigManager conversationsHistory_ :: AuthenticatedRequest (AuthProtect "token") -> Conversation.HistoryReq -> ClientM (ResponseJSON Conversation.HistoryRsp) -- | -- -- Retrieve replies of a conversation. -- Consider using 'repliesFetchAll' if you want to get entire replies -- of a conversation. -- -- conversationsReplies :: SlackConfig -> Conversation.RepliesReq -> IO (Response Conversation.HistoryRsp) conversationsReplies = flip $ \repliesReq -> do authR <- mkSlackAuthenticateReq run (conversationsReplies_ authR repliesReq) . slackConfigManager conversationsReplies_ :: AuthenticatedRequest (AuthProtect "token") -> Conversation.RepliesReq -> ClientM (ResponseJSON Conversation.HistoryRsp) -- | -- -- Send a message to a channel. -- -- chatPostMessage :: SlackConfig -> Chat.PostMsgReq -> IO (Response Chat.PostMsgRsp) chatPostMessage = flip $ \postReq -> do authR <- mkSlackAuthenticateReq run (chatPostMessage_ authR postReq) . slackConfigManager chatPostMessage_ :: AuthenticatedRequest (AuthProtect "token") -> Chat.PostMsgReq -> ClientM (ResponseJSON Chat.PostMsgRsp) -- | -- -- This method returns a list of all users in the team. -- This includes deleted/deactivated users. -- -- usersList :: SlackConfig -> IO (Response User.ListRsp) usersList = do authR <- mkSlackAuthenticateReq run (usersList_ authR) . slackConfigManager usersList_ :: AuthenticatedRequest (AuthProtect "token") -> ClientM (ResponseJSON User.ListRsp) -- | -- -- This method returns a list of all users in the team. -- This includes deleted/deactivated users. -- -- userLookupByEmail :: SlackConfig -> User.Email -> IO (Response User.UserRsp) userLookupByEmail = flip $ \email -> do authR <- mkSlackAuthenticateReq run (userLookupByEmail_ authR email) . slackConfigManager userLookupByEmail_ :: AuthenticatedRequest (AuthProtect "token") -> User.Email -> ClientM (ResponseJSON User.UserRsp) -- | Returns a function to get a username from a 'Common.UserId'. -- Comes in handy to use 'Web.Slack.MessageParser.messageToHtml' getUserDesc :: (Common.UserId -> Text) -- ^ A function to give a default username in case the username is unknown -> User.ListRsp -- ^ List of users as known by the slack server. See 'usersList'. -> (Common.UserId -> Text) -- ^ A function from 'Common.UserId' to username. getUserDesc unknownUserFn users = let userMap = Map.fromList $ (User.userId &&& User.userName) <$> User.listRspMembers users in \userId -> fromMaybe (unknownUserFn userId) $ Map.lookup userId userMap -- | Returns an action to send a request to get the history of a conversation. -- -- To fetch all messages in the conversation, run the returned 'LoadPage' action -- repeatedly until it returns an empty list. conversationsHistoryAll :: SlackConfig -> Conversation.HistoryReq -- ^ The first request to send. _NOTE_: 'Conversation.historyReqCursor' is silently ignored. -> IO (LoadPage IO Common.Message) -- ^ An action which returns a new page of messages every time called. -- If there are no pages anymore, it returns an empty list. conversationsHistoryAll = conversationsHistoryAllBy . conversationsHistory -- | Returns an action to send a request to get the replies of a conversation. -- -- To fetch all replies in the conversation, run the returned 'LoadPage' action -- repeatedly until it returns an empty list. -- -- *NOTE*: The conversations.replies endpoint always returns the first message -- of the thread. So every page returned by the 'LoadPage' action includes -- the first message of the thread. You should drop it if you want to -- collect messages in a thread without duplicates. repliesFetchAll :: SlackConfig -> Conversation.RepliesReq -- ^ The first request to send. _NOTE_: 'Conversation.repliesReqCursor' is silently ignored. -> IO (LoadPage IO Common.Message) -- ^ An action which returns a new page of messages every time called. -- If there are no pages anymore, it returns an empty list. repliesFetchAll = repliesFetchAllBy . conversationsReplies apiTest_ :<|> authTest_ :<|> conversationsList_ :<|> conversationsHistory_ :<|> conversationsReplies_ :<|> chatPostMessage_ :<|> usersList_ :<|> userLookupByEmail_ = client (Proxy :: Proxy Api) -- | -- -- type instance AuthClientData (AuthProtect "token") = Text -- | -- -- authenticateReq :: Text -> Request -> Request authenticateReq token = addHeader "Authorization" $ "Bearer " <> token -- | -- -- run :: ClientM (ResponseJSON a) -> Manager -> IO (Response a) run clientAction mgr = do let baseUrl = BaseUrl Https "slack.com" 443 "/api" unnestErrors <$> liftIO (runClientM clientAction $ mkClientEnv mgr baseUrl) mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token") mkSlackAuthenticateReq = (`mkAuthenticatedRequest` authenticateReq) . slackConfigToken unnestErrors :: Either ClientError (ResponseJSON a) -> Response a unnestErrors (Right (ResponseJSON (Right a))) = Right a unnestErrors (Right (ResponseJSON (Left (ResponseSlackError serv)))) = Left (Common.SlackError serv) unnestErrors (Left slackErr) = Left (Common.ServantError slackErr) -- | Prepare a SlackConfig from a slack token. -- You can then call the other functions providing this in a reader context. -- mkSlackConfig :: Text -> IO SlackConfig mkSlackConfig token = SlackConfig <$> newManager tlsManagerSettings <*> pure token