-- | Internal things in slack-web. May be changed arbitrarily!
module Web.Slack.Internal where

import Data.Aeson (Value (..))
import Network.HTTP.Client (Manager)
import Servant.API hiding (addHeader)
-- import Servant.Client.Core

import Servant.Client (BaseUrl (..), ClientError, ClientM, Scheme (..), mkClientEnv, runClientM)
import Servant.Client.Core (AuthClientData, AuthenticatedRequest, Request, addHeader, mkAuthenticatedRequest)
import Web.Slack.Common qualified as Common
import Web.Slack.Pager (Response)
import Web.Slack.Prelude

data SlackConfig = SlackConfig
  { SlackConfig -> Manager
slackConfigManager :: Manager
  , SlackConfig -> Text
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 stock (ResponseSlackError -> ResponseSlackError -> Bool
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Response" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Bool
ok <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ok"
    forall a. Either ResponseSlackError a -> ResponseJSON a
ResponseJSON
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
ok
        then forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        else forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ResponseSlackError
ResponseSlackError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"

mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq = (forall a.
AuthClientData a
-> (AuthClientData a -> Request -> Request)
-> AuthenticatedRequest a
`mkAuthenticatedRequest` Text -> Request -> Request
authenticateReq) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlackConfig -> Text
slackConfigToken

type instance
  AuthClientData (AuthProtect "token") =
    Text

authenticateReq ::
  Text ->
  Request ->
  Request
authenticateReq :: Text -> Request -> Request
authenticateReq Text
token =
  forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"Authorization" forall a b. (a -> b) -> a -> b
$ Text
"Bearer " forall a. Semigroup a => a -> a -> a
<> Text
token

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

unnestErrors :: Either ClientError (ResponseJSON a) -> Response a
unnestErrors :: forall a. Either ClientError (ResponseJSON a) -> Response a
unnestErrors (Right (ResponseJSON (Right a
a))) = forall a b. b -> Either a b
Right a
a
unnestErrors (Right (ResponseJSON (Left (ResponseSlackError Text
serv)))) =
  forall a b. a -> Either a b
Left (Text -> SlackClientError
Common.SlackError Text
serv)
unnestErrors (Left ClientError
slackErr) = forall a b. a -> Either a b
Left (ClientError -> SlackClientError
Common.ServantError ClientError
slackErr)