{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}

----------------------------------------------------------------------
-- |
-- Module: Web.Slack.Channel
-- Description: Types and functions related to <https://api.slack.com/docs/conversations-api Conversation API>
--
--
--
----------------------------------------------------------------------

module Web.Slack.Conversation
  ( Conversation(..)
  , ConversationId(..)
  , ConversationType(..)
  , ChannelConversation(..)
  , GroupConversation(..)
  , ImConversation(..)
  , TeamId(..)
  , Purpose(..)
  , Topic(..)
  , ListReq(..)
  , mkListReq
  , ListRsp(..)
  , HistoryReq (..)
  , mkHistoryReq
  , HistoryRsp (..)
  , RepliesReq (..)
  , mkRepliesReq
  , ResponseMetadata (..)
  ) where

-- aeson
import Data.Aeson
import Data.Aeson.Encoding
import Data.Aeson.TH
import Data.Aeson.Types

-- unordered-containers
import qualified Data.HashMap.Strict as HM

-- base
import Control.Applicative (empty, (<|>))
import GHC.Generics (Generic)

-- deepseq
import Control.DeepSeq (NFData)

-- http-api-data
import Web.FormUrlEncoded
import Web.HttpApiData

-- slack-web
import Web.Slack.Common
import Web.Slack.Util

-- scientific
import Data.Scientific

-- text
import Data.Text (Text)
import qualified Data.Text as T


-- |
--
--
data Topic =
  Topic
    { Topic -> Text
topicValue :: Text
    , Topic -> Text
topicCreator :: Text
    , Topic -> Integer
topicLastSet :: Integer
    }
  deriving (Topic -> Topic -> Bool
(Topic -> Topic -> Bool) -> (Topic -> Topic -> Bool) -> Eq Topic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Topic -> Topic -> Bool
$c/= :: Topic -> Topic -> Bool
== :: Topic -> Topic -> Bool
$c== :: Topic -> Topic -> Bool
Eq, Int -> Topic -> ShowS
[Topic] -> ShowS
Topic -> String
(Int -> Topic -> ShowS)
-> (Topic -> String) -> ([Topic] -> ShowS) -> Show Topic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Topic] -> ShowS
$cshowList :: [Topic] -> ShowS
show :: Topic -> String
$cshow :: Topic -> String
showsPrec :: Int -> Topic -> ShowS
$cshowsPrec :: Int -> Topic -> ShowS
Show, (forall x. Topic -> Rep Topic x)
-> (forall x. Rep Topic x -> Topic) -> Generic Topic
forall x. Rep Topic x -> Topic
forall x. Topic -> Rep Topic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Topic x -> Topic
$cfrom :: forall x. Topic -> Rep Topic x
Generic)

instance NFData Topic

$(deriveJSON (jsonOpts "topic") ''Topic)


-- |
--
--
data Purpose =
  Purpose
    { Purpose -> Text
purposeValue :: Text
    , Purpose -> Text
purposeCreator :: Text
    , Purpose -> Integer
purposeLastSet :: Integer
    }
  deriving (Purpose -> Purpose -> Bool
(Purpose -> Purpose -> Bool)
-> (Purpose -> Purpose -> Bool) -> Eq Purpose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Purpose -> Purpose -> Bool
$c/= :: Purpose -> Purpose -> Bool
== :: Purpose -> Purpose -> Bool
$c== :: Purpose -> Purpose -> Bool
Eq, Int -> Purpose -> ShowS
[Purpose] -> ShowS
Purpose -> String
(Int -> Purpose -> ShowS)
-> (Purpose -> String) -> ([Purpose] -> ShowS) -> Show Purpose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Purpose] -> ShowS
$cshowList :: [Purpose] -> ShowS
show :: Purpose -> String
$cshow :: Purpose -> String
showsPrec :: Int -> Purpose -> ShowS
$cshowsPrec :: Int -> Purpose -> ShowS
Show, (forall x. Purpose -> Rep Purpose x)
-> (forall x. Rep Purpose x -> Purpose) -> Generic Purpose
forall x. Rep Purpose x -> Purpose
forall x. Purpose -> Rep Purpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Purpose x -> Purpose
$cfrom :: forall x. Purpose -> Rep Purpose x
Generic)

instance NFData Purpose

$(deriveJSON (jsonOpts "purpose") ''Purpose)


