{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- FIXME(jadel): Use NoFieldSelectors when we drop everything before 9.2.

-- | Types for the [Slack Events API](https://api.slack.com/events).
module Web.Slack.Experimental.Events.Types where

import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types (Parser)
import Data.Scientific qualified as Sci
import Data.Time.Clock.System (SystemTime)
import Web.Slack.AesonUtils
import Web.Slack.Experimental.Blocks (SlackBlock)
import Web.Slack.Files.Types (FileObject)
import Web.Slack.Prelude
import Web.Slack.Types (ConversationId, TeamId, UserId)

-- | Not a ConversationType for some mysterious reason; this one has Channel as
-- an option, which does not exist as a ConversationType. Slack, why?
data ChannelType = Channel | Group | Im
  deriving stock (Int -> ChannelType -> ShowS
[ChannelType] -> ShowS
ChannelType -> String
(Int -> ChannelType -> ShowS)
-> (ChannelType -> String)
-> ([ChannelType] -> ShowS)
-> Show ChannelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChannelType -> ShowS
showsPrec :: Int -> ChannelType -> ShowS
$cshow :: ChannelType -> String
show :: ChannelType -> String
$cshowList :: [ChannelType] -> ShowS
showList :: [ChannelType] -> ShowS
Show, ChannelType -> ChannelType -> Bool
(ChannelType -> ChannelType -> Bool)
-> (ChannelType -> ChannelType -> Bool) -> Eq ChannelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChannelType -> ChannelType -> Bool
== :: ChannelType -> ChannelType -> Bool
$c/= :: ChannelType -> ChannelType -> Bool
/= :: ChannelType -> ChannelType -> Bool
Eq)

$(deriveJSON snakeCaseOptions ''ChannelType)

-- | <https://api.slack.com/events/message/message_attachment>
-- Ported from https://github.com/slackapi/node-slack-sdk/blob/fc87d51/packages/types/src/message-attachments.ts
--
-- @since 2.0.0.3
data AttachmentField = AttachmentField
  { AttachmentField -> Text
title :: Text
  , AttachmentField -> Text
value :: Text
  , AttachmentField -> Maybe Bool
short :: Maybe Bool
  }
  deriving stock (Int -> AttachmentField -> ShowS
[AttachmentField] -> ShowS
AttachmentField -> String
(Int -> AttachmentField -> ShowS)
-> (AttachmentField -> String)
-> ([AttachmentField] -> ShowS)
-> Show AttachmentField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttachmentField -> ShowS
showsPrec :: Int -> AttachmentField -> ShowS
$cshow :: AttachmentField -> String
show :: AttachmentField -> String
$cshowList :: [AttachmentField] -> ShowS
showList :: [AttachmentField] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''AttachmentField)

-- | @since 2.0.0.3
data AttachmentMessageBlockMessage = AttachmentMessageBlockMessage
  { AttachmentMessageBlockMessage -> [SlackBlock]
blocks :: [SlackBlock]
  }
  deriving stock (Int -> AttachmentMessageBlockMessage -> ShowS
[AttachmentMessageBlockMessage] -> ShowS
AttachmentMessageBlockMessage -> String
(Int -> AttachmentMessageBlockMessage -> ShowS)
-> (AttachmentMessageBlockMessage -> String)
-> ([AttachmentMessageBlockMessage] -> ShowS)
-> Show AttachmentMessageBlockMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttachmentMessageBlockMessage -> ShowS
showsPrec :: Int -> AttachmentMessageBlockMessage -> ShowS
$cshow :: AttachmentMessageBlockMessage -> String
show :: AttachmentMessageBlockMessage -> String
$cshowList :: [AttachmentMessageBlockMessage] -> ShowS
showList :: [AttachmentMessageBlockMessage] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''AttachmentMessageBlockMessage)

-- | @since 2.0.0.3
data AttachmentMessageBlock = AttachmentMessageBlock
  { AttachmentMessageBlock -> TeamId
team :: TeamId
  , AttachmentMessageBlock -> ConversationId
channel :: ConversationId
  , AttachmentMessageBlock -> Text
ts :: Text
  , AttachmentMessageBlock -> AttachmentMessageBlockMessage
message :: AttachmentMessageBlockMessage
  }
  deriving stock (Int -> AttachmentMessageBlock -> ShowS
[AttachmentMessageBlock] -> ShowS
AttachmentMessageBlock -> String
(Int -> AttachmentMessageBlock -> ShowS)
-> (AttachmentMessageBlock -> String)
-> ([AttachmentMessageBlock] -> ShowS)
-> Show AttachmentMessageBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttachmentMessageBlock -> ShowS
showsPrec :: Int -> AttachmentMessageBlock -> ShowS
$cshow :: AttachmentMessageBlock -> String
show :: AttachmentMessageBlock -> String
$cshowList :: [AttachmentMessageBlock] -> ShowS
showList :: [AttachmentMessageBlock] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''AttachmentMessageBlock)

-- | <https://api.slack.com/events/message/message_attachment>
-- Ported from https://github.com/slackapi/node-slack-sdk/blob/fc87d51/packages/types/src/message-attachments.ts
--
-- @since 2.0.0.3
data DecodedMessageAttachment = DecodedMessageAttachment
  { DecodedMessageAttachment -> Maybe Text
fallback :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
color :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
pretext :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
authorName :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
authorLink :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
authorIcon :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
title :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
titleLink :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
text :: Maybe Text
  , DecodedMessageAttachment -> Maybe [AttachmentField]
fields :: Maybe [AttachmentField]
  , DecodedMessageAttachment -> Maybe Text
imageUrl :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
thumbUrl :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
footer :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
footerIcon :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
ts :: Maybe Text
  , -- the following are undocumented
    DecodedMessageAttachment -> Maybe Bool
isMsgUnfurl :: Maybe Bool
  , DecodedMessageAttachment -> Maybe [AttachmentMessageBlock]
messageBlocks :: Maybe [AttachmentMessageBlock]
  -- ^ unfurled message blocks
  , DecodedMessageAttachment -> Maybe UserId
authorId :: Maybe UserId
  , DecodedMessageAttachment -> Maybe ConversationId
channelId :: Maybe ConversationId
  , DecodedMessageAttachment -> Maybe TeamId
channelTeam :: Maybe TeamId
  , DecodedMessageAttachment -> Maybe Bool
isAppUnfurl :: Maybe Bool
  , DecodedMessageAttachment -> Maybe Text
appUnfurlUrl :: Maybe Text
  , DecodedMessageAttachment -> Maybe Text
fromUrl :: Maybe Text
  }
  deriving stock (Int -> DecodedMessageAttachment -> ShowS
[DecodedMessageAttachment] -> ShowS
DecodedMessageAttachment -> String
(Int -> DecodedMessageAttachment -> ShowS)
-> (DecodedMessageAttachment -> String)
-> ([DecodedMessageAttachment] -> ShowS)
-> Show DecodedMessageAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodedMessageAttachment -> ShowS
showsPrec :: Int -> DecodedMessageAttachment -> ShowS
$cshow :: DecodedMessageAttachment -> String
show :: DecodedMessageAttachment -> String
$cshowList :: [DecodedMessageAttachment] -> ShowS
showList :: [DecodedMessageAttachment] -> ShowS
Show)

instance FromJSON DecodedMessageAttachment where
  parseJSON :: Value -> Parser DecodedMessageAttachment
parseJSON = String
-> (Object -> Parser DecodedMessageAttachment)
-> Value
-> Parser DecodedMessageAttachment
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DecodedMessageAttachment" ((Object -> Parser DecodedMessageAttachment)
 -> Value -> Parser DecodedMessageAttachment)
-> (Object -> Parser DecodedMessageAttachment)
-> Value
-> Parser DecodedMessageAttachment
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Maybe Text
fallback <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fallback"
    Maybe Text
color <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"color"
    Maybe Text
pretext <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pretext"
    Maybe Text
authorName <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author_name"
    Maybe Text
authorLink <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author_link"
    Maybe Text
authorIcon <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author_icon"
    Maybe Text
title <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title"
    Maybe Text
titleLink <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title_link"
    Maybe Text
text <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"text"
    Maybe [AttachmentField]
fields <- Object
v Object -> Key -> Parser (Maybe [AttachmentField])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fields"
    Maybe Text
imageUrl <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"image_url"
    Maybe Text
thumbUrl <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"thumb_url"
    Maybe Text
footer <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"footer"
    Maybe Text
footerIcon <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"footer_icon"
    Maybe Text
ts <- Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ts" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Text)) -> Parser (Maybe Text)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe Text)
-> (Value -> Parser (Maybe Text))
-> Maybe Value
-> Parser (Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing) Value -> Parser (Maybe Text)
parseTs
    Maybe Bool
isMsgUnfurl <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_msg_unfurl"
    Maybe [AttachmentMessageBlock]
messageBlocks <- Object
v Object -> Key -> Parser (Maybe [AttachmentMessageBlock])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message_blocks"
    Maybe UserId
authorId <- Object
v Object -> Key -> Parser (Maybe UserId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author_id"
    Maybe ConversationId
channelId <- Object
v Object -> Key -> Parser (Maybe ConversationId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_id"
    Maybe TeamId
channelTeam <- Object
v Object -> Key -> Parser (Maybe TeamId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_team"
    Maybe Bool
isAppUnfurl <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_app_unfurl"
    Maybe Text
appUnfurlUrl <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"app_unfurl_url"
    Maybe Text
fromUrl <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"from_url"
    pure DecodedMessageAttachment {Maybe Bool
Maybe [AttachmentField]
Maybe [AttachmentMessageBlock]
Maybe Text
Maybe TeamId
Maybe ConversationId
Maybe UserId
$sel:fallback:DecodedMessageAttachment :: Maybe Text
$sel:color:DecodedMessageAttachment :: Maybe Text
$sel:pretext:DecodedMessageAttachment :: Maybe Text
$sel:authorName:DecodedMessageAttachment :: Maybe Text
$sel:authorLink:DecodedMessageAttachment :: Maybe Text
$sel:authorIcon:DecodedMessageAttachment :: Maybe Text
$sel:title:DecodedMessageAttachment :: Maybe Text
$sel:titleLink:DecodedMessageAttachment :: Maybe Text
$sel:text:DecodedMessageAttachment :: Maybe Text
$sel:fields:DecodedMessageAttachment :: Maybe [AttachmentField]
$sel:imageUrl:DecodedMessageAttachment :: Maybe Text
$sel:thumbUrl:DecodedMessageAttachment :: Maybe Text
$sel:footer:DecodedMessageAttachment :: Maybe Text
$sel:footerIcon:DecodedMessageAttachment :: Maybe Text
$sel:ts:DecodedMessageAttachment :: Maybe Text
$sel:isMsgUnfurl:DecodedMessageAttachment :: Maybe Bool
$sel:messageBlocks:DecodedMessageAttachment :: Maybe [AttachmentMessageBlock]
$sel:authorId:DecodedMessageAttachment :: Maybe UserId
$sel:channelId:DecodedMessageAttachment :: Maybe ConversationId
$sel:channelTeam:DecodedMessageAttachment :: Maybe TeamId
$sel:isAppUnfurl:DecodedMessageAttachment :: Maybe Bool
$sel:appUnfurlUrl:DecodedMessageAttachment :: Maybe Text
$sel:fromUrl:DecodedMessageAttachment :: Maybe Text
fallback :: Maybe Text
color :: Maybe Text
pretext :: Maybe Text
authorName :: Maybe Text
authorLink :: Maybe Text
authorIcon :: Maybe Text
title :: Maybe Text
titleLink :: Maybe Text
text :: Maybe Text
fields :: Maybe [AttachmentField]
imageUrl :: Maybe Text
thumbUrl :: Maybe Text
footer :: Maybe Text
footerIcon :: Maybe Text
ts :: Maybe Text
isMsgUnfurl :: Maybe Bool
messageBlocks :: Maybe [AttachmentMessageBlock]
authorId :: Maybe UserId
channelId :: Maybe ConversationId
channelTeam :: Maybe TeamId
isAppUnfurl :: Maybe Bool
appUnfurlUrl :: Maybe Text
fromUrl :: Maybe Text
..}
    where
      parseTs :: Value -> Parser (Maybe Text)
      parseTs :: Value -> Parser (Maybe Text)
parseTs (String Text
s) = Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Parser (Maybe Text))
-> Maybe Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
      parseTs (Number Scientific
n) =
        let s :: String
s = FPFormat -> Maybe Int -> Scientific -> String
Sci.formatScientific FPFormat
Sci.Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
n
            formatted :: String
formatted = if Char
Element String
'.' Element String -> String -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
`elem` String
s then String
s else String
s String -> ShowS
forall m. Monoid m => m -> m -> m
++ String
".000000"
         in Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Parser (Maybe Text))
-> Maybe Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just ([Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack String
[Element Text]
formatted)
      parseTs Value
_ = Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

data MessageAttachment = MessageAttachment
  { MessageAttachment -> Maybe DecodedMessageAttachment
decoded :: Maybe DecodedMessageAttachment
  -- ^ If the attachment can be decoded, this will be populated
  , MessageAttachment -> Value
raw :: Value
  -- ^ Slack does not document the attachment schema/spec very well and we can't
  -- decode many attachments. In these cases clients can work with the raw JSON.
  }
  deriving stock (Int -> MessageAttachment -> ShowS
[MessageAttachment] -> ShowS
MessageAttachment -> String
(Int -> MessageAttachment -> ShowS)
-> (MessageAttachment -> String)
-> ([MessageAttachment] -> ShowS)
-> Show MessageAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageAttachment -> ShowS
showsPrec :: Int -> MessageAttachment -> ShowS
$cshow :: MessageAttachment -> String
show :: MessageAttachment -> String
$cshowList :: [MessageAttachment] -> ShowS
showList :: [MessageAttachment] -> ShowS
Show)

instance FromJSON MessageAttachment where
  parseJSON :: Value -> Parser MessageAttachment
parseJSON = String
-> (Object -> Parser MessageAttachment)
-> Value
-> Parser MessageAttachment
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MessageAttachment" ((Object -> Parser MessageAttachment)
 -> Value -> Parser MessageAttachment)
-> (Object -> Parser MessageAttachment)
-> Value
-> Parser MessageAttachment
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    let ov :: Value
ov = Object -> Value
Object Object
v
    -- Attempt to parse the entire object as DecodedMessageAttachment
    Maybe DecodedMessageAttachment
decodedContent <- Parser DecodedMessageAttachment
-> Parser (Maybe DecodedMessageAttachment)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DecodedMessageAttachment
 -> Parser (Maybe DecodedMessageAttachment))
-> Parser DecodedMessageAttachment
-> Parser (Maybe DecodedMessageAttachment)
forall a b. (a -> b) -> a -> b
$ Value -> Parser DecodedMessageAttachment
forall a. FromJSON a => Value -> Parser a
parseJSON Value
ov
    -- Return the structured data with raw JSON preserved
    pure MessageAttachment {$sel:decoded:MessageAttachment :: Maybe DecodedMessageAttachment
decoded = Maybe DecodedMessageAttachment
decodedContent, $sel:raw:MessageAttachment :: Value
raw = Value
ov}

-- | <https://api.slack.com/events/message>
-- and
-- <https://api.slack.com/events/message/file_share>
data MessageEvent = MessageEvent
  { MessageEvent -> Maybe [SlackBlock]
blocks :: Maybe [SlackBlock]
  , MessageEvent -> ConversationId
channel :: ConversationId
  , MessageEvent -> Text
text :: Text
  , MessageEvent -> ChannelType
channelType :: ChannelType
  , MessageEvent -> Maybe [FileObject]
files :: Maybe [FileObject]
  -- ^ @since 1.6.0.0
  , -- FIXME(jadel): clientMsgId??
    MessageEvent -> UserId
user :: UserId
  , MessageEvent -> Text
ts :: Text
  , MessageEvent -> Maybe Text
threadTs :: Maybe Text
  -- ^ Present if the message is in a thread
  , MessageEvent -> Maybe Text
appId :: Maybe Text
  -- ^ Present if it's sent by an app
  --
  --   For mysterious reasons, this is NOT
  --   <https://api.slack.com/events/message/bot_message>, this is a regular
  --   message but with bot metadata. I Think it's because there *is* an
  --   associated user.
  --
  --   See @botMessage.json@ golden parser test.
  , MessageEvent -> Maybe Text
botId :: Maybe Text
  -- ^ Present if it's sent by a bot user
  , MessageEvent -> Maybe [MessageAttachment]
attachments :: Maybe [MessageAttachment]
  -- ^ @since 2.0.0.3
  -- Present if the message has attachments
  }
  deriving stock (Int -> MessageEvent -> ShowS
[MessageEvent] -> ShowS
MessageEvent -> String
(Int -> MessageEvent -> ShowS)
-> (MessageEvent -> String)
-> ([MessageEvent] -> ShowS)
-> Show MessageEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageEvent -> ShowS
showsPrec :: Int -> MessageEvent -> ShowS
$cshow :: MessageEvent -> String
show :: MessageEvent -> String
$cshowList :: [MessageEvent] -> ShowS
showList :: [MessageEvent] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''MessageEvent)

-- | <https://api.slack.com/events/message/bot_message>
-- This is similar to a MessageEvent but sent by a bot, for example
-- messages that Reacji Channeler sends.
--
-- @since 2.0.0.2
data BotMessageEvent = BotMessageEvent
  { BotMessageEvent -> Maybe [SlackBlock]
blocks :: Maybe [SlackBlock]
  , BotMessageEvent -> ConversationId
channel :: ConversationId
  , BotMessageEvent -> Text
text :: Text
  , BotMessageEvent -> ChannelType
channelType :: ChannelType
  , BotMessageEvent -> Maybe [FileObject]
files :: Maybe [FileObject]
  , BotMessageEvent -> Text
ts :: Text
  , BotMessageEvent -> Maybe Text
threadTs :: Maybe Text
  -- ^ Present if the message is in a thread
  , BotMessageEvent -> Maybe Text
appId :: Maybe Text
  -- ^ Some (or all) bots also have an App ID
  , BotMessageEvent -> Text
botId :: Text
  -- ^ Always present for bot_message subtype
  , BotMessageEvent -> Maybe [MessageAttachment]
attachments :: Maybe [MessageAttachment]
  -- ^ @since 2.0.0.3
  -- Present if the message has attachments
  }
  deriving stock (Int -> BotMessageEvent -> ShowS
[BotMessageEvent] -> ShowS
BotMessageEvent -> String
(Int -> BotMessageEvent -> ShowS)
-> (BotMessageEvent -> String)
-> ([BotMessageEvent] -> ShowS)
-> Show BotMessageEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BotMessageEvent -> ShowS
showsPrec :: Int -> BotMessageEvent -> ShowS
$cshow :: BotMessageEvent -> String
show :: BotMessageEvent -> String
$cshowList :: [BotMessageEvent] -> ShowS
showList :: [BotMessageEvent] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''BotMessageEvent)

-- | <https://api.slack.com/events/message/message_changed>
--
-- FIXME(jadel): implement. This is mega cursed! in the normal message event
-- the channel is called "channel" but here it is called "channelId" and also
-- has a "channel_name" and "channel_team". Why?!
--
-- We don't decode these on this basis.
data MessageUpdateEvent = MessageUpdateEvent
  { MessageUpdateEvent -> MessageEvent
message :: MessageEvent
  }
  deriving stock (Int -> MessageUpdateEvent -> ShowS
[MessageUpdateEvent] -> ShowS
MessageUpdateEvent -> String
(Int -> MessageUpdateEvent -> ShowS)
-> (MessageUpdateEvent -> String)
-> ([MessageUpdateEvent] -> ShowS)
-> Show MessageUpdateEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageUpdateEvent -> ShowS
showsPrec :: Int -> MessageUpdateEvent -> ShowS
$cshow :: MessageUpdateEvent -> String
show :: MessageUpdateEvent -> String
$cshowList :: [MessageUpdateEvent] -> ShowS
showList :: [MessageUpdateEvent] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''MessageUpdateEvent)

-- | FIXME: this might be a Channel, but may also be missing some fields/have bonus
-- because Slack is cursed.
data CreatedChannel = CreatedChannel
  { CreatedChannel -> ConversationId
id :: ConversationId
  , CreatedChannel -> Bool
isChannel :: Bool
  , CreatedChannel -> Text
name :: Text
  , CreatedChannel -> Text
nameNormalized :: Text
  , CreatedChannel -> UserId
creator :: UserId
  , CreatedChannel -> SystemTime
created :: SystemTime
  , CreatedChannel -> Bool
isShared :: Bool
  , CreatedChannel -> Bool
isOrgShared :: Bool
  , -- what is this?
    CreatedChannel -> TeamId
contextTeamId :: TeamId
  }
  deriving stock (Int -> CreatedChannel -> ShowS
[CreatedChannel] -> ShowS
CreatedChannel -> String
(Int -> CreatedChannel -> ShowS)
-> (CreatedChannel -> String)
-> ([CreatedChannel] -> ShowS)
-> Show CreatedChannel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedChannel -> ShowS
showsPrec :: Int -> CreatedChannel -> ShowS
$cshow :: CreatedChannel -> String
show :: CreatedChannel -> String
$cshowList :: [CreatedChannel] -> ShowS
showList :: [CreatedChannel] -> ShowS
Show)

-- | A channel was created.
--
-- <https://api.slack.com/events/channel_created>
data ChannelCreatedEvent = ChannelCreatedEvent
  { ChannelCreatedEvent -> CreatedChannel
channel :: CreatedChannel
  }
  deriving stock (Int -> ChannelCreatedEvent -> ShowS
[ChannelCreatedEvent] -> ShowS
ChannelCreatedEvent -> String
(Int -> ChannelCreatedEvent -> ShowS)
-> (ChannelCreatedEvent -> String)
-> ([ChannelCreatedEvent] -> ShowS)
-> Show ChannelCreatedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChannelCreatedEvent -> ShowS
showsPrec :: Int -> ChannelCreatedEvent -> ShowS
$cshow :: ChannelCreatedEvent -> String
show :: ChannelCreatedEvent -> String
$cshowList :: [ChannelCreatedEvent] -> ShowS
showList :: [ChannelCreatedEvent] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''CreatedChannel)
$(deriveFromJSON snakeCaseOptions ''ChannelCreatedEvent)

-- | You left a channel.
--
-- <https://api.slack.com/events/channel_left>
data ChannelLeftEvent = ChannelLeftEvent
  { ChannelLeftEvent -> UserId
actorId :: UserId
  , ChannelLeftEvent -> ConversationId
channel :: ConversationId
  , ChannelLeftEvent -> Text
eventTs :: Text
  }
  deriving stock (Int -> ChannelLeftEvent -> ShowS
[ChannelLeftEvent] -> ShowS
ChannelLeftEvent -> String
(Int -> ChannelLeftEvent -> ShowS)
-> (ChannelLeftEvent -> String)
-> ([ChannelLeftEvent] -> ShowS)
-> Show ChannelLeftEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChannelLeftEvent -> ShowS
showsPrec :: Int -> ChannelLeftEvent -> ShowS
$cshow :: ChannelLeftEvent -> String
show :: ChannelLeftEvent -> String
$cshowList :: [ChannelLeftEvent] -> ShowS
showList :: [ChannelLeftEvent] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''ChannelLeftEvent)

-- | <https://api.slack.com/events/url_verification>
data UrlVerificationPayload = UrlVerificationPayload
  { UrlVerificationPayload -> Text
challenge :: Text
  }
  deriving stock (Int -> UrlVerificationPayload -> ShowS
[UrlVerificationPayload] -> ShowS
UrlVerificationPayload -> String
(Int -> UrlVerificationPayload -> ShowS)
-> (UrlVerificationPayload -> String)
-> ([UrlVerificationPayload] -> ShowS)
-> Show UrlVerificationPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlVerificationPayload -> ShowS
showsPrec :: Int -> UrlVerificationPayload -> ShowS
$cshow :: UrlVerificationPayload -> String
show :: UrlVerificationPayload -> String
$cshowList :: [UrlVerificationPayload] -> ShowS
showList :: [UrlVerificationPayload] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''UrlVerificationPayload)

newtype EventId = EventId {EventId -> Text
unEventId :: Text}
  deriving newtype (Value -> Parser [EventId]
Value -> Parser EventId
(Value -> Parser EventId)
-> (Value -> Parser [EventId]) -> FromJSON EventId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EventId
parseJSON :: Value -> Parser EventId
$cparseJSONList :: Value -> Parser [EventId]
parseJSONList :: Value -> Parser [EventId]
FromJSON)
  deriving stock (Int -> EventId -> ShowS
[EventId] -> ShowS
EventId -> String
(Int -> EventId -> ShowS)
-> (EventId -> String) -> ([EventId] -> ShowS) -> Show EventId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventId -> ShowS
showsPrec :: Int -> EventId -> ShowS
$cshow :: EventId -> String
show :: EventId -> String
$cshowList :: [EventId] -> ShowS
showList :: [EventId] -> ShowS
Show)

newtype MessageId = MessageId {MessageId -> Text
unMessageId :: Text}
  deriving newtype (Value -> Parser [MessageId]
Value -> Parser MessageId
(Value -> Parser MessageId)
-> (Value -> Parser [MessageId]) -> FromJSON MessageId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MessageId
parseJSON :: Value -> Parser MessageId
$cparseJSONList :: Value -> Parser [MessageId]
parseJSONList :: Value -> Parser [MessageId]
FromJSON)
  deriving stock (Int -> MessageId -> ShowS
[MessageId] -> ShowS
MessageId -> String
(Int -> MessageId -> ShowS)
-> (MessageId -> String)
-> ([MessageId] -> ShowS)
-> Show MessageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageId -> ShowS
showsPrec :: Int -> MessageId -> ShowS
$cshow :: MessageId -> String
show :: MessageId -> String
$cshowList :: [MessageId] -> ShowS
showList :: [MessageId] -> ShowS
Show, MessageId -> MessageId -> Bool
(MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool) -> Eq MessageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageId -> MessageId -> Bool
== :: MessageId -> MessageId -> Bool
$c/= :: MessageId -> MessageId -> Bool
/= :: MessageId -> MessageId -> Bool
Eq)

data Event
  = EventMessage MessageEvent
  | EventBotMessage BotMessageEvent
  | EventMessageChanged
  | -- | Weird message event of subtype channel_join. Sent "sometimes", according
    -- to a random Slack blog post from 2017:
    -- <https://api.slack.com/changelog/2017-05-rethinking-channel-entrance-and-exit-events-and-messages>
    --
    -- Documentation: <https://api.slack.com/events/message/channel_join>
    EventChannelJoinMessage
  | EventChannelCreated ChannelCreatedEvent
  | EventChannelLeft ChannelLeftEvent
  | EventUnknown Value
  deriving stock (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
Generic)

instance FromJSON Event where
  parseJSON :: Value -> Parser Event
parseJSON = String -> (Object -> Parser Event) -> Value -> Parser Event
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MessageEvent" \Object
obj -> do
    Text
tag :: Text <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Text
subtype :: Maybe Text <- Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subtype"
    case (Text
tag, Maybe Text
subtype) of
      (Text
"message", Maybe Text
Nothing) -> MessageEvent -> Event
EventMessage (MessageEvent -> Event) -> Parser MessageEvent -> Parser Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @MessageEvent (Object -> Value
Object Object
obj)
      (Text
"message", Just Text
"bot_message") -> BotMessageEvent -> Event
EventBotMessage (BotMessageEvent -> Event)
-> Parser BotMessageEvent -> Parser Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @BotMessageEvent (Object -> Value
Object Object
obj)
      (Text
"message", Just Text
"message_changed") -> Event -> Parser Event
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
EventMessageChanged
      (Text
"message", Just Text
"channel_join") -> Event -> Parser Event
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
EventChannelJoinMessage
      -- n.b. these are unified since it is *identical* to a Message event with
      -- a bonus files field
      (Text
"message", Just Text
"file_share") -> MessageEvent -> Event
EventMessage (MessageEvent -> Event) -> Parser MessageEvent -> Parser Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @MessageEvent (Object -> Value
Object Object
obj)
      (Text
"channel_created", Maybe Text
Nothing) -> ChannelCreatedEvent -> Event
EventChannelCreated (ChannelCreatedEvent -> Event)
-> Parser ChannelCreatedEvent -> Parser Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ChannelCreatedEvent
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
      (Text
"channel_left", Maybe Text
Nothing) -> ChannelLeftEvent -> Event
EventChannelLeft (ChannelLeftEvent -> Event)
-> Parser ChannelLeftEvent -> Parser Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ChannelLeftEvent
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
      (Text, Maybe Text)
_ -> Event -> Parser Event
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> Parser Event) -> Event -> Parser Event
forall a b. (a -> b) -> a -> b
$ Value -> Event
EventUnknown (Object -> Value
Object Object
obj)

