{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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,

    -- * Endpoints
    apiTest,
    authTest,
    chatPostMessage,
    chatUpdate,
    conversationsList,
    conversationsListAll,
    conversationsHistory,
    conversationsHistoryAll,
    conversationsReplies,
    repliesFetchAll,
    getUserDesc,
    usersList,
    usersListAll,
    userLookupByEmail,
    UsersConversations.usersConversations,
    UsersConversations.usersConversationsAll,

    -- * Requests and responses
    authenticateReq,
    Response,
    LoadPage,
  )
where

-- FIXME: Web.Slack.Prelude

import Control.Arrow ((&&&))
import Data.Map qualified as Map
import Data.Maybe
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Servant.API hiding (addHeader)
import Servant.Client hiding (Response, baseUrl)
import Servant.Client.Core (AuthenticatedRequest)
import Web.Slack.Api qualified as Api
import Web.Slack.Auth qualified as Auth
import Web.Slack.Chat qualified as Chat
import Web.Slack.Common qualified as Common
import Web.Slack.Conversation qualified as Conversation
import Web.Slack.Internal
import Web.Slack.Pager
import Web.Slack.User qualified as User
import Web.Slack.UsersConversations qualified as UsersConversations
import Prelude

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)
    :<|> "chat.update"
      :> AuthProtect "token"
      :> ReqBody '[FormUrlEncoded] Chat.UpdateReq
      :> Post '[JSON] (ResponseJSON Chat.UpdateRsp)
    :<|> "users.list"
      :> AuthProtect "token"
      :> ReqBody '[FormUrlEncoded] User.ListReq
      :> Post '[JSON] (ResponseJSON User.ListRsp)
    :<|> "users.lookupByEmail"
      :> AuthProtect "token"
      :> ReqBody '[FormUrlEncoded] User.Email
      :> Post '[JSON] (ResponseJSON User.UserRsp)

-- |
--
-- Check API calling code.
--
-- <https://api.slack.com/methods/api.test>
apiTest ::
  Manager ->
  Api.TestReq ->
  IO (Response Api.TestRsp)
apiTest :: Manager -> TestReq -> IO (Response TestRsp)
apiTest Manager
mgr TestReq
req = forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (TestReq -> ClientM (ResponseJSON TestRsp)
apiTest_ TestReq
req) Manager
mgr

apiTest_ ::
  Api.TestReq ->
  ClientM (ResponseJSON Api.TestRsp)

-- |
--
-- Check authentication and identity.
--
-- <https://api.slack.com/methods/auth.test>
authTest ::
  SlackConfig ->
  IO (Response Auth.TestRsp)
authTest :: SlackConfig -> IO (Response TestRsp)
authTest = do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> ClientM (ResponseJSON TestRsp)
authTest_ AuthenticatedRequest (AuthProtect "token")
authR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
slackConfigManager

authTest_ ::
  AuthenticatedRequest (AuthProtect "token") ->
  ClientM (ResponseJSON Auth.TestRsp)

-- |
--
-- Retrieve conversations list.
--
-- <https://api.slack.com/methods/conversations.list>
conversationsList ::
  SlackConfig ->
  Conversation.ListReq ->
  IO (Response Conversation.ListRsp)
conversationsList :: SlackConfig -> ListReq -> IO (Response ListRsp)
conversationsList = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \ListReq
listReq -> do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> ListReq -> ClientM (ResponseJSON ListRsp)
conversationsList_ AuthenticatedRequest (AuthProtect "token")
authR ListReq
listReq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
slackConfigManager

conversationsList_ ::
  AuthenticatedRequest (AuthProtect "token") ->
  Conversation.ListReq ->
  ClientM (ResponseJSON Conversation.ListRsp)

-- | Returns an action to send a request to get the list of conversations in the
--   workspace.
--
--   To fetch all replies in the conversation, run the returned 'LoadPage' action
--   repeatedly until it returns an empty list.
conversationsListAll ::
  SlackConfig ->
  -- | The first request to send. _NOTE_: 'Conversation.listReqCursor' is silently ignored.
  Conversation.ListReq ->
  -- | An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
  IO (LoadPage IO Conversation.Conversation)
