{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostMsg -> PostMsg -> Bool
$c/= :: PostMsg -> PostMsg -> Bool
== :: PostMsg -> PostMsg -> Bool
$c== :: PostMsg -> PostMsg -> Bool
Eq, 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
$cto :: forall x. Rep PostMsg x -> PostMsg
$cfrom :: forall x. PostMsg -> Rep PostMsg x
Generic, Int -> PostMsg -> ShowS
[PostMsg] -> ShowS
PostMsg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostMsg] -> ShowS
$cshowList :: [PostMsg] -> ShowS
show :: PostMsg -> String
$cshow :: PostMsg -> String
showsPrec :: Int -> PostMsg -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostMsgReq -> PostMsgReq -> Bool
$c/= :: PostMsgReq -> PostMsgReq -> Bool
== :: PostMsgReq -> PostMsgReq -> Bool
$c== :: PostMsgReq -> PostMsgReq -> Bool
Eq, 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
$cto :: forall x. Rep PostMsgReq x -> PostMsgReq
$cfrom :: forall x. PostMsgReq -> Rep PostMsgReq x
Generic, Int -> PostMsgReq -> ShowS
[PostMsgReq] -> ShowS
PostMsgReq -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostMsgReq] -> ShowS
$cshowList :: [PostMsgReq] -> ShowS
show :: PostMsgReq -> String
$cshow :: PostMsgReq -> String
showsPrec :: Int -> PostMsgReq -> ShowS
$cshowsPrec :: Int -> PostMsgReq -> ShowS
Show)

instance NFData PostMsgReq

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

instance ToForm PostMsgReq where
  toForm :: PostMsgReq -> Form
toForm =
    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 = forall a. a -> Maybe a
Just Text
text
    , postMsgReqParse :: Maybe Text
postMsgReqParse = forall a. Maybe a
Nothing
    , postMsgReqLinkNames :: Maybe Bool
postMsgReqLinkNames = forall a. Maybe a
Nothing
    , postMsgReqAttachments :: Maybe Text
postMsgReqAttachments = forall a. Maybe a
Nothing
    , postMsgReqBlocks :: Maybe Text
postMsgReqBlocks = forall a. Maybe a
Nothing
    , postMsgReqUnfurlLinks :: Maybe Bool
postMsgReqUnfurlLinks = forall a. Maybe a
Nothing
    , postMsgReqUnfurlMedia :: Maybe Bool
postMsgReqUnfurlMedia = forall a. Maybe a
Nothing
    , postMsgReqUsername :: Maybe Text
postMsgReqUsername = forall a. Maybe a
Nothing
    , postMsgReqAsUser :: Maybe Bool
postMsgReqAsUser = forall a. Maybe a
Nothing
    , postMsgReqIconUrl :: Maybe Text
postMsgReqIconUrl = forall a. Maybe a
Nothing
    , postMsgReqIconEmoji :: Maybe Text
postMsgReqIconEmoji = forall a. Maybe a
Nothing
    , postMsgReqThreadTs :: Maybe Text
postMsgReqThreadTs = forall a. Maybe a
Nothing
    , postMsgReqReplyBroadcast :: Maybe Bool
postMsgReqReplyBroadcast = forall a. Maybe a
Nothing
    }

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

instance ToForm UpdateReq where
  toForm :: UpdateReq -> Form
toForm = 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 = forall a. Maybe a
Nothing
    , updateReqAttachments :: Maybe Text
updateReqAttachments = forall a. Maybe a
Nothing
    , updateReqLinkNames :: Maybe Bool
updateReqLinkNames = forall a. Maybe a
Nothing
    , updateReqMetadata :: Maybe Text
updateReqMetadata = forall a. Maybe a
Nothing
    , updateReqParse :: Maybe Text
updateReqParse = forall a. Maybe a
Nothing
    , updateReqReplyBroadcast :: Maybe Bool
updateReqReplyBroadcast = forall a. Maybe a
Nothing
    , updateReqText :: Maybe Text
updateReqText = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRsp -> UpdateRsp -> Bool
$c/= :: UpdateRsp -> UpdateRsp -> Bool
== :: UpdateRsp -> UpdateRsp -> Bool
$c== :: UpdateRsp -> UpdateRsp -> Bool
Eq, 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
$cto :: forall x. Rep UpdateRsp x -> UpdateRsp
$cfrom :: forall x. UpdateRsp -> Rep UpdateRsp x
Generic, Int -> UpdateRsp -> ShowS
[UpdateRsp] -> ShowS
UpdateRsp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRsp] -> ShowS
$cshowList :: [UpdateRsp] -> ShowS
show :: UpdateRsp -> String
$cshow :: UpdateRsp -> String
showsPrec :: Int -> UpdateRsp -> ShowS
$cshowsPrec :: Int -> UpdateRsp -> ShowS
Show)

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