-- | Conversation object representing a public channel,
--   which any people in the team can join in and see.
data ChannelConversation =
  ChannelConversation
    { ChannelConversation -> ConversationId
channelId :: ConversationId
    , ChannelConversation -> Text
channelName :: Text
    , ChannelConversation -> Integer
channelCreated :: Integer
    , ChannelConversation -> Bool
channelIsArchived :: Bool
    , ChannelConversation -> Bool
channelIsGeneral :: Bool
    , ChannelConversation -> Integer
channelUnlinked :: Integer
    , ChannelConversation -> Text
channelNameNormalized :: Text
    , ChannelConversation -> Bool
channelIsShared :: Bool

    -- FIXME:
    -- I'm not sure the correct type of this field, because I only found
    -- example responses whose @parent_conversation@ is @null@
    -- , channelParentConversation: null
    , ChannelConversation -> UserId
channelCreator :: UserId
    , ChannelConversation -> Bool
channelIsExtShared :: Bool
    , ChannelConversation -> Bool
channelIsOrgShared :: Bool
    , ChannelConversation -> [TeamId]
channelSharedTeamIds :: [TeamId]

    -- FIXME:
    -- I'm not sure the correct type of these fields, because I only found
    -- example responses whose @pending_connected_team_ids@ and
    -- @pending_shared@ are empty arrays. (Perhaps this is because
    -- my team is a free account. The names make me guess its type is
    -- @[TeamId]@, but these were not documented as long as I looked up.
    -- , channelPendingShared :: [TeamId]
    -- , channelPendingConnectedTeamIds :: [TeamId]

    , ChannelConversation -> Bool
channelIsPendingExtShared :: Bool
    , ChannelConversation -> Bool
channelIsMember :: Bool
    , ChannelConversation -> Topic
channelTopic :: Topic
    , ChannelConversation -> Purpose
channelPurpose :: Purpose
    , ChannelConversation -> [Text]
channelPreviousNames :: [Text]
    , ChannelConversation -> Integer
channelNumMembers :: Integer
    }
  deriving (ChannelConversation -> ChannelConversation -> Bool
(ChannelConversation -> ChannelConversation -> Bool)
-> (ChannelConversation -> ChannelConversation -> Bool)
-> Eq ChannelConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelConversation -> ChannelConversation -> Bool
$c/= :: ChannelConversation -> ChannelConversation -> Bool
== :: ChannelConversation -> ChannelConversation -> Bool
$c== :: ChannelConversation -> ChannelConversation -> Bool
Eq, Int -> ChannelConversation -> ShowS
[ChannelConversation] -> ShowS
ChannelConversation -> String
(Int -> ChannelConversation -> ShowS)
-> (ChannelConversation -> String)
-> ([ChannelConversation] -> ShowS)
-> Show ChannelConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelConversation] -> ShowS
$cshowList :: [ChannelConversation] -> ShowS
show :: ChannelConversation -> String
$cshow :: ChannelConversation -> String
showsPrec :: Int -> ChannelConversation -> ShowS
$cshowsPrec :: Int -> ChannelConversation -> ShowS
Show, (forall x. ChannelConversation -> Rep ChannelConversation x)
-> (forall x. Rep ChannelConversation x -> ChannelConversation)
-> Generic ChannelConversation
forall x. Rep ChannelConversation x -> ChannelConversation
forall x. ChannelConversation -> Rep ChannelConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelConversation x -> ChannelConversation
$cfrom :: forall x. ChannelConversation -> Rep ChannelConversation x
Generic)

instance NFData ChannelConversation

$(deriveJSON (jsonOpts "channel") ''ChannelConversation)


-- | Conversation object representing a private channel or
--   _a multi-party instant message (mpim)*, which only invited people in the
--  team can join in and see.
data GroupConversation =
  GroupConversation
    { GroupConversation -> ConversationId
groupId :: ConversationId
    , GroupConversation -> Text
groupName :: Text
    , GroupConversation -> Integer
groupCreated :: Integer
    , GroupConversation -> Bool
groupIsArchived :: Bool
    , GroupConversation -> Bool
groupIsGeneral :: Bool
    , GroupConversation -> Integer
groupUnlinked :: Integer
    , GroupConversation -> Text
groupNameNormalized :: Text
    , GroupConversation -> Bool
groupIsShared :: Bool

    -- FIXME:
    -- I'm not sure the correct type of this field, because I only found
    -- example responses whose @parent_conversation@ is @null@
    -- , groupParentConversation :: null

    , GroupConversation -> UserId
groupCreator :: UserId
    , GroupConversation -> Bool
groupIsExtShared :: Bool
    , GroupConversation -> Bool
groupIsOrgShared :: Bool
    , GroupConversation -> [TeamId]
groupSharedTeamIds :: [TeamId]

    -- FIXME:
    -- I'm not sure the correct type of these fields, because I only found
    -- example responses whose @pending_connected_team_ids@ and
    -- @pending_shared@ are empty arrays. (Perhaps this is because
    -- my team is a free account. The names make me guess its type is
    -- @[TeamId]@, but these were not documented as long as I looked up.
    -- , group_pending_shared :: []
    -- , group_pending_connected_team_ids :: []

    , GroupConversation -> Bool
groupIsPendingExtShared :: Bool
    , GroupConversation -> Bool
groupIsMember :: Bool
    , GroupConversation -> Bool
groupIsPrivate :: Bool
    , GroupConversation -> Bool
groupIsMpim :: Bool
    , GroupConversation -> SlackTimestamp
groupLastRead :: SlackTimestamp
    , GroupConversation -> Bool
groupIsOpen :: Bool
    , GroupConversation -> Topic
groupTopic :: Topic
    , GroupConversation -> Purpose
groupPurpose :: Purpose
    , GroupConversation -> Scientific
groupPriority :: Scientific
    }
  deriving (GroupConversation -> GroupConversation -> Bool
(GroupConversation -> GroupConversation -> Bool)
-> (GroupConversation -> GroupConversation -> Bool)
-> Eq GroupConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupConversation -> GroupConversation -> Bool
$c/= :: GroupConversation -> GroupConversation -> Bool
== :: GroupConversation -> GroupConversation -> Bool
$c== :: GroupConversation -> GroupConversation -> Bool
Eq, Int -> GroupConversation -> ShowS
[GroupConversation] -> ShowS
GroupConversation -> String
(Int -> GroupConversation -> ShowS)
-> (GroupConversation -> String)
-> ([GroupConversation] -> ShowS)
-> Show GroupConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupConversation] -> ShowS
$cshowList :: [GroupConversation] -> ShowS
show :: GroupConversation -> String
$cshow :: GroupConversation -> String
showsPrec :: Int -> GroupConversation -> ShowS
$cshowsPrec :: Int -> GroupConversation -> ShowS
Show, (forall x. GroupConversation -> Rep GroupConversation x)
-> (forall x. Rep GroupConversation x -> GroupConversation)
-> Generic GroupConversation
forall x. Rep GroupConversation x -> GroupConversation
forall x. GroupConversation -> Rep GroupConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupConversation x -> GroupConversation
$cfrom :: forall x. GroupConversation -> Rep GroupConversation x
Generic)

