module Web.Slack.Types.Event where
import Web.Slack.Types.Channel
import Web.Slack.Types.Bot
import Web.Slack.Types.Base
import Web.Slack.Types.User
import Web.Slack.Types.File
import Web.Slack.Types.IM
import Web.Slack.Types.Id
import Web.Slack.Types.Item
import Web.Slack.Types.Comment
import Web.Slack.Types.Error
import Web.Slack.Types.Event.Subtype
import Web.Slack.Types.Group
import Web.Slack.Types.Time
import Web.Slack.Types.Presence
import Data.Aeson
import Data.Aeson.Types
import Control.Lens.TH
import Control.Applicative
import Data.Text (Text)
import qualified Data.Text as T
import Data.Monoid
import Prelude
type Domain = Text
data Event where
Hello :: Event
Message :: ChannelId -> Submitter -> Text -> SlackTimeStamp -> Maybe Subtype -> Maybe Edited -> Event
HiddenMessage :: ChannelId -> Submitter -> SlackTimeStamp -> Maybe Subtype -> Event
ChannelMarked :: ChannelId -> SlackTimeStamp -> Event
ChannelCreated :: Channel -> Event
ChannelJoined :: Channel -> Event
ChannelLeft :: Channel -> Event
ChannelDeleted :: ChannelId -> Event
ChannelRename :: ChannelRenameInfo -> Event
ChannelArchive :: ChannelId -> UserId -> Event
ChannelUnarchive :: ChannelId -> UserId -> Event
ChannelHistoryChanged :: SlackTimeStamp -> SlackTimeStamp -> SlackTimeStamp -> Event
ImCreated :: UserId -> IM -> Event
ImOpen :: UserId -> IMId -> Event
ImClose :: UserId -> IMId -> Event
ImMarked :: IMId -> SlackTimeStamp -> Event
ImHistoryChanged :: SlackTimeStamp -> SlackTimeStamp -> SlackTimeStamp -> Event
GroupJoined :: Group -> Event
GroupLeft :: Group -> Event
GroupOpen :: UserId -> GroupId -> Event
GroupClose :: UserId -> GroupId -> Event
GroupArchive :: GroupId -> Event
GroupUnarchive :: GroupId -> Event
GroupRename :: ChannelRenameInfo -> Event
GroupMarked :: GroupId -> SlackTimeStamp -> Event
GroupHistoryChanged :: SlackTimeStamp -> SlackTimeStamp -> SlackTimeStamp -> Event
FileCreated :: File -> Event
FileShared :: File -> Event
FileUnshared :: File -> Event
FilePublic :: File -> Event
FilePrivate :: FileId -> Event
FileChange :: File -> Event
FileDeleted :: FileId -> SlackTimeStamp -> Event
FileCommentAdded :: File -> Comment -> Event
FileCommentEdited :: File -> Comment -> Event
FileCommentDeleted :: File -> CommentId -> Event
PresenceChange :: UserId -> Presence -> Event
ManualPresenceChange :: Presence -> Event
PrefChange :: Pref -> Event
UserChange :: User -> Event
TeamJoin :: User -> Event
StarAdded :: UserId -> Item -> SlackTimeStamp -> Event
StarRemoved :: UserId -> Item -> SlackTimeStamp -> Event
EmojiChanged :: SlackTimeStamp -> Event
CommandsChanged :: SlackTimeStamp -> Event
TeamPrefChange :: Pref -> Event
TeamRenameEvent :: Text -> Event
TeamDomainChange :: URL -> Domain -> Event
EmailDomainChange :: Domain -> SlackTimeStamp -> Event
BotChanged :: Bot -> Event
BotAdded :: Bot -> Event
AccountsChanged :: Event
UserTyping :: ChannelId -> UserId -> Event
MessageResponse :: Int -> SlackTimeStamp -> Text -> Event
MessageError :: Int -> SlackError -> Event
Pong :: Time -> Event
NoEvent :: Event
deriving (Show)
type Pref = (Text, Value)
instance FromJSON Event where
parseJSON o@(Object v) = do
(typ :: Maybe Text) <- v .:? "type"
case typ of
Just t -> parseType o t
Nothing -> do
(ok :: Bool) <- v .: "ok"
if ok
then MessageResponse <$> v .: "reply_to" <*> v .: "ts" <*> v .: "text"
else MessageError <$> v .: "reply_to" <*> v .: "error"
parseJSON Null = return NoEvent
parseJSON _ = error "Expecting object: Event"
parseType :: Value -> Text -> Parser Event
parseType o@(Object v) typ =
case typ of
"hello" -> return Hello
"message" -> do
subt <- (\case
Nothing -> return Nothing
Just r -> Just <$> subtype r o) =<< v .:? "subtype"
submitter <- case subt of
Just (SBotMessage bid _ _) -> return $ BotComment bid
_ -> maybe System UserComment <$> v .:? "user"
(v .: "channel") :: Parser ChannelId
hidden <- (\case {Just True -> True; _ -> False}) <$> v .:? "hidden"
if not hidden
then Message <$> v .: "channel" <*> pure submitter <*> v .: "text" <*> v .: "ts" <*> pure subt <*> v .:? "edited"
else HiddenMessage <$> v .: "channel" <*> pure submitter <*> v .: "ts" <*> pure subt
"user_typing" -> UserTyping <$> v .: "channel" <*> v .: "user"
"presence_change" -> PresenceChange <$> v .: "user" <*> v .: "presence"
"channel_marked" -> ChannelMarked <$> v .: "channel" <*> v .: "ts"
"channel_created" -> ChannelCreated <$> v .: "channel"
"channel_joined" -> ChannelJoined <$> v .: "channel"
"channel_left" -> ChannelLeft <$> v .: "channel"
"channel_deleted" -> ChannelDeleted <$> v .: "channel"
"channel_rename" -> ChannelRename <$> v .: "channel"
"channel_archive" -> ChannelArchive <$> v .: "channel" <*> v .: "user"
"channel_unarchive" -> ChannelUnarchive <$> v .: "channel" <*> v .: "user"
"channel_history_changed" -> ChannelHistoryChanged <$> v .: "latest" <*> v .: "ts" <*> v .: "event_ts"
"im_open" -> ImOpen <$> v .: "user" <*> v .: "channel"
"im_created" -> ImCreated <$> v .: "user" <*> v .: "channel"
"im_close" -> ImClose <$> v .: "user" <*> v .: "channel"
"im_marked" -> ImMarked <$> v .: "channel" <*> v .: "ts"
"im_history_changed" -> ImHistoryChanged <$> v .: "latest" <*> v .: "ts" <*> v .: "event_ts"
"group_joined" -> GroupJoined <$> v .: "channel"
"group_left" -> GroupLeft <$> v .: "channel"
"group_open" -> GroupOpen <$> v .: "user" <*> v .: "channel"
"group_close" -> GroupClose <$> v .: "user" <*> v .: "channel"
"group_archive" -> GroupArchive <$> v .: "channel"
"group_unarchive" -> GroupUnarchive <$> v .: "channel"
"group_rename" -> GroupRename <$> v .: "channel"
"group_marked" -> GroupMarked <$> v .: "channel" <*> v .: "ts"
"group_history_changed" -> GroupHistoryChanged <$> v .: "latest" <*> v .: "ts" <*> v .: "event_ts"
"file_created" -> FileCreated <$> v .: "file"
"file_shared" -> FileShared <$> v .: "file"
"file_unshared" -> FileUnshared <$> v .: "file"
"file_public" -> FilePublic <$> v .: "file"
"file_private" -> FilePrivate <$> v .: "file"
"file_change" -> FileChange <$> v .: "file"
"file_deleted" -> FileDeleted <$> v .: "file_id" <*> v .: "event_ts"
"file_comment_added" -> FileCommentAdded <$> v .: "file" <*> v .: "comment"
"file_comment_edited" -> FileCommentEdited <$> v .: "file" <*> v .: "comment"
"file_comment_deleted" -> FileCommentDeleted <$> v .: "file" <*> v .: "comment"
"manual_presence_change" -> ManualPresenceChange <$> v .: "presence"
"pref_change" -> curry PrefChange <$> v .: "name" <*> v .: "value"
"user_change" -> UserChange <$> v .: "user"
"team_join" -> TeamJoin <$> v .: "user"
"star_added" -> StarAdded <$> v .: "user" <*> v .: "item" <*> v .: "event_ts"
"star_removed" -> StarRemoved <$> v .: "user" <*> v .: "item" <*> v .: "event_ts"
"emoji_changed" -> EmojiChanged <$> v .: "event_ts"
"commands_changed" -> CommandsChanged <$> v .: "event_ts"
"team_pref_change" -> curry TeamPrefChange <$> v .: "name" <*> v .: "value"
"team_rename" -> TeamRenameEvent <$> v .: "name"
"team_domain_change" -> TeamDomainChange <$> v .: "url" <*> v .: "domain"
"email_domain_changed" -> EmailDomainChange <$> v .: "email_domain" <*> v .: "event_ts"
"bot_added" -> BotAdded <$> v .: "bot"
"bot_changed" -> BotChanged <$> v .: "bot"
"accounts_changed" -> pure AccountsChanged
"pong" -> Pong <$> v .: "timestamp"
_ -> fail $ "Unrecognised type: " <> T.unpack typ
parseType _ _ = error "Expecting object"
data Submitter = UserComment UserId | BotComment BotId | System deriving (Show, Eq)
data ChannelRenameInfo = ChannelRenameInfo
{ _channelRenameId :: ChannelId
, _channelRenameName :: Text
, _channelRenameCreated :: Time } deriving Show
makeLenses ''ChannelRenameInfo
instance FromJSON ChannelRenameInfo where
parseJSON = withObject "ChannelRenameInfo" (\o -> ChannelRenameInfo <$> o .: "id" <*> o .: "name" <*> o .: "created")