diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,22 @@ +# 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. +* [#140](https://github.com/MercuryTechnologies/slack-web/pull/140) + Implement `reactions.add` method. + + Breaking change: various places in the API using emoji now use an Emoji + newtype. +* [#141](https://github.com/MercuryTechnologies/slack-web/pull/141) + Include `response_metadata` in errors. + This is a breaking change since it changes the type of `ResponseSlackError` and friends to add that field. +* [#142](https://github.com/MercuryTechnologies/slack-web/pull/142) + Make the block builder previously used in the test suite public as an + experimental module `Web.Slack.Experimental.Blocks.Builder`. + + This makes the DSL for specifying messages built with blocks a bit nicer. +* [#143](https://github.com/MercuryTechnologies/slack-web/pull/143) + Add the `bot_profile` field to messages. + # 2.0.1.0 (2025-01-09) * [#136](https://github.com/MercuryTechnologies/slack-web/pull/136) Bumps the version ranges for dependencies to be compatible with LTS 22.43. diff --git a/slack-web.cabal b/slack-web.cabal --- a/slack-web.cabal +++ b/slack-web.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.2 +cabal-version: 3.0 name: slack-web -version: 2.0.1.0 +version: 2.1.0.0 build-type: Simple @@ -29,10 +29,17 @@ tests/golden/BlockKitBuilderMessage/*.golden.json tests/golden/FileObject/*.json tests/golden/FileObject/*.golden + tests/golden/SlackView/*.json + tests/golden/SlackView/*.golden + tests/golden/PublishResp/*.json + tests/golden/PublishResp/*.golden + tests/golden/ResponseJSON/*.json + tests/golden/ResponseJSON/*.golden category: Web -tested-with: GHC == 8.10.7 || ==9.2.4 || == 9.4.2 || == 9.6.6 +-- Please keep in sync with .github/workflows/haskell.yml :) +tested-with: GHC == { 9.2, 9.4, 9.6, 9.8, 9.10 } extra-source-files: CHANGELOG.md @@ -68,7 +75,6 @@ default-extensions: AllowAmbiguousTypes - ApplicativeDo BlockArguments DataKinds DeriveAnyClass @@ -96,6 +102,7 @@ RankNTypes RecordWildCards RecursiveDo + RoleAnnotations ScopedTypeVariables StandaloneDeriving StandaloneKindSignatures @@ -118,22 +125,25 @@ Web.Slack.Files.Types Web.Slack.Internal Web.Slack.MessageParser + Web.Slack.Reactions Web.Slack.Pager Web.Slack.Pager.Types Web.Slack.Types Web.Slack.User Web.Slack.UsersConversations Web.Slack.Experimental.Blocks + Web.Slack.Experimental.Blocks.Builder Web.Slack.Experimental.Blocks.Types Web.Slack.Experimental.Events.Types + Web.Slack.Experimental.Views Web.Slack.Experimental.RequestVerification other-modules: Web.Slack.Util Web.Slack.Prelude Web.Slack.AesonUtils build-depends: - aeson >= 2.0 && < 2.2 - , base >= 4.11 && < 4.19 + aeson >= 2.0 && < 2.3 + , base >= 4.11 && < 4.22 , base16-bytestring , bytestring , classy-prelude @@ -144,7 +154,7 @@ , either , errors , hashable - , http-api-data >= 0.3 && < 0.6 + , http-api-data >= 0.3 && < 0.7 , http-client >= 0.5 && < 0.8 , http-client-tls >= 0.3 && < 0.4 , megaparsec >= 5.0 && < 10 @@ -157,7 +167,7 @@ , servant-client-core >= 0.16 && < 0.21 , string-conversions , string-variants >= 0.1.0.1 - , text (>= 1.2 && < 1.3) || (>= 2.0 && < 2.1) + , text (>= 1.2 && < 1.3) || (>= 2.0 && < 2.2) , time , transformers , unordered-containers @@ -182,11 +192,13 @@ Web.Slack.ConversationSpec Web.Slack.ChatSpec Web.Slack.Files.TypesSpec + Web.Slack.InternalSpec Web.Slack.UsersConversationsSpec Web.Slack.Experimental.RequestVerificationSpec Web.Slack.Experimental.Events.TypesSpec Web.Slack.Experimental.BlocksSpec Web.Slack.Experimental.Blocks.TypesSpec + Web.Slack.Experimental.ViewsSpec TestImport TestImport.Aeson build-tool-depends: diff --git a/src/Web/Slack/AesonUtils.hs b/src/Web/Slack/AesonUtils.hs --- a/src/Web/Slack/AesonUtils.hs +++ b/src/Web/Slack/AesonUtils.hs @@ -2,10 +2,12 @@ import Data.Aeson import Data.Aeson qualified as J -import Data.Aeson.Types (Pair) +import Data.Aeson.Types (Pair, parseFail) import Data.Char qualified as Char +import Data.List (dropWhileEnd) import Data.Text qualified as T import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Web.FormUrlEncoded qualified as F import Web.Slack.Prelude @@ -108,6 +110,15 @@ , constructorTagModifier = camelTo2 '_' } +-- | 'snakeCaseOptions' that eats trailing underscores. This is so that you can +-- have a field called "type_". +snakeCaseOptionsEatTrailingUnderscore :: Options +snakeCaseOptionsEatTrailingUnderscore = + defaultOptions + { fieldLabelModifier = camelTo2 '_' . dropWhileEnd (== '_') + , constructorTagModifier = camelTo2 '_' + } + snakeCaseFormOptions :: F.FormOptions snakeCaseFormOptions = F.defaultFormOptions @@ -122,3 +133,23 @@ instance ToJSON UnixTimestamp where toJSON (UnixTimestamp a) = toJSON (utcTimeToPOSIXSeconds a) + +-- | Expected a given value as a string. Useful for @type@ fields in json. +data Expected (lit :: Symbol) = Expected + +type role Expected phantom + +instance (KnownSymbol lit) => Eq (Expected lit) where + -- If the types match the values are always equal + _ == _ = True + +instance (KnownSymbol lit) => FromJSON (Expected lit) where + parseJSON = withText "Expected" \s -> do + unless (s == T.pack (symbolVal (Proxy @lit))) $ parseFail ("should be " <> symbolVal (Proxy @lit)) + pure Expected + +instance (KnownSymbol lit) => ToJSON (Expected lit) where + toJSON _ = String . T.pack $ symbolVal (Proxy @lit) + +instance (KnownSymbol lit) => Show (Expected lit) where + show _ = show $ symbolVal (Proxy @lit) diff --git a/src/Web/Slack/Chat.hs b/src/Web/Slack/Chat.hs --- a/src/Web/Slack/Chat.hs +++ b/src/Web/Slack/Chat.hs @@ -15,6 +15,7 @@ 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 @@ , 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 @@ , postMsgReqUsername :: Maybe Text , postMsgReqAsUser :: Maybe Bool , postMsgReqIconUrl :: Maybe Text - , postMsgReqIconEmoji :: Maybe Text + , postMsgReqIconEmoji :: Maybe Emoji , postMsgReqThreadTs :: Maybe Text , postMsgReqReplyBroadcast :: Maybe Bool } diff --git a/src/Web/Slack/Common.hs b/src/Web/Slack/Common.hs --- a/src/Web/Slack/Common.hs +++ b/src/Web/Slack/Common.hs @@ -27,6 +27,7 @@ Message (..), MessageType (..), SlackClientError (..), + ResponseSlackError (..), SlackMessageText (..), ) where @@ -84,13 +85,28 @@ $(deriveJSON (jsonOpts "message") ''Message) +-- | Contains errors that can be returned by the slack API. +-- constrast with 'SlackClientError' which additionally +-- contains errors which occured during the network communication. +-- +-- Includes an Object correponding to the @response_metadata@ field. +-- +-- @since 2.1.0.0 +data ResponseSlackError = ResponseSlackError + { errorText :: Text + , responseMetadata :: Object + } + deriving stock (Eq, Show, Generic) + +instance NFData ResponseSlackError + -- | -- Errors that can be triggered by a slack request. data SlackClientError = -- | errors from the network connection ServantError ClientError | -- | errors returned by the slack API - SlackError Text + SlackError ResponseSlackError deriving stock (Eq, Generic, Show) instance NFData SlackClientError diff --git a/src/Web/Slack/Experimental/Blocks/Builder.hs b/src/Web/Slack/Experimental/Blocks/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Web/Slack/Experimental/Blocks/Builder.hs @@ -0,0 +1,105 @@ +-- | A builder for Slack blocks +-- +-- @since 2.1.0.0 +module Web.Slack.Experimental.Blocks.Builder where + +import Control.Monad.Writer.Strict +import Web.Slack.Experimental.Blocks.Types (SlackAccessory (..), SlackAction, SlackActionList, SlackBlock (..), SlackBlockId, SlackContent, SlackContext (..), SlackPlainTextOnly (..), SlackSection (..), SlackText, slackSectionWithText) +import Web.Slack.Prelude + +type BlockBuilder = WriterT [SlackBlock] + +-- | Runs a block builder, yielding a result +runBlockBuilder :: (Monad m) => BlockBuilder m () -> m [SlackBlock] +runBlockBuilder = execWriterT + +-- | Header block. +-- +-- The text is max 150 characters long. +-- +-- +-- +-- @since 2.1.0.0 +headerBlock :: (Monad m) => SlackText -> BlockBuilder m () +headerBlock = tell . pure . SlackBlockHeader . SlackPlainTextOnly + +-- | Section block. Similar in concept to a p or div tag in HTML. +-- +-- +-- +-- @since 2.1.0.0 +sectionBlock :: (Monad m) => SlackText -> BlockBuilder m () +sectionBlock = tell . pure . SlackBlockSection . slackSectionWithText + +-- | Section block. Similar in concept to a p or div tag in HTML. +-- +-- +-- +-- @since 2.1.0.0 +sectionBlockWithFields :: (Monad m) => SlackText -> [SlackText] -> BlockBuilder m () +sectionBlockWithFields text fields = + tell + $ pure + $ SlackBlockSection + $ SlackSection + { slackSectionText = Just text + , slackSectionBlockId = Nothing + , slackSectionFields = Just fields + , slackSectionAccessory = Nothing + } + +-- | Section block. Similar in concept to a p or div tag in HTML. +-- +-- +-- +-- @since 2.1.0.0 +sectionBlockWithAccessory :: + (Monad m) => + SlackText -> + SlackAction -> + BlockBuilder m () +sectionBlockWithAccessory t b = + tell + $ pure + $ SlackBlockSection + SlackSection + { slackSectionText = Just t + , slackSectionBlockId = Nothing + , slackSectionFields = Nothing + , slackSectionAccessory = Just $ SlackButtonAccessory b + } + +-- | Horizontal line. Similar to an html @hr@ tag. +-- +-- +-- +-- @since 2.1.0.0 +dividerBlock :: (Monad m) => BlockBuilder m () +dividerBlock = tell . pure $ SlackBlockDivider + +-- | Context block: smaller, grey, text, and rendered inline. Like a @span@ in HTML. +-- +-- +contextBlock :: (Monad m) => [SlackContent] -> BlockBuilder m () +contextBlock = tell . pure . SlackBlockContext . SlackContext + +-- | Inline container for interactive actions. +-- +-- +actionsBlock :: + (Monad m) => + Maybe SlackBlockId -> + SlackActionList -> + BlockBuilder m () +actionsBlock a b = tell . pure $ SlackBlockActions a b + +-- | This is used for testing purposes so that you can paste these into the +-- Block Kit builder and have the expected format: +-- +-- +-- +-- @since 2.1.0.0 +newtype BlockKitBuilderMessage = BlockKitBuilderMessage {blocks :: [SlackBlock]} + +instance ToJSON BlockKitBuilderMessage where + toJSON BlockKitBuilderMessage {blocks} = object [("blocks", toJSON blocks)] diff --git a/src/Web/Slack/Experimental/Blocks/Types.hs b/src/Web/Slack/Experimental/Blocks/Types.hs --- a/src/Web/Slack/Experimental/Blocks/Types.hs +++ b/src/Web/Slack/Experimental/Blocks/Types.hs @@ -13,6 +13,7 @@ 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 @@ -111,6 +112,8 @@ newtype OptionalSetting a = OptionalSetting {unOptionalSetting :: Maybe a} deriving newtype (Eq) +type role OptionalSetting representational + -- | Allows using bare Strings without having to use 'setting' instance IsString (OptionalSetting String) where fromString = OptionalSetting . Just @@ -295,7 +298,7 @@ | RichItemChannel ConversationId | RichItemUser UserId RichStyle | RichItemLink RichLinkAttrs - | RichItemEmoji Text + | RichItemEmoji Emoji | RichItemOther Text Value -- FIXME(jadel): date, usergroup, team, broadcast deriving stock (Eq, Show) @@ -395,13 +398,31 @@ } data SlackBlock - = SlackBlockSection SlackSection + = -- | Section block. Similar in concept to a @p@ or @div@ tag in HTML. + -- + -- + SlackBlockSection SlackSection | SlackBlockImage SlackImage - | SlackBlockContext SlackContext - | SlackBlockDivider + | -- | Context block: smaller, grey, text, and rendered inline. Like a @span@ in HTML. + -- + -- + SlackBlockContext SlackContext + | -- | Horizontal line. Similar to an html @hr@ tag. + -- + -- + SlackBlockDivider | SlackBlockRichText RichText - | SlackBlockActions (Maybe SlackBlockId) SlackActionList -- 1 to 5 elements - | SlackBlockHeader SlackPlainTextOnly -- max length 150 + | -- | Inline container for interactive actions. + -- + -- + SlackBlockActions (Maybe SlackBlockId) SlackActionList -- 1 to 5 elements + | -- | Header block. + -- + -- The text is max 150 characters long. + -- + -- + SlackBlockHeader SlackPlainTextOnly + | SlackBlockOther Object deriving stock (Eq) instance Show SlackBlock where @@ -420,6 +441,7 @@ ] show (SlackBlockRichText rt) = show rt show (SlackBlockHeader p) = show p + show (SlackBlockOther o) = "SlackBlockOther " <> show o instance ToJSON SlackBlock where toJSON (SlackBlockSection SlackSection {..}) = @@ -454,6 +476,7 @@ [ "type" .= ("header" :: Text) , "text" .= slackPlainText ] + toJSON (SlackBlockOther o) = Object o instance FromJSON SlackBlock where parseJSON = withObject "SlackBlock" $ \obj -> do @@ -500,7 +523,7 @@ (headerContentObj :: Value) <- obj .: "text" headerContentText <- parseJSON headerContentObj pure $ SlackBlockHeader headerContentText - _ -> fail "Unknown SlackBlock type, must be one of ['section', 'context', 'image', 'divider', 'actions', 'rich_text', 'header']" + _unk -> pure $ SlackBlockOther obj newtype SlackMessage = SlackMessage [SlackBlock] deriving newtype (Semigroup, Monoid, Eq) diff --git a/src/Web/Slack/Experimental/Events/Types.hs b/src/Web/Slack/Experimental/Events/Types.hs --- a/src/Web/Slack/Experimental/Events/Types.hs +++ b/src/Web/Slack/Experimental/Events/Types.hs @@ -144,6 +144,19 @@ -- Return the structured data with raw JSON preserved pure MessageAttachment {decoded = decodedContent, raw = ov} +-- | @bot_profile@ field of message events. +-- +-- @since 2.1.0.0 +data BotProfile = BotProfile + { id :: Text + , name :: Text + , appId :: Text + , teamId :: TeamId + } + deriving stock (Show) + +$(deriveFromJSON snakeCaseOptions ''BotProfile) + -- | -- and -- @@ -162,14 +175,20 @@ , appId :: Maybe Text -- ^ Present if it's sent by an app -- - -- For mysterious reasons, this is NOT - -- , this is a regular - -- message but with bot metadata. I Think it's because there *is* an - -- associated user. + -- This is always the case for messages sent by modern Slack Apps, as + -- opposed to legacy bots, which send 'BotMessageEvent' so they do not + -- require an associated user ID. Modern Slack Apps have user IDs *and* App + -- IDs *and* Bot IDs. -- -- See @botMessage.json@ golden parser test. , botId :: Maybe Text -- ^ Present if it's sent by a bot user + , botProfile :: Maybe BotProfile + -- ^ The bot profile of the app sending the message, if any. + -- + -- This is (ill)-documented, sorta, at . + -- + -- @since 2.1.0.0 , attachments :: Maybe [MessageAttachment] -- ^ @since 2.0.0.3 -- Present if the message has attachments @@ -182,6 +201,13 @@ -- This is similar to a MessageEvent but sent by a bot, for example -- messages that Reacji Channeler sends. -- +-- This only applies to *legacy* bots. Modern Slack apps do not send +-- @bot_message@ events; see the Slack documentation. +-- +-- FIXME(jadel): remove this completely after March 31 2025 (?) or +-- March 2026 (?) since the things that send these will likely vanish. +-- +-- -- @since 2.0.0.2 data BotMessageEvent = BotMessageEvent { blocks :: Maybe [SlackBlock] @@ -273,6 +299,42 @@ deriving newtype (FromJSON) deriving stock (Show, Eq) +-- | Which tab of App Home is open. +-- +-- @since 2.1.0.0 +newtype AppHomeTab = AppHomeTab {unAppHomeTab :: Text} + deriving stock (Show, Eq) + deriving newtype (FromJSON, ToJSON) + +-- | Home tab of App Home. +-- +-- @since 2.1.0.0 +appHomeTabHome :: AppHomeTab +appHomeTabHome = AppHomeTab "home" + +-- | Messages tab of App Home. +-- +-- @since 2.1.0.0 +appHomeTabMessages :: AppHomeTab +appHomeTabMessages = AppHomeTab "messages" + +-- | App Home Opened event: when a Slack bot's home page is opened. +-- +-- +-- +-- See also: +-- +-- @since 2.1.0.0 +data AppHomeOpenedEvent = AppHomeOpenedEvent + { user :: UserId + , channel :: ConversationId + , tab :: AppHomeTab + , eventTs :: Text + } + deriving stock (Show) + +$(deriveFromJSON snakeCaseOptions ''AppHomeOpenedEvent) + data Event = EventMessage MessageEvent | EventBotMessage BotMessageEvent @@ -285,6 +347,8 @@ EventChannelJoinMessage | EventChannelCreated ChannelCreatedEvent | EventChannelLeft ChannelLeftEvent + | -- | @since 2.1.0.0 + EventAppHomeOpened AppHomeOpenedEvent | EventUnknown Value deriving stock (Show, Generic) @@ -302,6 +366,7 @@ ("message", Just "file_share") -> EventMessage <$> parseJSON @MessageEvent (Object obj) ("channel_created", Nothing) -> EventChannelCreated <$> parseJSON (Object obj) ("channel_left", Nothing) -> EventChannelLeft <$> parseJSON (Object obj) + ("app_home_opened", Nothing) -> EventAppHomeOpened <$> parseJSON (Object obj) _ -> pure $ EventUnknown (Object obj) data EventCallback = EventCallback diff --git a/src/Web/Slack/Experimental/Views.hs b/src/Web/Slack/Experimental/Views.hs new file mode 100644 --- /dev/null +++ b/src/Web/Slack/Experimental/Views.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + +-- | Publishing views using the Blocks API. +-- +-- This is used for App Home and modals. +-- +-- +-- +-- @since 2.1.0.0 +module Web.Slack.Experimental.Views ( + -- * Types + SlackView (..), + HomeTabView (..), + ModalView (..), + Expected (..), + + -- * Requests and responses + PublishReq (..), + PublishResp (..), + Api, + viewsPublish, +) where + +import Data.Aeson qualified as A +import Data.Aeson.KeyMap qualified as KM +import Servant.API (AuthProtect, FormUrlEncoded, JSON, Post, ReqBody, (:>)) +import Servant.Client (ClientM, client) +import Servant.Client.Core (AuthenticatedRequest) +import Web.FormUrlEncoded (ToForm (..)) +import Web.HttpApiData (ToHttpApiData (..)) +import Web.Slack.AesonUtils (Expected (..), snakeCaseOptions, snakeCaseOptionsEatTrailingUnderscore, (.=!), (.=?)) +import Web.Slack.Experimental.Blocks qualified as B +import Web.Slack.Experimental.Blocks.Types (SlackPlainTextOnly) +import Web.Slack.Internal (ResponseJSON (..), SlackConfig (..), mkSlackAuthenticateReq, run) +import Web.Slack.Pager (Response) +import Web.Slack.Prelude +import Web.Slack.Types (UserId) + +-- | View definition for some Slack surface. Has an inner type of either +-- 'ModalView' or 'HomeTabView'. +-- +-- +-- +-- @since 2.1.0.0 +data SlackView inner = SlackView + { blocks :: Vector B.SlackBlock + , privateMetadata :: Maybe Text + , callbackId :: Maybe Text + , externalId :: Maybe Text + , inner :: inner + } + deriving stock (Show, Eq, Generic) + +type role SlackView representational + +instance (FromJSON inner) => FromJSON (SlackView inner) where + parseJSON = withObject "SlackView" \o -> do + blocks <- o .: "blocks" + privateMetadata <- o .:? "private_metadata" + callbackId <- o .:? "callback_id" + externalId <- o .:? "external_id" + inner <- parseJSON @inner (A.Object o) + pure SlackView {..} + +instance (ToJSON inner) => ToJSON (SlackView inner) where + toJSON SlackView {..} = case toJSON inner of + A.Object innerObj -> + A.Object + ( KM.fromList + ( catMaybes + [ "blocks" .=! blocks + , "private_metadata" .=? privateMetadata + , "callback_id" .=? callbackId + , "external_id" .=? externalId + ] + ) + <> innerObj + ) + _ -> error "inner of SlackView is not an object" + +-- | @since 2.1.0.0 +data HomeTabView = HomeTabView + { type_ :: Expected "home" + } + deriving stock (Show, Eq, Generic) + +$(deriveJSON snakeCaseOptionsEatTrailingUnderscore ''HomeTabView) + +-- | Modal view +-- +-- +-- +-- @since 2.1.0.0 +data ModalView = ModalView + { type_ :: Expected "modal" + , title :: SlackPlainTextOnly + -- ^ Title of the modal on the top left. Maximum length of 24 characters. + , close :: Maybe SlackPlainTextOnly + -- ^ Text appearing on the close button on the bottom-right of the modal. + -- Maximum length of 24 characters. + , submit :: Maybe SlackPlainTextOnly + -- ^ Text appearing on the submit buttonn. Maximum length of 24 characters. + -- Must be 'SlackPlainTextOnly'. + , submitDisabled :: Maybe Bool + -- ^ Whether one or more inputs must be filled before enabling the submit button. + -- For configuration modals: + } + deriving stock (Show, Eq, Generic) + +$(deriveJSON snakeCaseOptionsEatTrailingUnderscore ''ModalView) + +-- | Publishes the App Home view for a user. +-- +-- +-- +-- @since 2.1.0.0 +data PublishReq = PublishReq + { userId :: UserId + -- ^ User to whom the view is being published. + , view :: SlackView HomeTabView + -- ^ View payload. + } + deriving stock (Show) + +instance ToForm PublishReq where + toForm PublishReq {..} = + [ ("user_id" :: Text, toQueryParam userId) + , ("view", toQueryParam . decodeUtf8 $ A.encode view) + ] + +-- | @since 2.1.0.0 +data PublishResp = PublishResp + { view :: SlackView HomeTabView + } + deriving stock (Show) + +$(deriveJSON snakeCaseOptions ''PublishResp) + +-- | @since 2.1.0.0 +type Api = + "views.publish" + :> AuthProtect "token" + :> ReqBody '[FormUrlEncoded] PublishReq + :> Post '[JSON] (ResponseJSON PublishResp) + +-- | Publishes the App Home view for a user. +-- +-- +-- +-- @since 2.1.0.0 +viewsPublish :: SlackConfig -> PublishReq -> IO (Response PublishResp) +viewsPublish slackConfig req = do + let authR = mkSlackAuthenticateReq slackConfig + run (viewsPublish_ authR req) . slackConfigManager $ slackConfig + +viewsPublish_ :: AuthenticatedRequest (AuthProtect "token") -> PublishReq -> ClientM (ResponseJSON PublishResp) +viewsPublish_ = client (Proxy @Api) diff --git a/src/Web/Slack/Internal.hs b/src/Web/Slack/Internal.hs --- a/src/Web/Slack/Internal.hs +++ b/src/Web/Slack/Internal.hs @@ -2,10 +2,11 @@ module Web.Slack.Internal where import Data.Aeson (Value (..)) -import Network.HTTP.Client (Manager) -import Servant.API hiding (addHeader) -- 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 @@ -17,15 +18,10 @@ , 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 (Eq, Show) - -- | -- Internal type! -newtype ResponseJSON a = ResponseJSON (Either ResponseSlackError a) +newtype ResponseJSON a = ResponseJSON (Either Common.ResponseSlackError a) + deriving stock (Show) instance (FromJSON a) => FromJSON (ResponseJSON a) where parseJSON = withObject "Response" $ \o -> do @@ -33,7 +29,10 @@ ResponseJSON <$> if ok then Right <$> parseJSON (Object o) - else Left . ResponseSlackError <$> o .: "error" + else do + err <- o .: "error" + meta <- o .:? "response_metadata" + pure $ Left $ Common.ResponseSlackError {errorText = err, responseMetadata = (fromMaybe KM.empty meta)} mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token") mkSlackAuthenticateReq = (`mkAuthenticatedRequest` authenticateReq) . slackConfigToken @@ -59,6 +58,6 @@ unnestErrors :: Either ClientError (ResponseJSON a) -> Response a unnestErrors (Right (ResponseJSON (Right a))) = Right a -unnestErrors (Right (ResponseJSON (Left (ResponseSlackError serv)))) = - Left (Common.SlackError serv) +unnestErrors (Right (ResponseJSON (Left err))) = + Left (Common.SlackError err) unnestErrors (Left slackErr) = Left (Common.ServantError slackErr) diff --git a/src/Web/Slack/Reactions.hs b/src/Web/Slack/Reactions.hs new file mode 100644 --- /dev/null +++ b/src/Web/Slack/Reactions.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + +-- | API methods relating to reactions: +-- +-- - +-- - +-- - +-- - +-- +-- @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. +-- +-- +-- +-- @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. +-- +-- +-- +-- @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 diff --git a/src/Web/Slack/Types.hs b/src/Web/Slack/Types.hs --- a/src/Web/Slack/Types.hs +++ b/src/Web/Slack/Types.hs @@ -10,6 +10,7 @@ UserId (..), ConversationId (..), TeamId (..), + Emoji (..), Cursor (..), SlackTimestamp (..), mkSlackTimestamp, @@ -48,6 +49,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 diff --git a/src/Web/Slack/User.hs b/src/Web/Slack/User.hs --- a/src/Web/Slack/User.hs +++ b/src/Web/Slack/User.hs @@ -19,13 +19,14 @@ 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 data Profile = Profile { profileAvatarHash :: Maybe Text , profileStatusText :: Maybe Text - , profileStatusEmoji :: Maybe Text + , profileStatusEmoji :: Maybe Emoji , profileRealName :: Maybe Text , profileDisplayName :: Maybe Text , profileRealNameNormalized :: Maybe Text diff --git a/tests/Web/Slack/Experimental/BlocksSpec.hs b/tests/Web/Slack/Experimental/BlocksSpec.hs --- a/tests/Web/Slack/Experimental/BlocksSpec.hs +++ b/tests/Web/Slack/Experimental/BlocksSpec.hs @@ -1,60 +1,12 @@ module Web.Slack.Experimental.BlocksSpec where -import Control.Monad.Writer.Strict import Data.StringVariants (mkNonEmptyText) import JSONGolden (oneGoldenTestEncode) import TestImport import Web.Slack.Experimental.Blocks +import Web.Slack.Experimental.Blocks.Builder (BlockKitBuilderMessage (..), actionsBlock, contextBlock, dividerBlock, headerBlock, runBlockBuilder, sectionBlock, sectionBlockWithAccessory, sectionBlockWithFields) import Web.Slack.Experimental.Blocks.Types --- FIXME(jadel, violet): These builder things should probably be put into a --- module to make them available, but that's later work - -headerBlock :: SlackText -> WriterT [SlackBlock] Identity () -headerBlock = tell . pure . SlackBlockHeader . SlackPlainTextOnly - -sectionBlock :: SlackText -> WriterT [SlackBlock] Identity () -sectionBlock = tell . pure . SlackBlockSection . slackSectionWithText - -sectionBlockWithFields :: SlackText -> [SlackText] -> WriterT [SlackBlock] Identity () -sectionBlockWithFields text fields = - tell - $ pure - $ SlackBlockSection - $ SlackSection - { slackSectionText = Just text - , slackSectionBlockId = Nothing - , slackSectionFields = Just fields - , slackSectionAccessory = Nothing - } - -sectionBlockWithAccessory :: - SlackText -> - SlackAction -> - WriterT [SlackBlock] Identity () -sectionBlockWithAccessory t b = - tell - $ pure - $ SlackBlockSection - SlackSection - { slackSectionText = Just t - , slackSectionBlockId = Nothing - , slackSectionFields = Nothing - , slackSectionAccessory = Just $ SlackButtonAccessory b - } - -dividerBlock :: WriterT [SlackBlock] Identity () -dividerBlock = tell . pure $ SlackBlockDivider - -contextBlock :: [SlackContent] -> WriterT [SlackBlock] Identity () -contextBlock = tell . pure . SlackBlockContext . SlackContext - -actionsBlock :: - Maybe SlackBlockId -> - SlackActionList -> - WriterT [SlackBlock] Identity () -actionsBlock a b = tell . pure $ SlackBlockActions a b - slackActionDoNothing :: SlackActionId slackActionDoNothing = SlackActionId . fromJust . mkNonEmptyText $ "doNothing" @@ -67,7 +19,8 @@ slackShowBlockFormat :: BlockKitBuilderMessage slackShowBlockFormat = BlockKitBuilderMessage - $ execWriter + $ runIdentity + . runBlockBuilder $ do headerBlock ("Blah: " <> list ["a", "b", "c"]) dividerBlock @@ -104,14 +57,6 @@ textMessage = message @Text list x = textMessage (intercalate ", " x) google = OptionalSetting . mkNonEmptyText @3000 $ "https://google.com" - --- | This is used so that we can paste the output of these tests directly into --- the block kit builder: --- -newtype BlockKitBuilderMessage = BlockKitBuilderMessage {blocks :: [SlackBlock]} - -instance ToJSON BlockKitBuilderMessage where - toJSON BlockKitBuilderMessage {blocks} = object [("blocks", toJSON blocks)] spec :: Spec spec = describe "Slack block builder" do diff --git a/tests/Web/Slack/Experimental/Events/TypesSpec.hs b/tests/Web/Slack/Experimental/Events/TypesSpec.hs --- a/tests/Web/Slack/Experimental/Events/TypesSpec.hs +++ b/tests/Web/Slack/Experimental/Events/TypesSpec.hs @@ -33,4 +33,6 @@ , "github_notification_ts_string" , "github_with_link" , "non_spec_attachment" + , "app_home_opened_home" + , "app_home_opened_messages" ] diff --git a/tests/Web/Slack/Experimental/ViewsSpec.hs b/tests/Web/Slack/Experimental/ViewsSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Slack/Experimental/ViewsSpec.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Web.Slack.Experimental.ViewsSpec where + +import JSONGolden +import TestImport +import Web.Slack.Experimental.Views + +spec :: Spec +spec = describe "Slack views" do + describe "SlackView ModalView" do + describe "FromJSON" do + mapM_ + (oneGoldenTestDecode @(SlackView ModalView)) + -- Taken from: https://api.slack.com/reference/surfaces/views#modal__modal-view-example + ["modalView"] + + describe "SlackView HomeTabView" do + mapM_ + (oneGoldenTestDecode @(SlackView HomeTabView)) + -- https://api.slack.com/reference/surfaces/views#home-example + ["homeTabView"] + + describe "views.publish response" do + oneGoldenTestDecode @PublishResp "views.publish example" diff --git a/tests/Web/Slack/InternalSpec.hs b/tests/Web/Slack/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Slack/InternalSpec.hs @@ -0,0 +1,20 @@ +module Web.Slack.InternalSpec where + +import JSONGolden +import TestImport +import Web.Slack.Internal + +-- | Parses nothing and succeeds! +data NoJSONExpectations = NoJSONExpectations + deriving stock (Show) + +instance FromJSON NoJSONExpectations where + parseJSON _ = pure NoJSONExpectations + +spec :: Spec +spec = describe "Common infrastructure" do + describe "Response parsing" do + -- FIXME(jadel): discards warnings for successful responses! seems like we + -- need to improve this API + oneGoldenTestDecode @(ResponseJSON NoJSONExpectations) "metadata_example" + oneGoldenTestDecode @(ResponseJSON NoJSONExpectations) "failed_view_publish" diff --git a/tests/golden/PublishResp/views.publish example.golden b/tests/golden/PublishResp/views.publish example.golden new file mode 100644 --- /dev/null +++ b/tests/golden/PublishResp/views.publish example.golden @@ -0,0 +1,18 @@ +PublishResp + { view = SlackView + { blocks = + [ SlackSection + { slackSectionText = Just "A simple section with some sample sentence." + , slackSectionBlockId = Just + ( NonEmptyText "2WGp9" ) + , slackSectionFields = Nothing + , slackSectionAccessory = Nothing + } + ] + , privateMetadata = Just "Shh it is a secret" + , callbackId = Just "identify_your_home_tab" + , externalId = Just "" + , inner = HomeTabView + { type_ = "home" } + } + } diff --git a/tests/golden/PublishResp/views.publish example.json b/tests/golden/PublishResp/views.publish example.json new file mode 100644 --- /dev/null +++ b/tests/golden/PublishResp/views.publish example.json @@ -0,0 +1,34 @@ +{ + "ok": true, + "view": { + "id": "VMHU10V25", + "team_id": "T8N4K1JN", + "type": "home", + "close": null, + "submit": null, + "blocks": [ + { + "type": "section", + "block_id": "2WGp9", + "text": { + "type": "mrkdwn", + "text": "A simple section with some sample sentence.", + "verbatim": false + } + } + ], + "private_metadata": "Shh it is a secret", + "callback_id": "identify_your_home_tab", + "state": { + "values": {} + }, + "hash": "156772938.1827394", + "clear_on_close": false, + "notify_on_close": false, + "root_view_id": "VMHU10V25", + "previous_view_id": null, + "app_id": "AA4928AQ", + "external_id": "", + "bot_id": "BA13894H" + } +} diff --git a/tests/golden/ResponseJSON/failed_view_publish.golden b/tests/golden/ResponseJSON/failed_view_publish.golden new file mode 100644 --- /dev/null +++ b/tests/golden/ResponseJSON/failed_view_publish.golden @@ -0,0 +1,17 @@ +ResponseJSON + ( Left + ( ResponseSlackError + { errorText = "invalid_arguments" + , responseMetadata = fromList + [ + ( "messages" + , Array + [ String "[ERROR] failed to match all allowed schemas [json-pointer:/view]" + , String "[ERROR] must provide an object [json-pointer:/view]" + , String "[ERROR] must provide an object [json-pointer:/view]" + ] + ) + ] + } + ) + ) diff --git a/tests/golden/ResponseJSON/failed_view_publish.json b/tests/golden/ResponseJSON/failed_view_publish.json new file mode 100644 --- /dev/null +++ b/tests/golden/ResponseJSON/failed_view_publish.json @@ -0,0 +1,11 @@ +{ + "ok": false, + "error": "invalid_arguments", + "response_metadata": { + "messages": [ + "[ERROR] failed to match all allowed schemas [json-pointer:/view]", + "[ERROR] must provide an object [json-pointer:/view]", + "[ERROR] must provide an object [json-pointer:/view]" + ] + } +} diff --git a/tests/golden/ResponseJSON/metadata_example.golden b/tests/golden/ResponseJSON/metadata_example.golden new file mode 100644 --- /dev/null +++ b/tests/golden/ResponseJSON/metadata_example.golden @@ -0,0 +1,1 @@ +ResponseJSON ( Right NoJSONExpectations ) diff --git a/tests/golden/ResponseJSON/metadata_example.json b/tests/golden/ResponseJSON/metadata_example.json new file mode 100644 --- /dev/null +++ b/tests/golden/ResponseJSON/metadata_example.json @@ -0,0 +1,14 @@ +{ + "ok": true, + "warnings": [ + "missing_charset" + ], + "response_metadata": { + "warnings": [ + "missing_charset" + ], + "messages": [ + "[WARN] A Content-Type HTTP header was presented but did not declare a charset, such as a 'utf-8'" + ] + } +} diff --git a/tests/golden/SlackView/homeTabView.golden b/tests/golden/SlackView/homeTabView.golden new file mode 100644 --- /dev/null +++ b/tests/golden/SlackView/homeTabView.golden @@ -0,0 +1,16 @@ +SlackView + { blocks = + [ SlackSection + { slackSectionText = Just "A stack of blocks for the sample Block Kit Home tab." + , slackSectionBlockId = Nothing + , slackSectionFields = Nothing + , slackSectionAccessory = Nothing + } + , "actions(Nothing) = ["SlackActionId {unSlackActionId = NonEmptyText \"oops our json decoder requires this\"} [button SlackButtonText (NonEmptyText \"Action A\")], SlackActionId {unSlackActionId = NonEmptyText \"oops our json decoder requires this 2\"} [button SlackButtonText (NonEmptyText \"Action B\")]"]" + ] + , privateMetadata = Nothing + , callbackId = Nothing + , externalId = Nothing + , inner = HomeTabView + { type_ = "home" } + } diff --git a/tests/golden/SlackView/homeTabView.json b/tests/golden/SlackView/homeTabView.json new file mode 100644 --- /dev/null +++ b/tests/golden/SlackView/homeTabView.json @@ -0,0 +1,35 @@ +{ + "type": "home", + "blocks": [ + { + "type": "section", + "text": { + "type": "mrkdwn", + "text": "A stack of blocks for the sample Block Kit Home tab." + } + }, + { + "type": "actions", + "elements": [ + { + "type": "button", + "action_id": "oops our json decoder requires this", + "text": { + "type": "plain_text", + "text": "Action A", + "emoji": true + } + }, + { + "type": "button", + "action_id": "oops our json decoder requires this 2", + "text": { + "type": "plain_text", + "text": "Action B", + "emoji": true + } + } + ] + } + ] +} diff --git a/tests/golden/SlackView/modalView.golden b/tests/golden/SlackView/modalView.golden new file mode 100644 --- /dev/null +++ b/tests/golden/SlackView/modalView.golden @@ -0,0 +1,86 @@ +SlackView + { blocks = + [ SlackSection + { slackSectionText = Just "It's Block Kit...but _in a modal_" + , slackSectionBlockId = Just + ( NonEmptyText "section1" ) + , slackSectionFields = Nothing + , slackSectionAccessory = Just SlackActionId + { unSlackActionId = NonEmptyText "button_abc" } + [ button SlackButtonText + ( NonEmptyText "Click me" ) + ] + } + , SlackBlockOther fromList + [ + ( "element" + , Object + ( fromList + [ + ( "action_id" + , String "input1" + ) + , + ( "multiline" + , Bool False + ) + , + ( "placeholder" + , Object + ( fromList + [ + ( "text" + , String "Type in here" + ) + , + ( "type" + , String "plain_text" + ) + ] + ) + ) + , + ( "type" + , String "plain_text_input" + ) + ] + ) + ) + , + ( "label" + , Object + ( fromList + [ + ( "text" + , String "Input label" + ) + , + ( "type" + , String "plain_text" + ) + ] + ) + ) + , + ( "optional" + , Bool False + ) + , + ( "type" + , String "input" + ) + ] + ] + , privateMetadata = Just "Shhhhhhhh" + , callbackId = Just "view_identifier_12" + , externalId = Nothing + , inner = ModalView + { type_ = "modal" + , title = SlackPlainTextOnly "Modal title" + , close = Just + ( SlackPlainTextOnly "Cancel" ) + , submit = Just + ( SlackPlainTextOnly "Save" ) + , submitDisabled = Nothing + } + } diff --git a/tests/golden/SlackView/modalView.json b/tests/golden/SlackView/modalView.json new file mode 100644 --- /dev/null +++ b/tests/golden/SlackView/modalView.json @@ -0,0 +1,54 @@ +{ + "type": "modal", + "title": { + "type": "plain_text", + "text": "Modal title" + }, + "blocks": [ + { + "type": "section", + "text": { + "type": "mrkdwn", + "text": "It's Block Kit...but _in a modal_" + }, + "block_id": "section1", + "accessory": { + "type": "button", + "text": { + "type": "plain_text", + "text": "Click me" + }, + "action_id": "button_abc", + "value": "Button value", + "style": "danger" + } + }, + { + "type": "input", + "label": { + "type": "plain_text", + "text": "Input label" + }, + "element": { + "type": "plain_text_input", + "action_id": "input1", + "placeholder": { + "type": "plain_text", + "text": "Type in here" + }, + "multiline": false + }, + "optional": false + } + ], + "close": { + "type": "plain_text", + "text": "Cancel" + }, + "submit": { + "type": "plain_text", + "text": "Save" + }, + "private_metadata": "Shhhhhhhh", + "callback_id": "view_identifier_12" +} diff --git a/tests/golden/SlackWebhookEvent/app_home_opened_home.golden b/tests/golden/SlackWebhookEvent/app_home_opened_home.golden new file mode 100644 --- /dev/null +++ b/tests/golden/SlackWebhookEvent/app_home_opened_home.golden @@ -0,0 +1,23 @@ +EventEventCallback + ( EventCallback + { eventId = EventId + { unEventId = "Ev08EUKK3342" } + , teamId = TeamId + { unTeamId = "T043DB835ML" } + , eventTime = MkSystemTime + { systemSeconds = 1740431544 + , systemNanoseconds = 0 + } + , event = EventAppHomeOpened + ( AppHomeOpenedEvent + { user = UserId + { unUserId = "U043H11ES4V" } + , channel = ConversationId + { unConversationId = "D0442US94JD" } + , tab = AppHomeTab + { unAppHomeTab = "home" } + , eventTs = "1740431544.556817" + } + ) + } + ) diff --git a/tests/golden/SlackWebhookEvent/app_home_opened_home.json b/tests/golden/SlackWebhookEvent/app_home_opened_home.json new file mode 100644 --- /dev/null +++ b/tests/golden/SlackWebhookEvent/app_home_opened_home.json @@ -0,0 +1,25 @@ +{ + "token": "aaaa", + "team_id": "T043DB835ML", + "api_app_id": "A0442TUPHGR", + "event": { + "type": "app_home_opened", + "user": "U043H11ES4V", + "channel": "D0442US94JD", + "tab": "home", + "event_ts": "1740431544.556817" + }, + "type": "event_callback", + "event_id": "Ev08EUKK3342", + "event_time": 1740431544, + "authorizations": [ + { + "enterprise_id": null, + "team_id": "T043DB835ML", + "user_id": "U0442US8QGH", + "is_bot": true, + "is_enterprise_install": false + } + ], + "is_ext_shared_channel": false +} diff --git a/tests/golden/SlackWebhookEvent/app_home_opened_messages.golden b/tests/golden/SlackWebhookEvent/app_home_opened_messages.golden new file mode 100644 --- /dev/null +++ b/tests/golden/SlackWebhookEvent/app_home_opened_messages.golden @@ -0,0 +1,23 @@ +EventEventCallback + ( EventCallback + { eventId = EventId + { unEventId = "Ev08EUG3TZ0S" } + , teamId = TeamId + { unTeamId = "T043DB835ML" } + , eventTime = MkSystemTime + { systemSeconds = 1740430328 + , systemNanoseconds = 0 + } + , event = EventAppHomeOpened + ( AppHomeOpenedEvent + { user = UserId + { unUserId = "U043H11ES4V" } + , channel = ConversationId + { unConversationId = "D0442US94JD" } + , tab = AppHomeTab + { unAppHomeTab = "messages" } + , eventTs = "1740430328.659101" + } + ) + } + ) diff --git a/tests/golden/SlackWebhookEvent/app_home_opened_messages.json b/tests/golden/SlackWebhookEvent/app_home_opened_messages.json new file mode 100644 --- /dev/null +++ b/tests/golden/SlackWebhookEvent/app_home_opened_messages.json @@ -0,0 +1,25 @@ +{ + "token": "aaaa", + "team_id": "T043DB835ML", + "api_app_id": "A0442TUPHGR", + "event": { + "type": "app_home_opened", + "user": "U043H11ES4V", + "channel": "D0442US94JD", + "tab": "messages", + "event_ts": "1740430328.659101" + }, + "type": "event_callback", + "event_id": "Ev08EUG3TZ0S", + "event_time": 1740430328, + "authorizations": [ + { + "enterprise_id": null, + "team_id": "T043DB835ML", + "user_id": "U0442US8QGH", + "is_bot": true, + "is_enterprise_install": false + } + ], + "is_ext_shared_channel": false +} diff --git a/tests/golden/SlackWebhookEvent/botMessage.golden b/tests/golden/SlackWebhookEvent/botMessage.golden --- a/tests/golden/SlackWebhookEvent/botMessage.golden +++ b/tests/golden/SlackWebhookEvent/botMessage.golden @@ -37,6 +37,15 @@ , threadTs = Just "1664216109.798919" , appId = Just "A0442TUPHGR" , botId = Just "B0439P161B9" + , botProfile = Just + ( BotProfile + { id = "B0439P161B9" + , name = "Slacklinker dev" + , appId = "A0442TUPHGR" + , teamId = TeamId + { unTeamId = "T043DB835ML" } + } + ) , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/circleci.golden b/tests/golden/SlackWebhookEvent/circleci.golden --- a/tests/golden/SlackWebhookEvent/circleci.golden +++ b/tests/golden/SlackWebhookEvent/circleci.golden @@ -50,6 +50,15 @@ , threadTs = Nothing , appId = Just "A56789123" , botId = Just "B01234687" + , botProfile = Just + ( BotProfile + { id = "B01234687" + , name = "CircleCI integration" + , appId = "A56789123" + , teamId = TeamId + { unTeamId = "T0123456789" } + } + ) , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/email_message.golden b/tests/golden/SlackWebhookEvent/email_message.golden --- a/tests/golden/SlackWebhookEvent/email_message.golden +++ b/tests/golden/SlackWebhookEvent/email_message.golden @@ -37,6 +37,7 @@ , threadTs = Nothing , appId = Nothing , botId = Just "B012346789" + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/forwarded_message.golden b/tests/golden/SlackWebhookEvent/forwarded_message.golden --- a/tests/golden/SlackWebhookEvent/forwarded_message.golden +++ b/tests/golden/SlackWebhookEvent/forwarded_message.golden @@ -22,6 +22,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/github_notification.golden b/tests/golden/SlackWebhookEvent/github_notification.golden --- a/tests/golden/SlackWebhookEvent/github_notification.golden +++ b/tests/golden/SlackWebhookEvent/github_notification.golden @@ -22,6 +22,15 @@ , threadTs = Nothing , appId = Just "A01BP7R4KNY" , botId = Just "B07LDR01Z63" + , botProfile = Just + ( BotProfile + { id = "B07LDR01Z63" + , name = "GitHub" + , appId = "A01BP7R4KNY" + , teamId = TeamId + { unTeamId = "T043DB835ML" } + } + ) , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/github_notification_ts_string.golden b/tests/golden/SlackWebhookEvent/github_notification_ts_string.golden --- a/tests/golden/SlackWebhookEvent/github_notification_ts_string.golden +++ b/tests/golden/SlackWebhookEvent/github_notification_ts_string.golden @@ -22,6 +22,15 @@ , threadTs = Nothing , appId = Just "A01BP7R4KNY" , botId = Just "B07LDR01Z63" + , botProfile = Just + ( BotProfile + { id = "B07LDR01Z63" + , name = "GitHub" + , appId = "A01BP7R4KNY" + , teamId = TeamId + { unTeamId = "T043DB835ML" } + } + ) , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/github_with_link.golden b/tests/golden/SlackWebhookEvent/github_with_link.golden --- a/tests/golden/SlackWebhookEvent/github_with_link.golden +++ b/tests/golden/SlackWebhookEvent/github_with_link.golden @@ -22,6 +22,15 @@ , threadTs = Nothing , appId = Just "A01BP7R4KNY" , botId = Just "B07LDR01Z63" + , botProfile = Just + ( BotProfile + { id = "B07LDR01Z63" + , name = "GitHub" + , appId = "A01BP7R4KNY" + , teamId = TeamId + { unTeamId = "T043DB835ML" } + } + ) , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/link.golden b/tests/golden/SlackWebhookEvent/link.golden --- a/tests/golden/SlackWebhookEvent/link.golden +++ b/tests/golden/SlackWebhookEvent/link.golden @@ -41,6 +41,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/messageExample.golden b/tests/golden/SlackWebhookEvent/messageExample.golden --- a/tests/golden/SlackWebhookEvent/messageExample.golden +++ b/tests/golden/SlackWebhookEvent/messageExample.golden @@ -37,6 +37,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/messageIm.golden b/tests/golden/SlackWebhookEvent/messageIm.golden --- a/tests/golden/SlackWebhookEvent/messageIm.golden +++ b/tests/golden/SlackWebhookEvent/messageIm.golden @@ -37,6 +37,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/message_file_share.golden b/tests/golden/SlackWebhookEvent/message_file_share.golden --- a/tests/golden/SlackWebhookEvent/message_file_share.golden +++ b/tests/golden/SlackWebhookEvent/message_file_share.golden @@ -52,6 +52,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/message_file_share_slack_connect.golden b/tests/golden/SlackWebhookEvent/message_file_share_slack_connect.golden --- a/tests/golden/SlackWebhookEvent/message_file_share_slack_connect.golden +++ b/tests/golden/SlackWebhookEvent/message_file_share_slack_connect.golden @@ -27,6 +27,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/message_rich_text.golden b/tests/golden/SlackWebhookEvent/message_rich_text.golden --- a/tests/golden/SlackWebhookEvent/message_rich_text.golden +++ b/tests/golden/SlackWebhookEvent/message_rich_text.golden @@ -26,7 +26,10 @@ , rsItalic = False } ) - , RichItemEmoji "cat" + , RichItemEmoji + ( Emoji + { unEmoji = "cat" } + ) , RichItemText " " ( RichStyle { rsBold = False @@ -79,6 +82,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } ) diff --git a/tests/golden/SlackWebhookEvent/non_spec_attachment.golden b/tests/golden/SlackWebhookEvent/non_spec_attachment.golden --- a/tests/golden/SlackWebhookEvent/non_spec_attachment.golden +++ b/tests/golden/SlackWebhookEvent/non_spec_attachment.golden @@ -22,6 +22,15 @@ , threadTs = Nothing , appId = Just "A01BP7R4KNY" , botId = Just "B07LDR01Z63" + , botProfile = Just + ( BotProfile + { id = "B07LDR01Z63" + , name = "GitHub" + , appId = "A01BP7R4KNY" + , teamId = TeamId + { unTeamId = "T043DB835ML" } + } + ) , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/share_with_message.golden b/tests/golden/SlackWebhookEvent/share_with_message.golden --- a/tests/golden/SlackWebhookEvent/share_with_message.golden +++ b/tests/golden/SlackWebhookEvent/share_with_message.golden @@ -37,6 +37,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/share_without_message.golden b/tests/golden/SlackWebhookEvent/share_without_message.golden --- a/tests/golden/SlackWebhookEvent/share_without_message.golden +++ b/tests/golden/SlackWebhookEvent/share_without_message.golden @@ -22,6 +22,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Just [ MessageAttachment { decoded = Just diff --git a/tests/golden/SlackWebhookEvent/slackbotIm.golden b/tests/golden/SlackWebhookEvent/slackbotIm.golden --- a/tests/golden/SlackWebhookEvent/slackbotIm.golden +++ b/tests/golden/SlackWebhookEvent/slackbotIm.golden @@ -46,6 +46,7 @@ , threadTs = Nothing , appId = Nothing , botId = Nothing + , botProfile = Nothing , attachments = Nothing } )