instance NFData GroupConversation

$(deriveJSON (jsonOpts "group") ''GroupConversation)


-- | Conversation object representing a (single-party) instance message,
--   where only two people talk.
data ImConversation =
  ImConversation
    { ImConversation -> ConversationId
imId :: ConversationId
    , ImConversation -> Integer
imCreated :: Integer
    , ImConversation -> Bool
imIsArchived :: Bool
    , ImConversation -> Bool
imIsOrgShared :: Bool
    , ImConversation -> UserId
imUser :: UserId
    , ImConversation -> Bool
imIsUserDeleted :: Bool
    , ImConversation -> Scientific
imPriority :: Scientific
    }
  deriving (ImConversation -> ImConversation -> Bool
(ImConversation -> ImConversation -> Bool)
-> (ImConversation -> ImConversation -> Bool) -> Eq ImConversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImConversation -> ImConversation -> Bool
$c/= :: ImConversation -> ImConversation -> Bool
== :: ImConversation -> ImConversation -> Bool
$c== :: ImConversation -> ImConversation -> Bool
Eq, Int -> ImConversation -> ShowS
[ImConversation] -> ShowS
ImConversation -> String
(Int -> ImConversation -> ShowS)
-> (ImConversation -> String)
-> ([ImConversation] -> ShowS)
-> Show ImConversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImConversation] -> ShowS
$cshowList :: [ImConversation] -> ShowS
show :: ImConversation -> String
$cshow :: ImConversation -> String
showsPrec :: Int -> ImConversation -> ShowS
$cshowsPrec :: Int -> ImConversation -> ShowS
Show, (forall x. ImConversation -> Rep ImConversation x)
-> (forall x. Rep ImConversation x -> ImConversation)
-> Generic ImConversation
forall x. Rep ImConversation x -> ImConversation
forall x. ImConversation -> Rep ImConversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImConversation x -> ImConversation
$cfrom :: forall x. ImConversation -> Rep ImConversation x
Generic)

instance NFData ImConversation

$(deriveJSON (jsonOpts "im") ''ImConversation)


-- | Ref. https://api.slack.com/types/conversation
--
--
data Conversation =
      Channel ChannelConversation
    | Group GroupConversation
    | Im ImConversation
  deriving (Conversation -> Conversation -> Bool
(Conversation -> Conversation -> Bool)
-> (Conversation -> Conversation -> Bool) -> Eq Conversation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conversation -> Conversation -> Bool
$c/= :: Conversation -> Conversation -> Bool
== :: Conversation -> Conversation -> Bool
$c== :: Conversation -> Conversation -> Bool
Eq, Int -> Conversation -> ShowS
[Conversation] -> ShowS
Conversation -> String
(Int -> Conversation -> ShowS)
-> (Conversation -> String)
-> ([Conversation] -> ShowS)
-> Show Conversation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conversation] -> ShowS
$cshowList :: [Conversation] -> ShowS
show :: Conversation -> String
$cshow :: Conversation -> String
showsPrec :: Int -> Conversation -> ShowS
$cshowsPrec :: Int -> Conversation -> ShowS
Show, (forall x. Conversation -> Rep Conversation x)
-> (forall x. Rep Conversation x -> Conversation)
-> Generic Conversation
forall x. Rep Conversation x -> Conversation
forall x. Conversation -> Rep Conversation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Conversation x -> Conversation
$cfrom :: forall x. Conversation -> Rep Conversation x
Generic)

