{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE CPP #-}

----------------------------------------------------------------------
-- |
-- Module: Web.Slack
-- Description:
--
--
--
----------------------------------------------------------------------

module Web.Slack
  ( SlackConfig(..)
  , mkSlackConfig
  , apiTest
  , authTest
  , chatPostMessage
  , conversationsList
  , conversationsHistory
  , conversationsHistoryAll
  , conversationsReplies
  , repliesFetchAll
  , getUserDesc
  , usersList
  , userLookupByEmail
  , authenticateReq
  , Response
  , LoadPage
  , HasManager(..)
  , HasToken(..)
  )
  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

-- servant-client
import Servant.Client hiding (Response, baseUrl)
import Servant.Client.Core (Request, appendToQueryString)

-- 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

#if MIN_VERSION_servant(0,16,0)
import Servant.Client.Core (AuthenticatedRequest, AuthClientData, mkAuthenticatedRequest, ClientError)
#else
import Servant.Client.Core.Internal.Auth
import Servant.Client.Core (ServantError)
type ClientError = ServantError
#endif

class HasManager a where
    getManager :: a -> Manager

class HasToken a where
    getToken :: a -> Text

-- | Implements the 'HasManager' and 'HasToken' typeclasses.
data SlackConfig
  = SlackConfig
  { SlackConfig -> Manager
slackConfigManager :: Manager
  , SlackConfig -> Text
slackConfigToken :: Text
  }

instance HasManager SlackConfig where
    getManager :: SlackConfig -> Manager
getManager = SlackConfig -> Manager
slackConfigManager
instance HasToken SlackConfig where
    getToken :: SlackConfig -> Text
getToken = SlackConfig -> Text
slackConfigToken

-- 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 (ResponseSlackError -> ResponseSlackError -> Bool
(ResponseSlackError -> ResponseSlackError -> Bool)
-> (ResponseSlackError -> ResponseSlackError -> Bool)
-> Eq ResponseSlackError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseSlackError -> ResponseSlackError -> Bool
$c/= :: ResponseSlackError -> ResponseSlackError -> Bool
== :: ResponseSlackError -> ResponseSlackError -> Bool
$c== :: ResponseSlackError -> ResponseSlackError -> Bool
Eq, Int -> ResponseSlackError -> ShowS
[ResponseSlackError] -> ShowS
ResponseSlackError -> String
(Int -> ResponseSlackError -> ShowS)
-> (ResponseSlackError -> String)
-> ([ResponseSlackError] -> ShowS)
-> Show ResponseSlackError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseSlackError] -> ShowS
$cshowList :: [ResponseSlackError] -> ShowS
show :: ResponseSlackError -> String
$cshow :: ResponseSlackError -> String
showsPrec :: Int -> ResponseSlackError -> ShowS
$cshowsPrec :: Int -> ResponseSlackError -> ShowS
Show)


-- |
-- Internal type!
--
newtype ResponseJSON a = ResponseJSON (Either ResponseSlackError a)

instance FromJSON a => FromJSON (ResponseJSON a) where
    parseJSON :: Value -> Parser (ResponseJSON a)
parseJSON = String
-> (Object -> Parser (ResponseJSON a))
-> Value
-> Parser (ResponseJSON a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Response" ((Object -> Parser (ResponseJSON a))
 -> Value -> Parser (ResponseJSON a))
