-- | 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
(ResponseSlackError -> ResponseSlackError -> Bool)
-> (ResponseSlackError -> ResponseSlackError -> Bool)
-> Eq ResponseSlackError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseSlackError -> ResponseSlackError -> Bool
== :: ResponseSlackError -> ResponseSlackError -> Bool
$c/= :: ResponseSlackError -> ResponseSlackError -> Bool
/= :: 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
$cshowsPrec :: Int -> ResponseSlackError -> ShowS
showsPrec :: Int -> ResponseSlackError -> ShowS
$cshow :: ResponseSlackError -> String
show :: ResponseSlackError -> String
$cshowList :: [ResponseSlackError] -> ShowS
showList :: [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 -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
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 (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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"

mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq = (AuthClientData (AuthProtect "token")
-> (AuthClientData (AuthProtect "token") -> Request -> Request)
-> AuthenticatedRequest (AuthProtect "token")
forall a.
AuthClientData a
-> (AuthClientData a -> Request -> Request)
-> AuthenticatedRequest a
`mkAuthenticatedRequest` Text -> Request -> Request
AuthClientData (AuthProtect "token") -> Request -> Request
authenticateReq) (Text -> AuthenticatedRequest (AuthProtect "token"))
-> (SlackConfig -> Text)
-> SlackConfig
-> AuthenticatedRequest (AuthProtect "token")
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 =
  HeaderName -> Text -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"Authorization" (Text -> Request -> Request) -> Text -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Text
"Bearer " Text -> Text -> Text
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"
  Either ClientError (ResponseJSON a) -> Response a
forall a. Either ClientError (ResponseJSON a) -> Response a
unnestErrors (Either ClientError (ResponseJSON a) -> Response a)
-> IO (Either ClientError (ResponseJSON a)) -> IO (Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ClientError (ResponseJSON a))
-> IO (Either ClientError (ResponseJSON a))
forall a. IO a -> IO 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 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))) = a -> Either SlackClientError a
forall a b. b -> Either a b
Right a
a
unnestErrors (Right (ResponseJSON (Left (ResponseSlackError Text
serv)))) =
  SlackClientError -> Either SlackClientError a
forall a b. a -> Either a b
Left (Text -> SlackClientError
Common.SlackError Text
serv)
unnestErrors (Left ClientError
slackErr) = SlackClientError -> Either SlackClientError a
forall a b. a -> Either a b
Left (ClientError -> SlackClientError
Common.ServantError ClientError
slackErr)