instance NFData Conversation


instance FromJSON Conversation where
  parseJSON :: Value -> Parser Conversation
parseJSON = String
-> (Object -> Parser Conversation) -> Value -> Parser Conversation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Conversation" ((Object -> Parser Conversation) -> Value -> Parser Conversation)
-> (Object -> Parser Conversation) -> Value -> Parser Conversation
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> (ChannelConversation -> Conversation)
-> Object
-> Parser Conversation
forall a b. FromJSON a => Text -> (a -> b) -> Object -> Parser b
parseWhen Text
"is_channel" ChannelConversation -> Conversation
Channel Object
o
      Parser Conversation -> Parser Conversation -> Parser Conversation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
-> (GroupConversation -> Conversation)
-> Object
-> Parser Conversation
forall a b. FromJSON a => Text -> (a -> b) -> Object -> Parser b
parseWhen Text
"is_group" GroupConversation -> Conversation
Group Object
o
      Parser Conversation -> Parser Conversation -> Parser Conversation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
-> (ImConversation -> Conversation)
-> Object
-> Parser Conversation
forall a b. FromJSON a => Text -> (a -> b) -> Object -> Parser b
parseWhen Text
"is_im" ImConversation -> Conversation
Im Object
o
      Parser Conversation -> Parser Conversation -> Parser Conversation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Conversation -> Parser Conversation
forall a. String -> Parser a -> Parser a
prependFailure
            String
"parsing a Conversation failed: neither channel, group, nor im, "
            (String -> Value -> Parser Conversation
forall a. String -> Value -> Parser a
typeMismatch String
"Conversation" (Object -> Value
Object Object
o))
   where
    parseWhen :: Text -> (a -> b) -> Object -> Parser b
parseWhen Text
key a -> b
con Object
o = do
      Bool
is <- (Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
key) Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Bool
forall (f :: * -> *) a. Alternative f => f a
empty
      if Bool
is
        then a -> b
con (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        else Parser b
forall (f :: * -> *) a. Alternative f => f a
empty


instance ToJSON Conversation where
  toJSON :: Conversation -> Value
toJSON (Channel ChannelConversation
channel) =
    let (Object Object
obj) = ChannelConversation -> Value
forall a. ToJSON a => a -> Value
toJSON ChannelConversation
channel
     in Object -> Value
Object
          (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_channel" (Bool -> Value
Bool Bool
True)
          (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_group" (Bool -> Value
Bool Bool
False)
          (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_im" (Bool -> Value
Bool Bool
False) Object
obj
  toJSON (Group GroupConversation
group) =
    let (Object Object
obj) = GroupConversation -> Value
forall a. ToJSON a => a -> Value
toJSON GroupConversation
group
     in Object -> Value
Object
          (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_channel" (Bool -> Value
Bool Bool
False)
          (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_group" (Bool -> Value
Bool Bool
True)
          (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_im" (Bool -> Value
Bool Bool
False) Object
obj
  toJSON (Im ImConversation
im) =
    let (Object Object
obj) = ImConversation -> Value
forall a. ToJSON a => a -> Value
toJSON ImConversation
im
     in Object -> Value
Object
          (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_channel" (Bool -> Value
Bool Bool
False)
          (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_group" (Bool -> Value
Bool Bool
False)
          (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"is_im" (Bool -> Value
Bool Bool
True) Object
obj


data ConversationType =
    PublicChannelType
  | PrivateChannelType
  | MpimType
  | ImType
  deriving (ConversationType -> ConversationType -> Bool
(ConversationType -> ConversationType -> Bool)
-> (ConversationType -> ConversationType -> Bool)
-> Eq ConversationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConversationType -> ConversationType -> Bool
$c/= :: ConversationType -> ConversationType -> Bool
== :: ConversationType -> ConversationType -> Bool
$c== :: ConversationType -> ConversationType -> Bool
Eq, Int -> ConversationType -> ShowS
[ConversationType] -> ShowS
ConversationType -> String
(Int -> ConversationType -> ShowS)
-> (ConversationType -> String)
-> ([ConversationType] -> ShowS)
-> Show ConversationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversationType] -> ShowS
$cshowList :: [ConversationType] -> ShowS
show :: ConversationType -> String
$cshow :: ConversationType -> String
showsPrec :: Int -> ConversationType -> ShowS
$cshowsPrec :: Int -> ConversationType -> ShowS
Show, (forall x. ConversationType -> Rep ConversationType x)
-> (forall x. Rep ConversationType x -> ConversationType)
-> Generic ConversationType
forall x. Rep ConversationType x -> ConversationType
forall x. ConversationType -> Rep ConversationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConversationType x -> ConversationType
$cfrom :: forall x. ConversationType -> Rep ConversationType x
Generic)

instance NFData ConversationType

instance ToHttpApiData ConversationType where
  toUrlPiece :: ConversationType -> Text
toUrlPiece ConversationType
PublicChannelType = Text
"public_channel"
  toUrlPiece ConversationType
PrivateChannelType = Text
"private_channel"
  toUrlPiece ConversationType
MpimType = Text
"mpim"
  toUrlPiece ConversationType
ImType = Text
"im"

instance ToJSON ConversationType where
  toJSON :: ConversationType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (ConversationType -> Text) -> ConversationType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationType -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece
  toEncoding :: ConversationType -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding)
