DUX-3101: Reactions API support

CHANGELOG.md

@@ -1,6 +1,11 @@
 # 2.1.0.0 (2025-03-06)
 * [#138](https://github.com/MercuryTechnologies/slack-web/pull/138)
   Implement `views.publish` method and App Home tab events.
+* [#139](https://github.com/MercuryTechnologies/slack-web/pull/138)
+  Implement `reactions.add` method.
+
+  Breaking change: various places in the API using emoji now use an Emoji
+  newtype.
 
 # 2.0.1.0 (2025-01-09)
 * [#136](https://github.com/MercuryTechnologies/slack-web/pull/136)

slack-web.cabal

@@ -123,6 +123,7 @@ library
       Web.Slack.Files.Types
       Web.Slack.Internal
       Web.Slack.MessageParser
+      Web.Slack.Reactions
       Web.Slack.Pager
       Web.Slack.Pager.Types
       Web.Slack.Types

src/Web/Slack/Chat.hs

@@ -15,6 +15,7 @@ module Web.Slack.Chat (
 import Web.FormUrlEncoded
 import Web.Slack.Conversation (ConversationId)
 import Web.Slack.Prelude
+import Web.Slack.Types (Emoji)
 import Web.Slack.Util
 
 data PostMsg = PostMsg
@@ -27,7 +28,7 @@ data PostMsg = PostMsg
   , postMsgUsername :: Maybe Text
   , postMsgAsUser :: Maybe Bool
   , postMsgIconUrl :: Maybe Text
-  , postMsgIconEmoji :: Maybe Text
+  , postMsgIconEmoji :: Maybe Emoji
   , postMsgThreadTs :: Maybe Text
   , postMsgReplyBroadcast :: Maybe Bool
   }
@@ -51,7 +52,7 @@ data PostMsgReq = PostMsgReq
   , postMsgReqUsername :: Maybe Text
   , postMsgReqAsUser :: Maybe Bool
   , postMsgReqIconUrl :: Maybe Text
-  , postMsgReqIconEmoji :: Maybe Text
+  , postMsgReqIconEmoji :: Maybe Emoji
   , postMsgReqThreadTs :: Maybe Text
   , postMsgReqReplyBroadcast :: Maybe Bool
   }

src/Web/Slack/Experimental/Blocks/Types.hs

@@ -13,6 +13,7 @@ import Refined.Unsafe (reallyUnsafeRefine)
 import Web.Slack.AesonUtils
 import Web.Slack.Common (ConversationId, UserId)
 import Web.Slack.Prelude
+import Web.Slack.Types (Emoji)
 
 -- | Class of types that can be turned into part of a Slack Message. 'message'
 -- is the primary way of converting primitive and domain-level types into things
@@ -297,7 +298,7 @@ data RichItem
   | RichItemChannel ConversationId
   | RichItemUser UserId RichStyle
   | RichItemLink RichLinkAttrs
-  | RichItemEmoji Text
+  | RichItemEmoji Emoji
   | RichItemOther Text Value
   -- FIXME(jadel): date, usergroup, team, broadcast
   deriving stock (Eq, Show)

src/Web/Slack/Reactions.hs

@@ -0,0 +1,79 @@
+{-# 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
+  { channel :: ConversationId
+  -- ^ Conversation in which to react.
+  , name :: Emoji
+  -- ^ Emoji name. For Unicode emoji, this is the name, not the character.
+  , timestamp :: Text
+  -- ^ Message @ts@ to react to.
+  }
+  deriving stock (Show, Eq)
+
+instance ToForm AddReq where
+  toForm AddReq {..} =
+    [ ("channel", unConversationId channel)
+    , ("name", unEmoji name)
+    , ("timestamp", timestamp)
+    ]
+
+-- | Response to @reactions.add@. Slack doesn't send us anything here.
+--
+-- @since 2.1.0.0
+data AddResp = AddResp
+  deriving stock (Show, Eq)
+
+instance ToJSON AddResp where
+  toJSON _ = A.object []
+
+instance FromJSON AddResp where
+  parseJSON = A.withObject "Reactions.AddResp" \_ -> pure 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 req = do
+  let authR = mkSlackAuthenticateReq slackConfig
+  run (reactionsAdd_ authR req) . slackConfigManager $ slackConfig
+
+reactionsAdd_ :: AuthenticatedRequest (AuthProtect "token") -> AddReq -> ClientM (ResponseJSON AddResp)
+reactionsAdd_ = client (Proxy @Api)
+
+-- FIXME(jadel): reactions.remove, reactions.get, reactions.list

src/Web/Slack/Types.hs

@@ -10,6 +10,7 @@ module Web.Slack.Types (
   UserId (..),
   ConversationId (..),
   TeamId (..),
+  Emoji (..),
   Cursor (..),
   SlackTimestamp (..),
   mkSlackTimestamp,
@@ -49,6 +50,13 @@ newtype TeamId = TeamId {unTeamId :: Text}
   deriving stock (Eq, Ord, Generic, Show)
   deriving newtype (NFData, Hashable, FromJSON, ToJSON, ToHttpApiData)
 
+-- | Slack emoji name.
+--
+-- @since 2.1.0.0
+newtype Emoji = Emoji {unEmoji :: Text}
+  deriving stock (Show, Eq)
+  deriving newtype (NFData, Hashable, IsString, FromJSON, ToJSON, ToHttpApiData)
+
 -- | Message text in the format returned by Slack,
 -- see https://api.slack.com/docs/message-formatting
 -- Consider using 'messageToHtml' for displaying.

src/Web/Slack/User.hs

@@ -19,13 +19,14 @@ import Web.HttpApiData
 import Web.Slack.Common
 import Web.Slack.Pager.Types (PagedRequest (..), PagedResponse (..), ResponseMetadata)
 import Web.Slack.Prelude
+import Web.Slack.Types (Emoji)
 import Web.Slack.Util
 
 -- | See <https://api.slack.com/types/user>
 data Profile = Profile
   { profileAvatarHash :: Maybe Text
   , profileStatusText :: Maybe Text
-  , profileStatusEmoji :: Maybe Text
+  , profileStatusEmoji :: Maybe Emoji
   , profileRealName :: Maybe Text
   , profileDisplayName :: Maybe Text
   , profileRealNameNormalized :: Maybe Text

tests/golden/SlackWebhookEvent/message_rich_text.golden

@@ -26,7 +26,10 @@ EventEventCallback
                                         , rsItalic = False
                                         }
                                     )
-                                , RichItemEmoji "cat"
+                                , RichItemEmoji
+                                    ( Emoji
+                                        { unEmoji = "cat" }
+                                    )
                                 , RichItemText " "
                                     ( RichStyle
                                         { rsBold = False