diff --git a/CHANGELOG.md b/CHANGELOG.md index dccd5ed..d985ea1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 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. + # 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 index ea6ef96..60e0a8e 100644 --- a/slack-web.cabal +++ b/slack-web.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: slack-web -version: 2.0.1.0 +version: 2.1.0.0 build-type: Simple @@ -29,6 +29,10 @@ extra-source-files: 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 category: Web @@ -69,7 +73,6 @@ common build-opts default-extensions: AllowAmbiguousTypes - ApplicativeDo BlockArguments DataKinds DeriveAnyClass @@ -97,6 +100,7 @@ common build-opts RankNTypes RecordWildCards RecursiveDo + RoleAnnotations ScopedTypeVariables StandaloneDeriving StandaloneKindSignatures @@ -127,6 +131,7 @@ library Web.Slack.Experimental.Blocks Web.Slack.Experimental.Blocks.Types Web.Slack.Experimental.Events.Types + Web.Slack.Experimental.Views Web.Slack.Experimental.RequestVerification other-modules: Web.Slack.Util @@ -188,6 +193,7 @@ test-suite tests 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 index 33d3087..4774135 100644 --- a/src/Web/Slack/AesonUtils.hs +++ b/src/Web/Slack/AesonUtils.hs @@ -2,10 +2,12 @@ module Web.Slack.AesonUtils where 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 @@ snakeCaseOptions = , 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 FromJSON UnixTimestamp where 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/Experimental/Blocks/Types.hs b/src/Web/Slack/Experimental/Blocks/Types.hs index c35c259..c355bd7 100644 --- a/src/Web/Slack/Experimental/Blocks/Types.hs +++ b/src/Web/Slack/Experimental/Blocks/Types.hs @@ -111,6 +111,8 @@ instance Slack Int where 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 @@ -402,6 +404,7 @@ data SlackBlock | SlackBlockRichText RichText | SlackBlockActions (Maybe SlackBlockId) SlackActionList -- 1 to 5 elements | SlackBlockHeader SlackPlainTextOnly -- max length 150 + | SlackBlockOther Object deriving stock (Eq) instance Show SlackBlock where @@ -420,6 +423,7 @@ instance Show SlackBlock where ] 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 +458,7 @@ instance ToJSON SlackBlock where [ "type" .= ("header" :: Text) , "text" .= slackPlainText ] + toJSON (SlackBlockOther o) = Object o instance FromJSON SlackBlock where parseJSON = withObject "SlackBlock" $ \obj -> do @@ -500,7 +505,7 @@ instance FromJSON SlackBlock where (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 index a8a1da9..7972ff1 100644 --- a/src/Web/Slack/Experimental/Events/Types.hs +++ b/src/Web/Slack/Experimental/Events/Types.hs @@ -273,6 +273,42 @@ newtype MessageId = MessageId {unMessageId :: Text} 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 +321,8 @@ data Event EventChannelJoinMessage | EventChannelCreated ChannelCreatedEvent | EventChannelLeft ChannelLeftEvent + | -- | @since 2.1.0.0 + EventAppHomeOpened AppHomeOpenedEvent | EventUnknown Value deriving stock (Show, Generic) @@ -302,6 +340,7 @@ instance FromJSON Event where ("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 index 0000000..7676b31 --- /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/tests/Web/Slack/Experimental/Events/TypesSpec.hs b/tests/Web/Slack/Experimental/Events/TypesSpec.hs index 49ed11f..45956ce 100644 --- a/tests/Web/Slack/Experimental/Events/TypesSpec.hs +++ b/tests/Web/Slack/Experimental/Events/TypesSpec.hs @@ -33,4 +33,6 @@ spec = describe "Types for Slack events" do , "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 index 0000000..d7d691f --- /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/golden/PublishResp/views.publish example.golden b/tests/golden/PublishResp/views.publish example.golden new file mode 100644 index 0000000..187b342 --- /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" } + } + } \ No newline at end of file diff --git a/tests/golden/PublishResp/views.publish example.json b/tests/golden/PublishResp/views.publish example.json new file mode 100644 index 0000000..665afd9 --- /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/SlackView/homeTabView.golden b/tests/golden/SlackView/homeTabView.golden new file mode 100644 index 0000000..d430994 --- /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" } + } \ No newline at end of file diff --git a/tests/golden/SlackView/homeTabView.json b/tests/golden/SlackView/homeTabView.json new file mode 100644 index 0000000..470823b --- /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 index 0000000..24a2a71 --- /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 + } + } \ No newline at end of file diff --git a/tests/golden/SlackView/modalView.json b/tests/golden/SlackView/modalView.json new file mode 100644 index 0000000..161b85c --- /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 index 0000000..b1e91ac --- /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" + } + ) + } + ) \ No newline at end of file diff --git a/tests/golden/SlackWebhookEvent/app_home_opened_home.json b/tests/golden/SlackWebhookEvent/app_home_opened_home.json new file mode 100644 index 0000000..88421f7 --- /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 index 0000000..20d4e58 --- /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" + } + ) + } + ) \ No newline at end of file diff --git a/tests/golden/SlackWebhookEvent/app_home_opened_messages.json b/tests/golden/SlackWebhookEvent/app_home_opened_messages.json new file mode 100644 index 0000000..6601f79 --- /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 +}