-> (ConversationType -> Text) -> ConversationType -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationType -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece

instance FromJSON ConversationType where
  parseJSON :: Value -> Parser ConversationType
parseJSON = String
-> (Text -> Parser ConversationType)
-> Value
-> Parser ConversationType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ConversationType" ((Text -> Parser ConversationType)
 -> Value -> Parser ConversationType)
-> (Text -> Parser ConversationType)
-> Value
-> Parser ConversationType
forall a b. (a -> b) -> a -> b
$ \case
    Text
"public_channel" -> ConversationType -> Parser ConversationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversationType
PublicChannelType
    Text
"private_channel" -> ConversationType -> Parser ConversationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversationType
PrivateChannelType
    Text
"mpim" -> ConversationType -> Parser ConversationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversationType
MpimType
    Text
"im" -> ConversationType -> Parser ConversationType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversationType
ImType
    Text
actual ->
      String -> Parser ConversationType -> Parser ConversationType
forall a. String -> Parser a -> Parser a
prependFailure String
"must be either \"public_channel\", \"private_channel\", \"mpim\" or \"im\"!"
        (Parser ConversationType -> Parser ConversationType)
-> (Value -> Parser ConversationType)
-> Value
-> Parser ConversationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Parser ConversationType
forall a. String -> Value -> Parser a
typeMismatch String
"ConversationType" (Value -> Parser ConversationType)
-> Value -> Parser ConversationType
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
actual



data ListReq =
  ListReq
    { ListReq -> Maybe Bool
listReqExcludeArchived :: Maybe Bool
    , ListReq -> [ConversationType]
listReqTypes :: [ConversationType]
    }
  deriving (ListReq -> ListReq -> Bool
(ListReq -> ListReq -> Bool)
-> (ListReq -> ListReq -> Bool) -> Eq ListReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListReq -> ListReq -> Bool
$c/= :: ListReq -> ListReq -> Bool
== :: ListReq -> ListReq -> Bool
$c== :: ListReq -> ListReq -> Bool
Eq, Int -> ListReq -> ShowS
[ListReq] -> ShowS
ListReq -> String
(Int -> ListReq -> ShowS)
-> (ListReq -> String) -> ([ListReq] -> ShowS) -> Show ListReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListReq] -> ShowS
$cshowList :: [ListReq] -> ShowS
show :: ListReq -> String
$cshow :: ListReq -> String
showsPrec :: Int -> ListReq -> ShowS
$cshowsPrec :: Int -> ListReq -> ShowS
Show, (forall x. ListReq -> Rep ListReq x)
-> (forall x. Rep ListReq x -> ListReq) -> Generic ListReq
forall x. Rep ListReq x -> ListReq
forall x. ListReq -> Rep ListReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListReq x -> ListReq
$cfrom :: forall x. ListReq -> Rep ListReq x
Generic)

instance NFData ListReq


-- |
--
--

$(deriveJSON (jsonOpts "listReq") ''ListReq)

-- |
--
--

mkListReq
  :: ListReq
mkListReq :: ListReq
mkListReq =
  ListReq :: Maybe Bool -> [ConversationType] -> ListReq
ListReq
    { listReqExcludeArchived :: Maybe Bool
listReqExcludeArchived = Maybe Bool
forall a. Maybe a
Nothing
    , listReqTypes :: [ConversationType]
listReqTypes = []
    }


-- |
--
--

instance ToForm ListReq where
  toForm :: ListReq -> Form
toForm (ListReq Maybe Bool
archived [ConversationType]
types) =
    Form
archivedForm Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Form
typesForm
   where
    archivedForm :: Form
archivedForm =
      Form -> (Bool -> Form) -> Maybe Bool -> Form
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Form
forall a. Monoid a => a
mempty (\Bool
val -> [(Text
"archived", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Bool
val)]) Maybe Bool
archived
    typesForm :: Form
typesForm =
      if [ConversationType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConversationType]
types
        then Form
forall a. Monoid a => a
mempty
        else [(Text
"types", Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ConversationType -> Text) -> [ConversationType] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ConversationType -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [ConversationType]
types)]


-- |
--

