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

module Web.Slack.Chat (
  PostMsg (..),
  PostMsgReq (..),
  mkPostMsgReq,
  PostMsgRsp (..),
  UpdateReq (..),
  mkUpdateReq,
  UpdateRsp (..),
) where

import Web.FormUrlEncoded
import Web.Slack.Conversation (ConversationId)
import Web.Slack.Prelude
import Web.Slack.Util

data PostMsg = PostMsg
  { PostMsg -> Text
postMsgText :: Text
  , PostMsg -> Maybe Text
postMsgParse :: Maybe Text
  , PostMsg -> Maybe Bool
postMsgLinkNames :: Maybe Bool
  , PostMsg -> Maybe Text
postMsgAttachments :: Maybe Text
  , PostMsg -> Maybe Bool
postMsgUnfurlLinks :: Maybe Bool
  , PostMsg -> Maybe Bool
postMsgUnfurlMedia :: Maybe Bool
  , PostMsg -> Maybe Text
postMsgUsername :: Maybe Text
  , PostMsg -> Maybe Bool
postMsgAsUser :: Maybe Bool
  , PostMsg -> Maybe Text
postMsgIconUrl :: Maybe Text
  , PostMsg -> Maybe Text
postMsgIconEmoji :: Maybe Text
  , PostMsg -> Maybe Text
postMsgThreadTs :: Maybe Text
  , PostMsg -> Maybe Bool
postMsgReplyBroadcast :: Maybe Bool
  }
  deriving stock (PostMsg -> PostMsg -> Bool
(PostMsg -> PostMsg -> Bool)
-> (PostMsg -> PostMsg -> Bool) -> Eq PostMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostMsg -> PostMsg -> Bool
== :: PostMsg -> PostMsg -> Bool
$c/= :: PostMsg -> PostMsg -> Bool
/= :: PostMsg -> PostMsg -> Bool
Eq, (forall x. PostMsg -> Rep PostMsg x)
-> (forall x. Rep PostMsg x -> PostMsg) -> Generic PostMsg
forall x. Rep PostMsg x -> PostMsg
forall x. PostMsg -> Rep PostMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostMsg -> Rep PostMsg x
from :: forall x. PostMsg -> Rep PostMsg x
$cto :: forall x. Rep PostMsg x -> PostMsg
to :: forall x. Rep PostMsg x -> PostMsg
Generic, Int -> PostMsg -> ShowS
[PostMsg] -> ShowS
PostMsg -> String
(Int -> PostMsg -> ShowS)
-> (PostMsg -> String) -> ([PostMsg] -> ShowS) -> Show PostMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostMsg -> ShowS
showsPrec :: Int -> PostMsg -> ShowS
$cshow :: PostMsg -> String
show :: PostMsg -> String
$cshowList :: [PostMsg] -> ShowS
showList :: [PostMsg] -> ShowS
Show)

instance NFData PostMsg

$(deriveJSON (jsonOpts "postMsg") ''PostMsg)