conversationsListAll :: SlackConfig -> ListReq -> IO (LoadPage IO Conversation)
conversationsListAll = forall (m :: * -> *) req resp.
(MonadIO m, PagedRequest req, PagedResponse resp) =>
(req -> m (Response resp))
-> req -> m (LoadPage m (ResponseObject resp))
fetchAllBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> ListReq -> IO (Response ListRsp)
conversationsList

-- |
--
-- Retrieve ceonversation history.
-- Consider using 'historyFetchAll' in combination with this function.
--
-- <https://api.slack.com/methods/conversations.history>
conversationsHistory ::
  SlackConfig ->
  Conversation.HistoryReq ->
  IO (Response Conversation.HistoryRsp)
conversationsHistory :: SlackConfig -> HistoryReq -> IO (Response HistoryRsp)
conversationsHistory = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \HistoryReq
histReq -> do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> HistoryReq -> ClientM (ResponseJSON HistoryRsp)
conversationsHistory_ AuthenticatedRequest (AuthProtect "token")
authR HistoryReq
histReq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
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.
--
-- <https://api.slack.com/methods/conversations.replies>
conversationsReplies ::
  SlackConfig ->
  Conversation.RepliesReq ->
  IO (Response Conversation.HistoryRsp)
conversationsReplies :: SlackConfig -> RepliesReq -> IO (Response HistoryRsp)
conversationsReplies = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \RepliesReq
repliesReq -> do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> RepliesReq -> ClientM (ResponseJSON HistoryRsp)
conversationsReplies_ AuthenticatedRequest (AuthProtect "token")
authR RepliesReq
repliesReq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
slackConfigManager

conversationsReplies_ ::
  AuthenticatedRequest (AuthProtect "token") ->
  Conversation.RepliesReq ->
  ClientM (ResponseJSON Conversation.HistoryRsp)

-- |
--
-- Send a message to a channel.
--
-- <https://api.slack.com/methods/chat.postMessage>
chatPostMessage ::
  SlackConfig ->
  Chat.PostMsgReq ->
  IO (Response Chat.PostMsgRsp)
chatPostMessage :: SlackConfig -> PostMsgReq -> IO (Response PostMsgRsp)
chatPostMessage = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \PostMsgReq
postReq -> do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> PostMsgReq -> ClientM (ResponseJSON PostMsgRsp)
chatPostMessage_ AuthenticatedRequest (AuthProtect "token")
authR PostMsgReq
postReq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
slackConfigManager

chatPostMessage_ ::
  AuthenticatedRequest (AuthProtect "token") ->
  Chat.PostMsgReq ->
  ClientM (ResponseJSON Chat.PostMsgRsp)

-- | Updates a message.
--
-- <https://api.slack.com/methods/chat.update>
chatUpdate ::
  SlackConfig ->
  Chat.UpdateReq ->
  IO (Response Chat.UpdateRsp)
chatUpdate :: SlackConfig -> UpdateReq -> IO (Response UpdateRsp)
chatUpdate = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \UpdateReq
updateReq -> do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> UpdateReq -> ClientM (ResponseJSON UpdateRsp)
chatUpdate_ AuthenticatedRequest (AuthProtect "token")
authR UpdateReq
updateReq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
slackConfigManager

chatUpdate_ ::
  AuthenticatedRequest (AuthProtect "token") ->
  Chat.UpdateReq ->
  ClientM (ResponseJSON Chat.UpdateRsp)

-- | This method returns a list of all users in the team.
-- This includes deleted/deactivated users.
--
-- <https://api.slack.com/methods/users.list>
usersList ::
  SlackConfig ->
  User.ListReq ->
  IO (Response User.ListRsp)
usersList :: SlackConfig -> ListReq -> IO (Response ListRsp)
usersList SlackConfig
config ListReq
req = do
  let authR :: AuthenticatedRequest (AuthProtect "token")
authR = SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq SlackConfig
config
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> ListReq -> ClientM (ResponseJSON ListRsp)
usersList_ AuthenticatedRequest (AuthProtect "token")
authR ListReq
req) (SlackConfig -> Manager
slackConfigManager SlackConfig
config)

usersList_ ::
  AuthenticatedRequest (AuthProtect "token") ->
  User.ListReq ->
  ClientM (ResponseJSON User.ListRsp)