newtype ListRsp =
  ListRsp
    { ListRsp -> [Conversation]
listRspChannels :: [Conversation]
    }
  deriving (ListRsp -> ListRsp -> Bool
(ListRsp -> ListRsp -> Bool)
-> (ListRsp -> ListRsp -> Bool) -> Eq ListRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListRsp -> ListRsp -> Bool
$c/= :: ListRsp -> ListRsp -> Bool
== :: ListRsp -> ListRsp -> Bool
$c== :: ListRsp -> ListRsp -> Bool
Eq, Int -> ListRsp -> ShowS
[ListRsp] -> ShowS
ListRsp -> String
(Int -> ListRsp -> ShowS)
-> (ListRsp -> String) -> ([ListRsp] -> ShowS) -> Show ListRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListRsp] -> ShowS
$cshowList :: [ListRsp] -> ShowS
show :: ListRsp -> String
$cshow :: ListRsp -> String
showsPrec :: Int -> ListRsp -> ShowS
$cshowsPrec :: Int -> ListRsp -> ShowS
Show, (forall x. ListRsp -> Rep ListRsp x)
-> (forall x. Rep ListRsp x -> ListRsp) -> Generic ListRsp
forall x. Rep ListRsp x -> ListRsp
forall x. ListRsp -> Rep ListRsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListRsp x -> ListRsp
$cfrom :: forall x. ListRsp -> Rep ListRsp x
Generic)

instance NFData ListRsp

$(deriveFromJSON (jsonOpts "listRsp") ''ListRsp)

-- |
--
--

data HistoryReq =
  HistoryReq
    { HistoryReq -> ConversationId
historyReqChannel :: ConversationId
    , HistoryReq -> Maybe Cursor
historyReqCursor :: Maybe Cursor
    , HistoryReq -> Int
historyReqCount :: Int
    , HistoryReq -> Maybe SlackTimestamp
historyReqLatest :: Maybe SlackTimestamp
    , HistoryReq -> Maybe SlackTimestamp
historyReqOldest :: Maybe SlackTimestamp
    , HistoryReq -> Bool
historyReqInclusive :: Bool
    }
  deriving (HistoryReq -> HistoryReq -> Bool
(HistoryReq -> HistoryReq -> Bool)
-> (HistoryReq -> HistoryReq -> Bool) -> Eq HistoryReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryReq -> HistoryReq -> Bool
$c/= :: HistoryReq -> HistoryReq -> Bool
== :: HistoryReq -> HistoryReq -> Bool
$c== :: HistoryReq -> HistoryReq -> Bool
Eq, Int -> HistoryReq -> ShowS
[HistoryReq] -> ShowS
HistoryReq -> String
(Int -> HistoryReq -> ShowS)
-> (HistoryReq -> String)
-> ([HistoryReq] -> ShowS)
-> Show HistoryReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryReq] -> ShowS
$cshowList :: [HistoryReq] -> ShowS
show :: HistoryReq -> String
$cshow :: HistoryReq -> String
showsPrec :: Int -> HistoryReq -> ShowS
$cshowsPrec :: Int -> HistoryReq -> ShowS
Show, (forall x. HistoryReq -> Rep HistoryReq x)
-> (forall x. Rep HistoryReq x -> HistoryReq) -> Generic HistoryReq
forall x. Rep HistoryReq x -> HistoryReq
forall x. HistoryReq -> Rep HistoryReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryReq x -> HistoryReq
$cfrom :: forall x. HistoryReq -> Rep HistoryReq x
Generic)

instance NFData HistoryReq

-- |
--
--

$(deriveJSON (jsonOpts "historyReq") ''HistoryReq)


-- |
--
--

mkHistoryReq
  :: ConversationId
  -> HistoryReq
mkHistoryReq :: ConversationId -> HistoryReq
mkHistoryReq ConversationId
channel =
  HistoryReq :: ConversationId
-> Maybe Cursor
-> Int
-> Maybe SlackTimestamp
-> Maybe SlackTimestamp
-> Bool
-> HistoryReq
HistoryReq
    { historyReqChannel :: ConversationId
historyReqChannel = ConversationId
channel
    , historyReqCursor :: Maybe Cursor
historyReqCursor = Maybe Cursor
forall a. Maybe a
Nothing
    , historyReqCount :: Int
historyReqCount = Int
100
    , historyReqLatest :: Maybe SlackTimestamp
historyReqLatest = Maybe SlackTimestamp
forall a. Maybe a
Nothing
    , historyReqOldest :: Maybe SlackTimestamp
historyReqOldest = Maybe SlackTimestamp
forall a. Maybe a
Nothing
    , historyReqInclusive :: Bool
historyReqInclusive = Bool
True
    }

-- |
--
--

instance ToForm HistoryReq where
  -- can't use genericToForm because slack expects booleans as 0/1
  toForm :: HistoryReq -> Form