data PostMsgReq = PostMsgReq
  { PostMsgReq -> Text
postMsgReqChannel :: Text
  , PostMsgReq -> Maybe Text
postMsgReqText :: Maybe Text
  -- ^ One of 'postMsgReqText', 'postMsgReqAttachments', or 'postMsgReqBlocks'
  -- is required.
  , PostMsgReq -> Maybe Text
postMsgReqParse :: Maybe Text
  , PostMsgReq -> Maybe Bool
postMsgReqLinkNames :: Maybe Bool
  , PostMsgReq -> Maybe Text
postMsgReqAttachments :: Maybe Text
  , PostMsgReq -> Maybe Text
postMsgReqBlocks :: Maybe Text
  , PostMsgReq -> Maybe Bool
postMsgReqUnfurlLinks :: Maybe Bool
  , PostMsgReq -> Maybe Bool
postMsgReqUnfurlMedia :: Maybe Bool
  , PostMsgReq -> Maybe Text
postMsgReqUsername :: Maybe Text
  , PostMsgReq -> Maybe Bool
postMsgReqAsUser :: Maybe Bool
  , PostMsgReq -> Maybe Text
postMsgReqIconUrl :: Maybe Text
  , PostMsgReq -> Maybe Text
postMsgReqIconEmoji :: Maybe Text
  , PostMsgReq -> Maybe Text
postMsgReqThreadTs :: Maybe Text
  , PostMsgReq -> Maybe Bool
postMsgReqReplyBroadcast :: Maybe Bool
  }
  deriving stock (PostMsgReq -> PostMsgReq -> Bool
(PostMsgReq -> PostMsgReq -> Bool)
-> (PostMsgReq -> PostMsgReq -> Bool) -> Eq PostMsgReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostMsgReq -> PostMsgReq -> Bool
== :: PostMsgReq -> PostMsgReq -> Bool
$c/= :: PostMsgReq -> PostMsgReq -> Bool
/= :: PostMsgReq -> PostMsgReq -> Bool
Eq, (forall x. PostMsgReq -> Rep PostMsgReq x)
-> (forall x. Rep PostMsgReq x -> PostMsgReq) -> Generic PostMsgReq
forall x. Rep PostMsgReq x -> PostMsgReq
forall x. PostMsgReq -> Rep PostMsgReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostMsgReq -> Rep PostMsgReq x
from :: forall x. PostMsgReq -> Rep PostMsgReq x
$cto :: forall x. Rep PostMsgReq x -> PostMsgReq
to :: forall x. Rep PostMsgReq x -> PostMsgReq
Generic, Int -> PostMsgReq -> ShowS
[PostMsgReq] -> ShowS
PostMsgReq -> String
(Int -> PostMsgReq -> ShowS)
-> (PostMsgReq -> String)
-> ([PostMsgReq] -> ShowS)
-> Show PostMsgReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostMsgReq -> ShowS
showsPrec :: Int -> PostMsgReq -> ShowS
$cshow :: PostMsgReq -> String
show :: PostMsgReq -> String
$cshowList :: [PostMsgReq] -> ShowS
showList :: [PostMsgReq] -> ShowS
Show)

instance NFData PostMsgReq

$(deriveJSON (jsonOpts "postMsgReq") ''PostMsgReq)

instance ToForm PostMsgReq where
  toForm :: PostMsgReq -> Form
toForm =
    FormOptions -> PostMsgReq -> Form
forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm (Text -> FormOptions
formOpts Text
"postMsgReq")

mkPostMsgReq ::
  Text ->
  Text ->
  PostMsgReq
mkPostMsgReq :: Text -> Text -> PostMsgReq
mkPostMsgReq Text
channel Text
text =
  PostMsgReq
    { postMsgReqChannel :: Text
postMsgReqChannel = Text
channel
    , postMsgReqText :: Maybe Text
postMsgReqText = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
    , postMsgReqParse :: Maybe Text
postMsgReqParse = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqLinkNames :: Maybe Bool
postMsgReqLinkNames = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqAttachments :: Maybe Text
postMsgReqAttachments = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqBlocks :: Maybe Text
postMsgReqBlocks = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqUnfurlLinks :: Maybe Bool
postMsgReqUnfurlLinks = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqUnfurlMedia :: Maybe Bool
postMsgReqUnfurlMedia = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqUsername :: Maybe Text
postMsgReqUsername = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqAsUser :: Maybe Bool
postMsgReqAsUser = Maybe Bool
forall a. Maybe a
Nothing
    , postMsgReqIconUrl :: Maybe Text
postMsgReqIconUrl = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqIconEmoji :: Maybe Text
postMsgReqIconEmoji = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqThreadTs :: Maybe Text
postMsgReqThreadTs = Maybe Text
forall a. Maybe a
Nothing
    , postMsgReqReplyBroadcast :: Maybe Bool
postMsgReqReplyBroadcast = Maybe Bool
forall a. Maybe a
Nothing
    }