data EventCallback = EventCallback
  { EventCallback -> EventId
eventId :: EventId
  , EventCallback -> TeamId
teamId :: TeamId
  , EventCallback -> SystemTime
eventTime :: SystemTime
  , EventCallback -> Event
event :: Event
  }
  deriving stock (Int -> EventCallback -> ShowS
[EventCallback] -> ShowS
EventCallback -> String
(Int -> EventCallback -> ShowS)
-> (EventCallback -> String)
-> ([EventCallback] -> ShowS)
-> Show EventCallback
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventCallback -> ShowS
showsPrec :: Int -> EventCallback -> ShowS
$cshow :: EventCallback -> String
show :: EventCallback -> String
$cshowList :: [EventCallback] -> ShowS
showList :: [EventCallback] -> ShowS
Show)

$(deriveFromJSON snakeCaseOptions ''EventCallback)

data SlackWebhookEvent
  = EventUrlVerification UrlVerificationPayload
  | EventEventCallback EventCallback
  | EventUnknownWebhook Value
  deriving stock (Int -> SlackWebhookEvent -> ShowS
[SlackWebhookEvent] -> ShowS
SlackWebhookEvent -> String
(Int -> SlackWebhookEvent -> ShowS)
-> (SlackWebhookEvent -> String)
-> ([SlackWebhookEvent] -> ShowS)
-> Show SlackWebhookEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlackWebhookEvent -> ShowS
showsPrec :: Int -> SlackWebhookEvent -> ShowS
$cshow :: SlackWebhookEvent -> String
show :: SlackWebhookEvent -> String
$cshowList :: [SlackWebhookEvent] -> ShowS
showList :: [SlackWebhookEvent] -> ShowS
Show, (forall x. SlackWebhookEvent -> Rep SlackWebhookEvent x)
-> (forall x. Rep SlackWebhookEvent x -> SlackWebhookEvent)
-> Generic SlackWebhookEvent
forall x. Rep SlackWebhookEvent x -> SlackWebhookEvent
forall x. SlackWebhookEvent -> Rep SlackWebhookEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlackWebhookEvent -> Rep SlackWebhookEvent x
from :: forall x. SlackWebhookEvent -> Rep SlackWebhookEvent x
$cto :: forall x. Rep SlackWebhookEvent x -> SlackWebhookEvent
to :: forall x. Rep SlackWebhookEvent x -> SlackWebhookEvent
Generic)