toForm HistoryReq{Bool
Int
Maybe SlackTimestamp
Maybe Cursor
ConversationId
historyReqInclusive :: Bool
historyReqOldest :: Maybe SlackTimestamp
historyReqLatest :: Maybe SlackTimestamp
historyReqCount :: Int
historyReqCursor :: Maybe Cursor
historyReqChannel :: ConversationId
historyReqInclusive :: HistoryReq -> Bool
historyReqOldest :: HistoryReq -> Maybe SlackTimestamp
historyReqLatest :: HistoryReq -> Maybe SlackTimestamp
historyReqCount :: HistoryReq -> Int
historyReqCursor :: HistoryReq -> Maybe Cursor
historyReqChannel :: HistoryReq -> ConversationId
..} =
    [(Text
"channel", ConversationId -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ConversationId
historyReqChannel)]
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Cursor -> Form
forall a. ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust Text
"cursor" Maybe Cursor
historyReqCursor
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(Text
"count", Int -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Int
historyReqCount)]
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe SlackTimestamp -> Form
forall a. ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust Text
"latest" Maybe SlackTimestamp
historyReqLatest
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe SlackTimestamp -> Form
forall a. ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust Text
"oldest" Maybe SlackTimestamp
historyReqOldest
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(Text
"inclusive", Int -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (if Bool
historyReqInclusive then Int
1 :: Int else Int
0))]


-- |
--
--
newtype ResponseMetadata = ResponseMetadata { ResponseMetadata -> Maybe Cursor
responseMetadataNextCursor :: Maybe Cursor }
  deriving (ResponseMetadata -> ResponseMetadata -> Bool
(ResponseMetadata -> ResponseMetadata -> Bool)
-> (ResponseMetadata -> ResponseMetadata -> Bool)
-> Eq ResponseMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseMetadata -> ResponseMetadata -> Bool
$c/= :: ResponseMetadata -> ResponseMetadata -> Bool
== :: ResponseMetadata -> ResponseMetadata -> Bool
$c== :: ResponseMetadata -> ResponseMetadata -> Bool
Eq, Int -> ResponseMetadata -> ShowS
[ResponseMetadata] -> ShowS
ResponseMetadata -> String
(Int -> ResponseMetadata -> ShowS)
-> (ResponseMetadata -> String)
-> ([ResponseMetadata] -> ShowS)
-> Show ResponseMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseMetadata] -> ShowS
$cshowList :: [ResponseMetadata] -> ShowS
show :: ResponseMetadata -> String
$cshow :: ResponseMetadata -> String
showsPrec :: Int -> ResponseMetadata -> ShowS
$cshowsPrec :: Int -> ResponseMetadata -> ShowS
Show, (forall x. ResponseMetadata -> Rep ResponseMetadata x)
-> (forall x. Rep ResponseMetadata x -> ResponseMetadata)
-> Generic ResponseMetadata
forall x. Rep ResponseMetadata x -> ResponseMetadata
forall x. ResponseMetadata -> Rep ResponseMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResponseMetadata x -> ResponseMetadata
$cfrom :: forall x. ResponseMetadata -> Rep ResponseMetadata x
Generic)

instance NFData ResponseMetadata

$(deriveJSON (jsonOpts "responseMetadata") ''ResponseMetadata)


-- |
--
--

data HistoryRsp =
  HistoryRsp
    { HistoryRsp -> [Message]
historyRspMessages :: [Message]
    , HistoryRsp -> Maybe ResponseMetadata
historyRspResponseMetadata :: Maybe ResponseMetadata
    }
  deriving (HistoryRsp -> HistoryRsp -> Bool
(HistoryRsp -> HistoryRsp -> Bool)
-> (HistoryRsp -> HistoryRsp -> Bool) -> Eq HistoryRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryRsp -> HistoryRsp -> Bool
$c/= :: HistoryRsp -> HistoryRsp -> Bool
== :: HistoryRsp -> HistoryRsp -> Bool
$c== :: HistoryRsp -> HistoryRsp -> Bool
Eq, Int -> HistoryRsp -> ShowS
[HistoryRsp] -> ShowS
HistoryRsp -> String
(Int -> HistoryRsp -> ShowS)
-> (HistoryRsp -> String)
-> ([HistoryRsp] -> ShowS)
-> Show HistoryRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryRsp] -> ShowS
$cshowList :: [HistoryRsp] -> ShowS
show :: HistoryRsp -> String
$cshow :: HistoryRsp -> String
showsPrec :: Int -> HistoryRsp -> ShowS
$cshowsPrec :: Int -> HistoryRsp -> ShowS
Show, (forall x. HistoryRsp -> Rep HistoryRsp x)
-> (forall x. Rep HistoryRsp x -> HistoryRsp) -> Generic HistoryRsp
forall x. Rep HistoryRsp x -> HistoryRsp
forall x. HistoryRsp -> Rep HistoryRsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryRsp x -> HistoryRsp
$cfrom :: forall x. HistoryRsp -> Rep HistoryRsp x
Generic)

instance NFData HistoryRsp

$(deriveJSON (jsonOpts "historyRsp") ''HistoryRsp)