data PostMsgRsp = PostMsgRsp
  { PostMsgRsp -> Text
postMsgRspTs :: Text
  , PostMsgRsp -> PostMsg
postMsgRspMessage :: PostMsg
  }
  deriving stock (PostMsgRsp -> PostMsgRsp -> Bool
(PostMsgRsp -> PostMsgRsp -> Bool)
-> (PostMsgRsp -> PostMsgRsp -> Bool) -> Eq PostMsgRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostMsgRsp -> PostMsgRsp -> Bool
== :: PostMsgRsp -> PostMsgRsp -> Bool
$c/= :: PostMsgRsp -> PostMsgRsp -> Bool
/= :: PostMsgRsp -> PostMsgRsp -> Bool
Eq, (forall x. PostMsgRsp -> Rep PostMsgRsp x)
-> (forall x. Rep PostMsgRsp x -> PostMsgRsp) -> Generic PostMsgRsp
forall x. Rep PostMsgRsp x -> PostMsgRsp
forall x. PostMsgRsp -> Rep PostMsgRsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostMsgRsp -> Rep PostMsgRsp x
from :: forall x. PostMsgRsp -> Rep PostMsgRsp x
$cto :: forall x. Rep PostMsgRsp x -> PostMsgRsp
to :: forall x. Rep PostMsgRsp x -> PostMsgRsp
Generic, Int -> PostMsgRsp -> ShowS
[PostMsgRsp] -> ShowS
PostMsgRsp -> String
(Int -> PostMsgRsp -> ShowS)
-> (PostMsgRsp -> String)
-> ([PostMsgRsp] -> ShowS)
-> Show PostMsgRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostMsgRsp -> ShowS
showsPrec :: Int -> PostMsgRsp -> ShowS
$cshow :: PostMsgRsp -> String
show :: PostMsgRsp -> String
$cshowList :: [PostMsgRsp] -> ShowS
showList :: [PostMsgRsp] -> ShowS
Show)

instance NFData PostMsgRsp

$(deriveFromJSON (jsonOpts "postMsgRsp") ''PostMsgRsp)

-- | <https://api.slack.com/methods/chat.update>
data UpdateReq = UpdateReq
  { UpdateReq -> ConversationId
updateReqChannel :: ConversationId
  , UpdateReq -> Text
updateReqTs :: Text
  -- ^ \"Timestamp of the message to be updated.\"
  , UpdateReq -> Maybe Bool
updateReqAsUser :: Maybe Bool
  -- ^ \"Pass true to update the message as the authed user. Bot users in this context are considered authed users.\"
  , UpdateReq -> Maybe Text
updateReqAttachments :: Maybe Text
  -- ^ \"A JSON-based array of structured attachments, presented as a URL-encoded string. This field is required when not presenting text. If you don't include this field, the message's previous attachments will be retained. To remove previous attachments, include an empty array for this field.\"
  , UpdateReq -> Maybe Bool
updateReqLinkNames :: Maybe Bool
  , UpdateReq -> Maybe Text
updateReqMetadata :: Maybe Text
  , UpdateReq -> Maybe Text
updateReqParse :: Maybe Text
  , UpdateReq -> Maybe Bool
updateReqReplyBroadcast :: Maybe Bool
  -- ^ \"Broadcast an existing thread reply to make it visible to everyone in the channel or conversation.\"
  , UpdateReq -> Maybe Text
updateReqText :: Maybe Text
  -- ^ \"New text for the message, using the default formatting rules. It's not required when presenting blocks or attachments.\"
  }
  deriving stock (UpdateReq -> UpdateReq -> Bool
(UpdateReq -> UpdateReq -> Bool)
-> (UpdateReq -> UpdateReq -> Bool) -> Eq UpdateReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateReq -> UpdateReq -> Bool
== :: UpdateReq -> UpdateReq -> Bool
$c/= :: UpdateReq -> UpdateReq -> Bool
/= :: UpdateReq -> UpdateReq -> Bool
Eq, (forall x. UpdateReq -> Rep UpdateReq x)
-> (forall x. Rep UpdateReq x -> UpdateReq) -> Generic UpdateReq
forall x. Rep UpdateReq x -> UpdateReq
forall x. UpdateReq -> Rep UpdateReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateReq -> Rep UpdateReq x
from :: forall x. UpdateReq -> Rep UpdateReq x
$cto :: forall x. Rep UpdateReq x -> UpdateReq
to :: forall x. Rep UpdateReq x -> UpdateReq
Generic, Int -> UpdateReq -> ShowS
[UpdateReq] -> ShowS
UpdateReq -> String
(Int -> UpdateReq -> ShowS)
-> (UpdateReq -> String)
-> ([UpdateReq] -> ShowS)
-> Show UpdateReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateReq -> ShowS
showsPrec :: Int -> UpdateReq -> ShowS
$cshow :: UpdateReq -> String
show :: UpdateReq -> String
$cshowList :: [UpdateReq] -> ShowS
showList :: [UpdateReq] -> ShowS
Show)