usersListAll ::
  SlackConfig ->
  -- | The first request to send. _NOTE_: 'User.listReqCursor' is silently ignored.
  User.ListReq ->
  -- | An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
  IO (LoadPage IO User.User)
usersListAll :: SlackConfig -> ListReq -> IO (LoadPage IO User)
usersListAll = forall (m :: * -> *) req resp.
(MonadIO m, PagedRequest req, PagedResponse resp) =>
(req -> m (Response resp))
-> req -> m (LoadPage m (ResponseObject resp))
fetchAllBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> ListReq -> IO (Response ListRsp)
usersList

-- | Find a user by email address.
--
-- <https://api.slack.com/methods/users.lookupByEmail>
userLookupByEmail ::
  SlackConfig ->
  User.Email ->
  IO (Response User.UserRsp)
userLookupByEmail :: SlackConfig -> Email -> IO (Response UserRsp)
userLookupByEmail = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \Email
email -> do
  AuthenticatedRequest (AuthProtect "token")
authR <- SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq
  forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> Email -> ClientM (ResponseJSON UserRsp)
userLookupByEmail_ AuthenticatedRequest (AuthProtect "token")
authR Email
email) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> Manager
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 ::
  -- | A function to give a default username in case the username is unknown
  (Common.UserId -> Text) ->
  -- | List of users as known by the slack server. See 'usersList'.
  User.ListRsp ->
  -- | A function from 'Common.UserId' to username.
  (Common.UserId -> Text)
getUserDesc :: (UserId -> Text) -> ListRsp -> UserId -> Text
getUserDesc UserId -> Text
unknownUserFn ListRsp
users =
  let userMap :: Map UserId Text
userMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ (User -> UserId
User.userId forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& User -> Text
User.userName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRsp -> [User]
User.listRspMembers ListRsp
users
   in \UserId
userId -> forall a. a -> Maybe a -> a
fromMaybe (UserId -> Text
unknownUserFn UserId
userId) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UserId
userId Map UserId Text
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 ->
  -- | The first request to send. _NOTE_: 'Conversation.historyReqCursor' is silently ignored.
  Conversation.HistoryReq ->
  -- | An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
  IO (LoadPage IO Common.Message)
conversationsHistoryAll :: SlackConfig -> HistoryReq -> IO (LoadPage IO Message)
conversationsHistoryAll = forall (m :: * -> *) req resp.
(MonadIO m, PagedRequest req, PagedResponse resp) =>
(req -> m (Response resp))
-> req -> m (LoadPage m (ResponseObject resp))
fetchAllBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> HistoryReq -> IO (Response HistoryRsp)
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 ->
  -- | The first request to send. _NOTE_: 'Conversation.repliesReqCursor' is silently ignored.
  Conversation.RepliesReq ->
  -- | An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
  IO (LoadPage IO Common.Message)
repliesFetchAll :: SlackConfig -> RepliesReq -> IO (LoadPage IO Message)
repliesFetchAll = forall (m :: * -> *) req resp.
(MonadIO m, PagedRequest req, PagedResponse resp) =>
(req -> m (Response resp))
-> req -> m (LoadPage m (ResponseObject resp))
fetchAllBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackConfig -> RepliesReq -> IO (Response HistoryRsp)
conversationsReplies

TestReq -> ClientM (ResponseJSON TestRsp)
apiTest_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> ClientM (ResponseJSON TestRsp)
authTest_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> ListReq -> ClientM (ResponseJSON ListRsp)
conversationsList_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> HistoryReq -> ClientM (ResponseJSON HistoryRsp)
conversationsHistory_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> RepliesReq -> ClientM (ResponseJSON HistoryRsp)
conversationsReplies_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> PostMsgReq -> ClientM (ResponseJSON PostMsgRsp)
chatPostMessage_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> UpdateReq -> ClientM (ResponseJSON UpdateRsp)
chatUpdate_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> ListReq -> ClientM (ResponseJSON ListRsp)
usersList_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> Email -> ClientM (ResponseJSON UserRsp)
userLookupByEmail_ =
    forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy :: Proxy Api)

-- | 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 :: Text -> IO SlackConfig
mkSlackConfig Text
token = Manager -> Text -> SlackConfig
SlackConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
token