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

import Data.Aeson (Value (..))
-- import Servant.Client.Core

import Data.Aeson.KeyMap qualified as KM
import Network.HTTP.Client (Manager)
import Servant.API hiding (addHeader)
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
  }

-- |
-- Internal type!
newtype ResponseJSON a = ResponseJSON (Either Common.ResponseSlackError a)
  deriving stock (Int -> ResponseJSON a -> ShowS
[ResponseJSON a] -> ShowS
ResponseJSON a -> String
(Int -> ResponseJSON a -> ShowS)
-> (ResponseJSON a -> String)
-> ([ResponseJSON a] -> ShowS)
-> Show (ResponseJSON a)
forall a. Show a => Int -> ResponseJSON a -> ShowS
forall a. Show a => [ResponseJSON a] -> ShowS
forall a. Show a => ResponseJSON a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ResponseJSON a -> ShowS
showsPrec :: Int -> ResponseJSON a -> ShowS
$cshow :: forall a. Show a => ResponseJSON a -> String
show :: ResponseJSON a -> String
$cshowList :: forall a. Show a => [ResponseJSON a] -> ShowS
showList :: [ResponseJSON a] -> ShowS
Show)

type role ResponseJSON representational

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 do
          Text
err <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
          Maybe Object
meta <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_metadata"
          Either ResponseSlackError a -> Parser (Either ResponseSlackError a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseSlackError a
 -> Parser (Either ResponseSlackError a))
-> Either ResponseSlackError a
-> Parser (Either ResponseSlackError a)
forall a b. (a -> b) -> a -> b
$ ResponseSlackError -> Either ResponseSlackError a
forall a b. a -> Either a b
Left (ResponseSlackError -> Either ResponseSlackError a)
-> ResponseSlackError -> Either ResponseSlackError a
forall a b. (a -> b) -> a -> b
$ Common.ResponseSlackError {errorText :: Text
errorText = Text
err, responseMetadata :: Object
responseMetadata = (Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall v. KeyMap v
KM.empty Maybe Object
meta)}

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
err))) =
  SlackClientError -> Either SlackClientError a
forall a b. a -> Either a b
Left (ResponseSlackError -> SlackClientError
Common.SlackError ResponseSlackError
err)
unnestErrors (Left ClientError
slackErr) = SlackClientError -> Either SlackClientError a
forall a b. a -> Either a b
Left (ClientError -> SlackClientError
Common.ServantError ClientError
slackErr)