{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}

-- | API methods relating to reactions:
--
-- - <https://api.slack.com/methods/reactions.add>
-- - <https://api.slack.com/methods/reactions.get>
-- - <https://api.slack.com/methods/reactions.list>
-- - <https://api.slack.com/methods/reactions.remove>
--
-- @since 2.1.0.0
module Web.Slack.Reactions (AddReq (..), AddResp (..), Api, reactionsAdd, reactionsAdd_) where

import Data.Aeson qualified as A
import Servant.API (AuthProtect, FormUrlEncoded, JSON, Post, ReqBody, (:>))
import Servant.Client (ClientM, client)
import Servant.Client.Core (AuthenticatedRequest)
import Web.FormUrlEncoded (ToForm (..))
import Web.Slack.Internal (ResponseJSON (..), SlackConfig (..), mkSlackAuthenticateReq, run)
import Web.Slack.Pager (Response)
import Web.Slack.Prelude
import Web.Slack.Types (ConversationId (..), Emoji (..))

-- | Add a reaction to a message.
--
-- <https://api.slack.com/methods/reactions.add>
--
-- @since 2.1.0.0
data AddReq = AddReq
  { AddReq -> ConversationId
channel :: ConversationId
  -- ^ Conversation in which to react.
  , AddReq -> Emoji
name :: Emoji
  -- ^ Emoji name. For Unicode emoji, this is the name, not the character.
  , AddReq -> Text
timestamp :: Text
  -- ^ Message @ts@ to react to.
  }
  deriving stock (Int -> AddReq -> ShowS
[AddReq] -> ShowS
AddReq -> String
(Int -> AddReq -> ShowS)
-> (AddReq -> String) -> ([AddReq] -> ShowS) -> Show AddReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddReq -> ShowS
showsPrec :: Int -> AddReq -> ShowS
$cshow :: AddReq -> String
show :: AddReq -> String
$cshowList :: [AddReq] -> ShowS
showList :: [AddReq] -> ShowS
Show, AddReq -> AddReq -> Bool
(AddReq -> AddReq -> Bool)
-> (AddReq -> AddReq -> Bool) -> Eq AddReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddReq -> AddReq -> Bool
== :: AddReq -> AddReq -> Bool
$c/= :: AddReq -> AddReq -> Bool
/= :: AddReq -> AddReq -> Bool
Eq)

instance ToForm AddReq where
  toForm :: AddReq -> Form
toForm AddReq {Text
Emoji
ConversationId
$sel:channel:AddReq :: AddReq -> ConversationId
$sel:name:AddReq :: AddReq -> Emoji
$sel:timestamp:AddReq :: AddReq -> Text
channel :: ConversationId
name :: Emoji
timestamp :: Text
..} =
    [ (Text
"channel", ConversationId -> Text
unConversationId ConversationId
channel)
    , (Text
"name", Emoji -> Text
unEmoji Emoji
name)
    , (Text
"timestamp", Text
timestamp)
    ]

-- | Response to @reactions.add@. Slack doesn't send us anything here.
--
-- @since 2.1.0.0
data AddResp = AddResp
  deriving stock (Int -> AddResp -> ShowS
[AddResp] -> ShowS
AddResp -> String
(Int -> AddResp -> ShowS)
-> (AddResp -> String) -> ([AddResp] -> ShowS) -> Show AddResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddResp -> ShowS
showsPrec :: Int -> AddResp -> ShowS
$cshow :: AddResp -> String
show :: AddResp -> String
$cshowList :: [AddResp] -> ShowS
showList :: [AddResp] -> ShowS
Show, AddResp -> AddResp -> Bool
(AddResp -> AddResp -> Bool)
-> (AddResp -> AddResp -> Bool) -> Eq AddResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddResp -> AddResp -> Bool
== :: AddResp -> AddResp -> Bool
$c/= :: AddResp -> AddResp -> Bool
/= :: AddResp -> AddResp -> Bool
Eq)

instance ToJSON AddResp where
  toJSON :: AddResp -> Value
toJSON AddResp
_ = [Pair] -> Value
A.object []

instance FromJSON AddResp where
  parseJSON :: Value -> Parser AddResp
parseJSON = String -> (Object -> Parser AddResp) -> Value -> Parser AddResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Reactions.AddResp" \Object
_ -> AddResp -> Parser AddResp
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddResp
AddResp

type Api =
  "reactions.add"
    :> AuthProtect "token"
    :> ReqBody '[FormUrlEncoded] AddReq
    :> Post '[JSON] (ResponseJSON AddResp)

-- | Adds a reaction to a message.
--
-- <https://api.slack.com/methods/reactions.add>
--
-- @since 2.1.0.0
reactionsAdd :: SlackConfig -> AddReq -> IO (Response AddResp)
reactionsAdd :: SlackConfig -> AddReq -> IO (Response AddResp)
reactionsAdd SlackConfig
slackConfig AddReq
req = do
  let authR :: AuthenticatedRequest (AuthProtect "token")
authR = SlackConfig -> AuthenticatedRequest (AuthProtect "token")
mkSlackAuthenticateReq SlackConfig
slackConfig
  ClientM (ResponseJSON AddResp) -> Manager -> IO (Response AddResp)
forall a. ClientM (ResponseJSON a) -> Manager -> IO (Response a)
run (AuthenticatedRequest (AuthProtect "token")
-> AddReq -> ClientM (ResponseJSON AddResp)
reactionsAdd_ AuthenticatedRequest (AuthProtect "token")
authR AddReq
req) (Manager -> IO (Response AddResp))
-> (SlackConfig -> Manager) -> SlackConfig -> IO (Response AddResp)
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 -> Manager
slackConfigManager (SlackConfig -> IO (Response AddResp))
-> SlackConfig -> IO (Response AddResp)
forall a b. (a -> b) -> a -> b
$ SlackConfig
slackConfig

reactionsAdd_ :: AuthenticatedRequest (AuthProtect "token") -> AddReq -> ClientM (ResponseJSON AddResp)
reactionsAdd_ :: AuthenticatedRequest (AuthProtect "token")
-> AddReq -> ClientM (ResponseJSON AddResp)
reactionsAdd_ = Proxy Api -> Client ClientM Api
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Api)

-- FIXME(jadel): reactions.remove, reactions.get, reactions.list