-> (Object -> Parser (ResponseJSON a))
-> Value
-> Parser (ResponseJSON a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Bool
ok <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ok"
        Either ResponseSlackError a -> ResponseJSON a
forall a. Either ResponseSlackError a -> ResponseJSON a
ResponseJSON (Either ResponseSlackError a -> ResponseJSON a)
-> Parser (Either ResponseSlackError a) -> Parser (ResponseJSON a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
ok
           then a -> Either ResponseSlackError a
forall a b. b -> Either a b
Right (a -> Either ResponseSlackError a)
-> Parser a -> Parser (Either ResponseSlackError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
           else ResponseSlackError -> Either ResponseSlackError a
forall a b. a -> Either a b
Left (ResponseSlackError -> Either ResponseSlackError a)
-> (Text -> ResponseSlackError)
-> Text
-> Either ResponseSlackError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ResponseSlackError
ResponseSlackError (Text -> Either ResponseSlackError a)
-> Parser Text -> Parser (Either ResponseSlackError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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.
--
-- <https://api.slack.com/methods/api.test>

apiTest
  :: (MonadReader env m, HasManager env, MonadIO m)
  => Api.TestReq
  -> m (Response Api.TestRsp)
apiTest :: TestReq -> m (Response TestRsp)
apiTest TestReq
req = ClientM (ResponseJSON TestRsp) -> m (Response TestRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (TestReq -> ClientM (ResponseJSON TestRsp)
apiTest_ TestReq
req)

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

-- |
--
-- Check authentication and identity.
--
-- <https://api.slack.com/methods/auth.test>

authTest
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => m (Response Auth.TestRsp)
authTest :: m (Response TestRsp)
authTest = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON TestRsp) -> m (Response TestRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> ClientM (ResponseJSON TestRsp)
authTest_ AuthenticatedRequest (AuthProtect "token")
authR)

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

-- |
--
-- Retrieve conversations list.
--
-- <https://api.slack.com/methods/conversations.list>

conversationsList
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Conversation.ListReq
  -> m (Response Conversation.ListRsp)
conversationsList :: ListReq -> m (Response ListRsp)
conversationsList ListReq
listReq = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON ListRsp) -> m (Response ListRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> ListReq -> ClientM (ResponseJSON ListRsp)
conversationsList_ AuthenticatedRequest (AuthProtect "token")
authR ListReq
listReq)

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


-- |
--
-- Retrieve ceonversation history.
-- Consider using 'historyFetchAll' in combination with this function.
--
-- <https://api.slack.com/methods/conversations.history>

conversationsHistory
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Conversation.HistoryReq
  -> m (Response Conversation.HistoryRsp)
conversationsHistory :: HistoryReq -> m (Response HistoryRsp)
conversationsHistory HistoryReq
histReq = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON HistoryRsp) -> m (Response HistoryRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> HistoryReq -> ClientM (ResponseJSON HistoryRsp)
conversationsHistory_ AuthenticatedRequest (AuthProtect "token")
authR HistoryReq
histReq)

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
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Conversation.RepliesReq
  -> m (Response Conversation.HistoryRsp)
conversationsReplies :: RepliesReq -> m (Response HistoryRsp)
conversationsReplies RepliesReq
repliesReq = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON HistoryRsp) -> m (Response HistoryRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> RepliesReq -> ClientM (ResponseJSON HistoryRsp)
conversationsReplies_ AuthenticatedRequest (AuthProtect "token")
authR RepliesReq
repliesReq)

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


-- |
--
-- Send a message to a channel.
--
-- <https://api.slack.com/methods/chat.postMessage>

chatPostMessage
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => Chat.PostMsgReq
  -> m (Response Chat.PostMsgRsp)
chatPostMessage :: PostMsgReq -> m (Response PostMsgRsp)
chatPostMessage PostMsgReq
postReq = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON PostMsgRsp) -> m (Response PostMsgRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> PostMsgReq -> ClientM (ResponseJSON PostMsgRsp)
chatPostMessage_ AuthenticatedRequest (AuthProtect "token")
authR PostMsgReq
postReq)

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.
--
-- <https://api.slack.com/methods/users.list>

usersList
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => m (Response User.ListRsp)
usersList :: m (Response ListRsp)
usersList = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON ListRsp) -> m (Response ListRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> ClientM (ResponseJSON ListRsp)
usersList_ AuthenticatedRequest (AuthProtect "token")
authR)

usersList_
  :: AuthenticatedRequest (AuthProtect "token")
  -> ClientM (ResponseJSON User.ListRsp)

-- |
--
-- This method returns a list of all users in the team.
-- This includes deleted/deactivated users.
--
-- <https://api.slack.com/methods/users.lookupByEmail>

userLookupByEmail
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  => User.Email 
  -> m (Response User.UserRsp)
userLookupByEmail :: Email -> m (Response UserRsp)
userLookupByEmail Email
email = do
  AuthenticatedRequest (AuthProtect "token")
authR <- m (AuthenticatedRequest (AuthProtect "token"))
forall env (m :: * -> *).
(MonadReader env m, HasToken env) =>
m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq
  ClientM (ResponseJSON UserRsp) -> m (Response UserRsp)
forall env (m :: * -> *) a.
(MonadReader env m, HasManager env, MonadIO m) =>
ClientM (ResponseJSON a) -> m (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> Email -> ClientM (ResponseJSON UserRsp)
userLookupByEmail_ AuthenticatedRequest (AuthProtect "token")
authR Email
email)

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 :: (UserId -> Text) -> ListRsp -> UserId -> Text
getUserDesc UserId -> Text
unknownUserFn ListRsp
users =
  let userMap :: Map UserId Text