instance ToForm UpdateReq where
  toForm :: UpdateReq -> Form
toForm = FormOptions -> UpdateReq -> Form
forall a.
(Generic a, GToForm a (Rep a)) =>
FormOptions -> a -> Form
genericToForm (Text -> FormOptions
formOpts Text
"updateReq")

mkUpdateReq :: ConversationId -> Text -> UpdateReq
mkUpdateReq :: ConversationId -> Text -> UpdateReq
mkUpdateReq ConversationId
channel Text
ts =
  UpdateReq
    { updateReqChannel :: ConversationId
updateReqChannel = ConversationId
channel
    , updateReqTs :: Text
updateReqTs = Text
ts
    , updateReqAsUser :: Maybe Bool
updateReqAsUser = Maybe Bool
forall a. Maybe a
Nothing
    , updateReqAttachments :: Maybe Text
updateReqAttachments = Maybe Text
forall a. Maybe a
Nothing
    , updateReqLinkNames :: Maybe Bool
updateReqLinkNames = Maybe Bool
forall a. Maybe a
Nothing
    , updateReqMetadata :: Maybe Text
updateReqMetadata = Maybe Text
forall a. Maybe a
Nothing
    , updateReqParse :: Maybe Text
updateReqParse = Maybe Text
forall a. Maybe a
Nothing
    , updateReqReplyBroadcast :: Maybe Bool
updateReqReplyBroadcast = Maybe Bool
forall a. Maybe a
Nothing
    , updateReqText :: Maybe Text
updateReqText = Maybe Text
forall a. Maybe a
Nothing
    }

data UpdateRsp = UpdateRsp
  { UpdateRsp -> ConversationId
updateRspChannel :: ConversationId
  , UpdateRsp -> Text
updateRspTs :: Text
  , UpdateRsp -> Text
updateRspText :: Text
  -- FIXME(jadel): this does look suspiciously like the same schema as
  -- MessageEvent based on the example I received, but Slack hasn't documented
  -- what it actually is, so let's not try to parse it for now.
  -- , message :: MessageEvent
  }
  deriving stock (UpdateRsp -> UpdateRsp -> Bool
(UpdateRsp -> UpdateRsp -> Bool)
-> (UpdateRsp -> UpdateRsp -> Bool) -> Eq UpdateRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateRsp -> UpdateRsp -> Bool
== :: UpdateRsp -> UpdateRsp -> Bool
$c/= :: UpdateRsp -> UpdateRsp -> Bool
/= :: UpdateRsp -> UpdateRsp -> Bool
Eq, (forall x. UpdateRsp -> Rep UpdateRsp x)
-> (forall x. Rep UpdateRsp x -> UpdateRsp) -> Generic UpdateRsp
forall x. Rep UpdateRsp x -> UpdateRsp
forall x. UpdateRsp -> Rep UpdateRsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateRsp -> Rep UpdateRsp x
from :: forall x. UpdateRsp -> Rep UpdateRsp x
$cto :: forall x. Rep UpdateRsp x -> UpdateRsp
to :: forall x. Rep UpdateRsp x -> UpdateRsp
Generic, Int -> UpdateRsp -> ShowS
[UpdateRsp] -> ShowS
UpdateRsp -> String
(Int -> UpdateRsp -> ShowS)
-> (UpdateRsp -> String)
-> ([UpdateRsp] -> ShowS)
-> Show UpdateRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateRsp -> ShowS
showsPrec :: Int -> UpdateRsp -> ShowS
$cshow :: UpdateRsp -> String
show :: UpdateRsp -> String
$cshowList :: [UpdateRsp] -> ShowS
showList :: [UpdateRsp] -> ShowS
Show)

$(deriveFromJSON (jsonOpts "updateRsp") ''UpdateRsp)