instance FromJSON SlackWebhookEvent where
  parseJSON :: Value -> Parser SlackWebhookEvent
parseJSON = String
-> (Object -> Parser SlackWebhookEvent)
-> Value
-> Parser SlackWebhookEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SlackWebhookEvent" \Object
obj -> do
    Text
tag :: Text <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case Text
tag of
      Text
"url_verification" -> UrlVerificationPayload -> SlackWebhookEvent
EventUrlVerification (UrlVerificationPayload -> SlackWebhookEvent)
-> Parser UrlVerificationPayload -> Parser SlackWebhookEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser UrlVerificationPayload
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
      Text
"event_callback" -> EventCallback -> SlackWebhookEvent
EventEventCallback (EventCallback -> SlackWebhookEvent)
-> Parser EventCallback -> Parser SlackWebhookEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser EventCallback
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
      Text
_ -> SlackWebhookEvent -> Parser SlackWebhookEvent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlackWebhookEvent -> Parser SlackWebhookEvent)
-> SlackWebhookEvent -> Parser SlackWebhookEvent
forall a b. (a -> b) -> a -> b
$ Value -> SlackWebhookEvent
EventUnknownWebhook (Object -> Value
Object Object
obj)

-- * Event responses

-- $eventResponses
--
-- By and large, Slack does not care about the response returned from event
-- handlers, at least for the 'EventEventCallback' as long as your service
-- 200s. The exception is 'EventUrlVerification', which is expected to return a
-- 'UrlVerificationResponse'

-- | Response for @url_verification@.
data UrlVerificationResponse = UrlVerificationResponse
  { UrlVerificationResponse -> Text
challenge :: Text
  }
  deriving stock (Int -> UrlVerificationResponse -> ShowS
[UrlVerificationResponse] -> ShowS
UrlVerificationResponse -> String
(Int -> UrlVerificationResponse -> ShowS)
-> (UrlVerificationResponse -> String)
-> ([UrlVerificationResponse] -> ShowS)
-> Show UrlVerificationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlVerificationResponse -> ShowS
showsPrec :: Int -> UrlVerificationResponse -> ShowS
$cshow :: UrlVerificationResponse -> String
show :: UrlVerificationResponse -> String
$cshowList :: [UrlVerificationResponse] -> ShowS
showList :: [UrlVerificationResponse] -> ShowS
Show)

$(deriveToJSON defaultOptions ''UrlVerificationResponse)