data RepliesReq =
  RepliesReq
    { RepliesReq -> SlackTimestamp
repliesReqTs :: SlackTimestamp
    , RepliesReq -> Maybe Cursor
repliesReqCursor :: Maybe Cursor
    , RepliesReq -> ConversationId
repliesReqChannel :: ConversationId
    , RepliesReq -> Int
repliesReqLimit :: Int
    , RepliesReq -> Maybe SlackTimestamp
repliesReqLatest :: Maybe SlackTimestamp
    , RepliesReq -> Maybe SlackTimestamp
repliesReqOldest :: Maybe SlackTimestamp
    , RepliesReq -> Bool
repliesReqInclusive :: Bool
    }
  deriving (RepliesReq -> RepliesReq -> Bool
(RepliesReq -> RepliesReq -> Bool)
-> (RepliesReq -> RepliesReq -> Bool) -> Eq RepliesReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepliesReq -> RepliesReq -> Bool
$c/= :: RepliesReq -> RepliesReq -> Bool
== :: RepliesReq -> RepliesReq -> Bool
$c== :: RepliesReq -> RepliesReq -> Bool
Eq, Int -> RepliesReq -> ShowS
[RepliesReq] -> ShowS
RepliesReq -> String
(Int -> RepliesReq -> ShowS)
-> (RepliesReq -> String)
-> ([RepliesReq] -> ShowS)
-> Show RepliesReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepliesReq] -> ShowS
$cshowList :: [RepliesReq] -> ShowS
show :: RepliesReq -> String
$cshow :: RepliesReq -> String
showsPrec :: Int -> RepliesReq -> ShowS
$cshowsPrec :: Int -> RepliesReq -> ShowS
Show, (forall x. RepliesReq -> Rep RepliesReq x)
-> (forall x. Rep RepliesReq x -> RepliesReq) -> Generic RepliesReq
forall x. Rep RepliesReq x -> RepliesReq
forall x. RepliesReq -> Rep RepliesReq x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepliesReq x -> RepliesReq
$cfrom :: forall x. RepliesReq -> Rep RepliesReq x
Generic)

instance NFData RepliesReq

$(deriveJSON (jsonOpts "repliesReq") ''RepliesReq)

instance ToForm RepliesReq where
  -- can't use genericToForm because slack expects booleans as 0/1
  toForm :: RepliesReq -> Form
toForm RepliesReq {Bool
Int
Maybe SlackTimestamp
Maybe Cursor
SlackTimestamp
ConversationId
repliesReqInclusive :: Bool
repliesReqOldest :: Maybe SlackTimestamp
repliesReqLatest :: Maybe SlackTimestamp
repliesReqLimit :: Int
repliesReqChannel :: ConversationId
repliesReqCursor :: Maybe Cursor
repliesReqTs :: SlackTimestamp
repliesReqInclusive :: RepliesReq -> Bool
repliesReqOldest :: RepliesReq -> Maybe SlackTimestamp
repliesReqLatest :: RepliesReq -> Maybe SlackTimestamp
repliesReqLimit :: RepliesReq -> Int
repliesReqChannel :: RepliesReq -> ConversationId
repliesReqCursor :: RepliesReq -> Maybe Cursor
repliesReqTs :: RepliesReq -> SlackTimestamp
..} =
    [(Text
"channel", ConversationId -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ConversationId
repliesReqChannel)]
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(Text
"ts", SlackTimestamp -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam SlackTimestamp
repliesReqTs)]
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Cursor -> Form
forall a. ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust Text
"cursor" Maybe Cursor
repliesReqCursor
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(Text
"limit", Int -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam Int
repliesReqLimit)]
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe SlackTimestamp -> Form
forall a. ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust Text
"latest" Maybe SlackTimestamp
repliesReqLatest
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe SlackTimestamp -> Form
forall a. ToHttpApiData a => Text -> Maybe a -> Form
toQueryParamIfJust Text
"oldest" Maybe SlackTimestamp
repliesReqOldest
      Form -> Form -> Form
forall a. Semigroup a => a -> a -> a
<> [(Text
"inclusive", Int -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (if Bool
repliesReqInclusive then Int
1 :: Int else Int
0))]


-- |
--
--

mkRepliesReq
  :: ConversationId
  -> SlackTimestamp
  -> RepliesReq
mkRepliesReq :: ConversationId -> SlackTimestamp -> RepliesReq
mkRepliesReq ConversationId
channel SlackTimestamp
ts =
  RepliesReq :: SlackTimestamp
-> Maybe Cursor
-> ConversationId
-> Int
-> Maybe SlackTimestamp
-> Maybe SlackTimestamp
-> Bool
-> RepliesReq
RepliesReq
    { repliesReqChannel :: ConversationId
repliesReqChannel = ConversationId
channel
    , repliesReqCursor :: Maybe Cursor
repliesReqCursor = Maybe Cursor
forall a. Maybe a
Nothing
    , repliesReqTs :: SlackTimestamp
repliesReqTs = SlackTimestamp
ts
    , repliesReqLimit :: Int
repliesReqLimit = Int
100
    , repliesReqLatest :: Maybe SlackTimestamp
repliesReqLatest = Maybe SlackTimestamp
forall a. Maybe a
Nothing
    , repliesReqOldest :: Maybe SlackTimestamp
repliesReqOldest = Maybe SlackTimestamp
forall a. Maybe a
Nothing
    , repliesReqInclusive :: Bool
repliesReqInclusive = Bool
True
    }