userMap = [(UserId, Text)] -> Map UserId Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UserId, Text)] -> Map UserId Text)
-> [(UserId, Text)] -> Map UserId Text
forall a b. (a -> b) -> a -> b
$ (User -> UserId
User.userId (User -> UserId) -> (User -> Text) -> User -> (UserId, Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& User -> Text
User.userName) (User -> (UserId, Text)) -> [User] -> [(UserId, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRsp -> [User]
User.listRspMembers ListRsp
users
  in
    \UserId
userId -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (UserId -> Text
unknownUserFn UserId
userId) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ UserId -> Map UserId Text -> Maybe Text
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
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  =>  Conversation.HistoryReq
  -- ^ The first request to send. _NOTE_: 'Conversation.historyReqCursor' is silently ignored.
  -> m (LoadPage m 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 :: HistoryReq -> m (LoadPage m Message)
conversationsHistoryAll = (HistoryReq -> m (Response HistoryRsp))
-> HistoryReq -> m (LoadPage m Message)
forall (m :: * -> *).
MonadIO m =>
(HistoryReq -> m (Response HistoryRsp))
-> HistoryReq -> m (LoadPage m Message)
conversationsHistoryAllBy HistoryReq -> m (Response HistoryRsp)
forall env (m :: * -> *).
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
HistoryReq -> m (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
  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)
  =>  Conversation.RepliesReq
  -- ^ The first request to send. _NOTE_: 'Conversation.repliesReqCursor' is silently ignored.
  -> m (LoadPage m 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 :: RepliesReq -> m (LoadPage m Message)
repliesFetchAll = (RepliesReq -> m (Response HistoryRsp))
-> RepliesReq -> m (LoadPage m Message)
forall (m :: * -> *).
MonadIO m =>
(RepliesReq -> m (Response HistoryRsp))
-> RepliesReq -> m (LoadPage m Message)
repliesFetchAllBy RepliesReq -> m (Response HistoryRsp)
forall env (m :: * -> *).
(MonadReader env m, HasManager env, HasToken env, MonadIO m) =>
RepliesReq -> m (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")
-> ClientM (ResponseJSON ListRsp)
usersList_
  :<|> AuthenticatedRequest (AuthProtect "token")
-> Email -> ClientM (ResponseJSON UserRsp)
userLookupByEmail_
  =
  Proxy Api -> Client ClientM Api
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy Api
forall k (t :: k). Proxy t
Proxy :: Proxy Api)


-- |
--
--

type instance AuthClientData (AuthProtect "token") =
  Text


-- |
--
--

authenticateReq
  :: Text
  -> Request
  -> Request
authenticateReq :: Text -> Request -> Request
authenticateReq Text
token =
  Text -> Maybe Text -> Request -> Request
appendToQueryString Text
"token" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
token)


-- |
--
--

run
  :: (MonadReader env m, HasManager env, MonadIO m)
  => ClientM (ResponseJSON a)
  -> m (Response a)
run :: ClientM (ResponseJSON a) -> m (Response a)
run ClientM (ResponseJSON a)
clientAction = do
  env
env <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let baseUrl :: BaseUrl
baseUrl = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"slack.com" Int
443 String
"/api"
  Either ClientError (ResponseJSON a) -> Response a
forall a. Either ClientError (ResponseJSON a) -> Response a
unnestErrors (Either ClientError (ResponseJSON a) -> Response a)
-> m (Either ClientError (ResponseJSON a)) -> m (Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ClientError (ResponseJSON a))
-> m (Either ClientError (ResponseJSON a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientM (ResponseJSON a)
-> ClientEnv -> IO (Either ClientError (ResponseJSON a))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (ResponseJSON a)
clientAction (ClientEnv -> IO (Either ClientError (ResponseJSON a)))
-> ClientEnv -> IO (Either ClientError (ResponseJSON a))
forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv (env -> Manager
forall a. HasManager a => a -> Manager
getManager env
env) BaseUrl
baseUrl)

mkSlackAuthenticateReq :: (MonadReader env m, HasToken env)
  => m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq :: m (AuthenticatedRequest (AuthProtect "token"))
mkSlackAuthenticateReq = (Text
 -> (Text -> Request -> Request)
 -> AuthenticatedRequest (AuthProtect "token"))
-> (Text -> Request -> Request)
-> Text
-> AuthenticatedRequest (AuthProtect "token")
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text
-> (Text -> Request -> Request)
-> AuthenticatedRequest (AuthProtect "token")
forall a.
AuthClientData a
-> (AuthClientData a -> Request -> Request)
-> AuthenticatedRequest a
mkAuthenticatedRequest Text -> Request -> Request
authenticateReq (Text -> AuthenticatedRequest (AuthProtect "token"))
-> (env -> Text)
-> env
-> AuthenticatedRequest (AuthProtect "token")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> Text
forall a. HasToken a => a -> Text
getToken (env -> AuthenticatedRequest (AuthProtect "token"))
-> m env -> m (AuthenticatedRequest (AuthProtect "token"))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m env
forall r (m :: * -> *). MonadReader r m => m r
ask

unnestErrors :: Either ClientError (ResponseJSON a) -> Response a
unnestErrors :: Either ClientError (ResponseJSON a) -> Response a
unnestErrors (Right (ResponseJSON (Right a
a))) = a -> Response a
forall a b. b -> Either a b
Right a
a
unnestErrors (Right (ResponseJSON (Left (ResponseSlackError Text
serv))))
    = SlackClientError -> Response a
forall a b. a -> Either a b
Left (Text -> SlackClientError
Common.SlackError Text
serv)
unnestErrors (Left ClientError
slackErr) = SlackClientError -> Response a
forall a b. a -> Either a b
Left (ClientError -> SlackClientError
Common.ServantError ClientError
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 :: Text -> IO SlackConfig
mkSlackConfig Text
token = Manager -> Text -> SlackConfig
SlackConfig (Manager -> Text -> SlackConfig)
-> IO Manager -> IO (Text -> SlackConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings IO (Text -> SlackConfig) -> IO Text -> IO SlackConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
token