{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}
module Telegram.Bot.API.GettingUpdates where

import           Data.Aeson                      (FromJSON (..), ToJSON (..), Value)
import           Data.Foldable                   (asum)
import           Data.Proxy
import           GHC.Generics                    (Generic)

import           Servant.API
import           Servant.Client                  hiding (Response)

import           Telegram.Bot.API.Internal.Utils
import           Telegram.Bot.API.MakingRequests
import           Telegram.Bot.API.Types
import           Telegram.Bot.API.InlineMode
import Telegram.Bot.API.Internal.TH (makeDefault)

-- ** 'Update'

newtype UpdateId = UpdateId Int
  deriving (UpdateId -> UpdateId -> Bool
(UpdateId -> UpdateId -> Bool)
-> (UpdateId -> UpdateId -> Bool) -> Eq UpdateId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateId -> UpdateId -> Bool
== :: UpdateId -> UpdateId -> Bool
$c/= :: UpdateId -> UpdateId -> Bool
/= :: UpdateId -> UpdateId -> Bool
Eq, Eq UpdateId
Eq UpdateId =>
(UpdateId -> UpdateId -> Ordering)
-> (UpdateId -> UpdateId -> Bool)
-> (UpdateId -> UpdateId -> Bool)
-> (UpdateId -> UpdateId -> Bool)
-> (UpdateId -> UpdateId -> Bool)
-> (UpdateId -> UpdateId -> UpdateId)
-> (UpdateId -> UpdateId -> UpdateId)
-> Ord UpdateId
UpdateId -> UpdateId -> Bool
UpdateId -> UpdateId -> Ordering
UpdateId -> UpdateId -> UpdateId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UpdateId -> UpdateId -> Ordering
compare :: UpdateId -> UpdateId -> Ordering
$c< :: UpdateId -> UpdateId -> Bool
< :: UpdateId -> UpdateId -> Bool
$c<= :: UpdateId -> UpdateId -> Bool
<= :: UpdateId -> UpdateId -> Bool
$c> :: UpdateId -> UpdateId -> Bool
> :: UpdateId -> UpdateId -> Bool
$c>= :: UpdateId -> UpdateId -> Bool
>= :: UpdateId -> UpdateId -> Bool
$cmax :: UpdateId -> UpdateId -> UpdateId
max :: UpdateId -> UpdateId -> UpdateId
$cmin :: UpdateId -> UpdateId -> UpdateId
min :: UpdateId -> UpdateId -> UpdateId
Ord, Int -> UpdateId -> ShowS
[UpdateId] -> ShowS
UpdateId -> String
(Int -> UpdateId -> ShowS)
-> (UpdateId -> String) -> ([UpdateId] -> ShowS) -> Show UpdateId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateId -> ShowS
showsPrec :: Int -> UpdateId -> ShowS
$cshow :: UpdateId -> String
show :: UpdateId -> String
$cshowList :: [UpdateId] -> ShowS
showList :: [UpdateId] -> ShowS
Show, [UpdateId] -> Value
[UpdateId] -> Encoding
UpdateId -> Bool
UpdateId -> Value
UpdateId -> Encoding
(UpdateId -> Value)
-> (UpdateId -> Encoding)
-> ([UpdateId] -> Value)
-> ([UpdateId] -> Encoding)
-> (UpdateId -> Bool)
-> ToJSON UpdateId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UpdateId -> Value
toJSON :: UpdateId -> Value
$ctoEncoding :: UpdateId -> Encoding
toEncoding :: UpdateId -> Encoding
$ctoJSONList :: [UpdateId] -> Value
toJSONList :: [UpdateId] -> Value
$ctoEncodingList :: [UpdateId] -> Encoding
toEncodingList :: [UpdateId] -> Encoding
$comitField :: UpdateId -> Bool
omitField :: UpdateId -> Bool
ToJSON, Maybe UpdateId
Value -> Parser [UpdateId]
Value -> Parser UpdateId
(Value -> Parser UpdateId)
-> (Value -> Parser [UpdateId])
-> Maybe UpdateId
-> FromJSON UpdateId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UpdateId
parseJSON :: Value -> Parser UpdateId
$cparseJSONList :: Value -> Parser [UpdateId]
parseJSONList :: Value -> Parser [UpdateId]
$comittedField :: Maybe UpdateId
omittedField :: Maybe UpdateId
FromJSON)

-- | This object represents an incoming update.
-- At most __one__ of the optional parameters can be present in any given update.
data Update = Update
  { Update -> UpdateId
updateUpdateId          :: UpdateId -- ^ The update‘s unique identifier. Update identifiers start from a certain positive number and increase sequentially. This ID becomes especially handy if you’re using Webhooks, since it allows you to ignore repeated updates or to restore the correct update sequence, should they get out of order. If there are no new updates for at least a week, then identifier of the next update will be chosen randomly instead of sequentially.
  , Update -> Maybe Message
updateMessage           :: Maybe Message -- ^ New incoming message of any kind — text, photo, sticker, etc.
  , Update -> Maybe Message
updateEditedMessage     :: Maybe Message -- ^ New version of a message that is known to the bot and was edited
  , Update -> Maybe Message
updateChannelPost       :: Maybe Message -- ^ New incoming channel post of any kind — text, photo, sticker, etc.
  , Update -> Maybe Message
updateEditedChannelPost :: Maybe Message -- ^ New version of a channel post that is known to the bot and was edited.
  , Update -> Maybe BusinessConnection
updateBusinessConnection :: Maybe BusinessConnection -- ^ The bot was connected to or disconnected from a business account, or a user edited an existing connection with the bot.
  , Update -> Maybe Message
updateBusinessMessage :: Maybe Message -- ^ New message from a connected business account.
  , Update -> Maybe Message
updateEditedBusinessMessage :: Maybe Message -- ^ New version of a message from a connected business account.
  , Update -> Maybe BusinessMessagesDeleted
updateDeletedBusinessMessages :: Maybe BusinessMessagesDeleted -- ^ Messages were deleted from a connected business account.
  , Update -> Maybe MessageReactionUpdated
updateMessageReaction :: Maybe MessageReactionUpdated -- ^ A reaction to a message was changed by a user. The bot must be an administrator in the chat and must explicitly specify @message_reaction@ in the list of /allowed_updates/ to receive these updates. The update isn't received for reactions set by bots.
  , Update -> Maybe MessageReactionCountUpdated
updateMessageReactionCount :: Maybe MessageReactionCountUpdated -- ^ Reactions to a message with anonymous reactions were changed. The bot must be an administrator in the chat and must explicitly specify @message_reaction_count@ in the list of /allowed_updates/ to receive these updates. The updates are grouped and can be sent with delay up to a few minutes.
  , Update -> Maybe InlineQuery
updateInlineQuery       :: Maybe InlineQuery -- ^ New incoming inline query.
  , Update -> Maybe ChosenInlineResult
updateChosenInlineResult :: Maybe ChosenInlineResult -- ^ The result of an inline query that was chosen by a user and sent to their chat partner. Please see our documentation on the feedback collecting for details on how to enable these updates for your bot.
  , Update -> Maybe CallbackQuery
updateCallbackQuery     :: Maybe CallbackQuery -- ^ New incoming callback query.
  , Update -> Maybe ShippingQuery
updateShippingQuery     :: Maybe ShippingQuery -- ^ New incoming shipping query. Only for invoices with flexible price
  , Update -> Maybe PreCheckoutQuery
updatePreCheckoutQuery  :: Maybe PreCheckoutQuery -- ^ New incoming pre-checkout query. Contains full information about checkout
  , Update -> Maybe Poll
updatePoll              :: Maybe Poll -- ^ New poll state. Bots receive only updates about stopped polls and polls, which are sent by the bot.
  , Update -> Maybe PollAnswer
updatePollAnswer        :: Maybe PollAnswer -- ^ A user changed their answer in a non-anonymous poll. Bots receive new votes only in polls that were sent by the bot itself.
  , Update -> Maybe ChatMemberUpdated
updateMyChatMember      :: Maybe ChatMemberUpdated -- ^ The bot's chat member status was updated in a chat. For private chats, this update is received only when the bot is blocked or unblocked by the user.
  , Update -> Maybe ChatMemberUpdated
updateChatMember        :: Maybe ChatMemberUpdated -- ^ A chat member's status was updated in a chat. The bot must be an administrator in the chat and must explicitly specify “chat_member” in the list of allowed_updates to receive these updates.
  , Update -> Maybe ChatJoinRequest
updateChatJoinRequest   :: Maybe ChatJoinRequest -- ^ A request to join the chat has been sent. The bot must have the can_invite_users administrator right in the chat to receive these updates.
  , Update -> Maybe ChatBoostUpdated
updateChatBoost         :: Maybe ChatBoostUpdated -- ^ A chat boost was added or changed. The bot must be an administrator in the chat to receive these updates.
  , Update -> Maybe ChatBoostRemoved
updateRemovedChatBoost  :: Maybe ChatBoostRemoved -- ^ A boost was removed from a chat. The bot must be an administrator in the chat to receive these updates.
  } deriving ((forall x. Update -> Rep Update x)
-> (forall x. Rep Update x -> Update) -> Generic Update
forall x. Rep Update x -> Update
forall x. Update -> Rep Update x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Update -> Rep Update x
from :: forall x. Update -> Rep Update x
$cto :: forall x. Rep Update x -> Update
to :: forall x. Rep Update x -> Update
Generic, Int -> Update -> ShowS
[Update] -> ShowS
Update -> String
(Int -> Update -> ShowS)
-> (Update -> String) -> ([Update] -> ShowS) -> Show Update
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Update -> ShowS
showsPrec :: Int -> Update -> ShowS
$cshow :: Update -> String
show :: Update -> String
$cshowList :: [Update] -> ShowS
showList :: [Update] -> ShowS
Show)

instance ToJSON   Update where toJSON :: Update -> Value
toJSON = Update -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON Update where parseJSON :: Value -> Parser Update
parseJSON = Value -> Parser Update
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON

updateChatId :: Update -> Maybe ChatId
updateChatId :: Update -> Maybe ChatId
updateChatId = (Message -> ChatId) -> Maybe Message -> Maybe ChatId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chat -> ChatId
chatId (Chat -> ChatId) -> (Message -> Chat) -> Message -> ChatId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Chat
messageChat) (Maybe Message -> Maybe ChatId)
-> (Update -> Maybe Message) -> Update -> Maybe ChatId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update -> Maybe Message
extractUpdateMessage

extractUpdateMessage :: Update -> Maybe Message
extractUpdateMessage :: Update -> Maybe Message
extractUpdateMessage Update{Maybe BusinessMessagesDeleted
Maybe MessageReactionCountUpdated
Maybe ShippingQuery
Maybe PreCheckoutQuery
Maybe PollAnswer
Maybe MessageReactionUpdated
Maybe Poll
Maybe ChatMemberUpdated
Maybe ChatJoinRequest
Maybe ChatBoostRemoved
Maybe ChatBoostUpdated
Maybe BusinessConnection
Maybe Message
Maybe CallbackQuery
Maybe ChosenInlineResult
Maybe InlineQuery
UpdateId
updateUpdateId :: Update -> UpdateId
updateMessage :: Update -> Maybe Message
updateEditedMessage :: Update -> Maybe Message
updateChannelPost :: Update -> Maybe Message
updateEditedChannelPost :: Update -> Maybe Message
updateBusinessConnection :: Update -> Maybe BusinessConnection
updateBusinessMessage :: Update -> Maybe Message
updateEditedBusinessMessage :: Update -> Maybe Message
updateDeletedBusinessMessages :: Update -> Maybe BusinessMessagesDeleted
updateMessageReaction :: Update -> Maybe MessageReactionUpdated
updateMessageReactionCount :: Update -> Maybe MessageReactionCountUpdated
updateInlineQuery :: Update -> Maybe InlineQuery
updateChosenInlineResult :: Update -> Maybe ChosenInlineResult
updateCallbackQuery :: Update -> Maybe CallbackQuery
updateShippingQuery :: Update -> Maybe ShippingQuery
updatePreCheckoutQuery :: Update -> Maybe PreCheckoutQuery
updatePoll :: Update -> Maybe Poll
updatePollAnswer :: Update -> Maybe PollAnswer
updateMyChatMember :: Update -> Maybe ChatMemberUpdated
updateChatMember :: Update -> Maybe ChatMemberUpdated
updateChatJoinRequest :: Update -> Maybe ChatJoinRequest
updateChatBoost :: Update -> Maybe ChatBoostUpdated
updateRemovedChatBoost :: Update -> Maybe ChatBoostRemoved
updateUpdateId :: UpdateId
updateMessage :: Maybe Message
updateEditedMessage :: Maybe Message
updateChannelPost :: Maybe Message
updateEditedChannelPost :: Maybe Message
updateBusinessConnection :: Maybe BusinessConnection
updateBusinessMessage :: Maybe Message
updateEditedBusinessMessage :: Maybe Message
updateDeletedBusinessMessages :: Maybe BusinessMessagesDeleted
updateMessageReaction :: Maybe MessageReactionUpdated
updateMessageReactionCount :: Maybe MessageReactionCountUpdated
updateInlineQuery :: Maybe InlineQuery
updateChosenInlineResult :: Maybe ChosenInlineResult
updateCallbackQuery :: Maybe CallbackQuery
updateShippingQuery :: Maybe ShippingQuery
updatePreCheckoutQuery :: Maybe PreCheckoutQuery
updatePoll :: Maybe Poll
updatePollAnswer :: Maybe PollAnswer
updateMyChatMember :: Maybe ChatMemberUpdated
updateChatMember :: Maybe ChatMemberUpdated
updateChatJoinRequest :: Maybe ChatJoinRequest
updateChatBoost :: Maybe ChatBoostUpdated
updateRemovedChatBoost :: Maybe ChatBoostRemoved
..} = [Maybe Message] -> Maybe Message
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  [ Maybe Message
updateMessage
  , Maybe Message
updateEditedMessage
  , Maybe Message
updateChannelPost
  , Maybe Message
updateEditedChannelPost
  , Maybe CallbackQuery
updateCallbackQuery Maybe CallbackQuery
-> (CallbackQuery -> Maybe Message) -> Maybe Message
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CallbackQuery -> Maybe Message
callbackQueryMessage
  ]

-- ** 'getUpdates'

type GetUpdatesAs a
  = "getUpdates" :> ReqBody '[JSON] GetUpdatesRequest :> Get '[JSON] (Response [a])

type GetUpdates = GetUpdatesAs Update

-- | Use this method to receive incoming updates using long polling.
-- An list of 'Update' objects is returned.
--
-- NOTE: This method will not work if an outgoing webhook is set up.
--
-- NOTE: In order to avoid getting duplicate updates, recalculate offset after each server response.
getUpdates :: GetUpdatesRequest -> ClientM (Response [Update])
getUpdates :: GetUpdatesRequest -> ClientM (Response [Update])
getUpdates = Proxy GetUpdates -> Client ClientM GetUpdates
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @GetUpdates)

-- | More liberal version of `getUpdates` funcion.
--
-- It's useful  when you aren't sure that you can
-- parse all the types of updates, so you would recieve
-- a list of Value with updates, that you can parse later.
getUpdatesAsValue :: GetUpdatesRequest -> ClientM (Response [Value])
getUpdatesAsValue :: GetUpdatesRequest -> ClientM (Response [Value])
getUpdatesAsValue = Proxy (GetUpdatesAs Value) -> Client ClientM (GetUpdatesAs Value)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(GetUpdatesAs Value))

-- | Request parameters for 'getUpdates'.
data GetUpdatesRequest = GetUpdatesRequest
  { GetUpdatesRequest -> Maybe UpdateId
getUpdatesOffset         :: Maybe UpdateId -- ^ Identifier of the first update to be returned. Must be greater by one than the highest among the identifiers of previously received updates. By default, updates starting with the earliest unconfirmed update are returned. An update is considered confirmed as soon as getUpdates is called with an offset higher than its update_id. The negative offset can be specified to retrieve updates starting from -offset update from the end of the updates queue. All previous updates will forgotten.
  , GetUpdatesRequest -> Maybe Int
getUpdatesLimit          :: Maybe Int -- ^ Limits the number of updates to be retrieved. Values between 1—100 are accepted. Defaults to 100.
  , GetUpdatesRequest -> Maybe Seconds
getUpdatesTimeout        :: Maybe Seconds -- ^ Timeout in seconds for long polling. Defaults to 0, i.e. usual short polling. Should be positive, short polling should be used for testing purposes only.
  , GetUpdatesRequest -> Maybe [UpdateType]
getUpdatesAllowedUpdates :: Maybe [UpdateType] -- ^ List the types of updates you want your bot to receive. For example, specify [“message”, “edited_channel_post”, “callback_query”] to only receive updates of these types. See GetUpdates for a complete list of available update types. Specify an empty list to receive all updates regardless of type (default). If not specified, the previous setting will be used. Please note that this parameter doesn't affect updates created before the call to the getUpdates, so unwanted updates may be received for a short period of time.
  } deriving ((forall x. GetUpdatesRequest -> Rep GetUpdatesRequest x)
-> (forall x. Rep GetUpdatesRequest x -> GetUpdatesRequest)
-> Generic GetUpdatesRequest
forall x. Rep GetUpdatesRequest x -> GetUpdatesRequest
forall x. GetUpdatesRequest -> Rep GetUpdatesRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetUpdatesRequest -> Rep GetUpdatesRequest x
from :: forall x. GetUpdatesRequest -> Rep GetUpdatesRequest x
$cto :: forall x. Rep GetUpdatesRequest x -> GetUpdatesRequest
to :: forall x. Rep GetUpdatesRequest x -> GetUpdatesRequest
Generic)

instance ToJSON   GetUpdatesRequest where toJSON :: GetUpdatesRequest -> Value
toJSON = GetUpdatesRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON GetUpdatesRequest where parseJSON :: Value -> Parser GetUpdatesRequest
parseJSON = Value -> Parser GetUpdatesRequest
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON

data UpdateType
  = UpdateMessage
  | UpdateEditedMessage
  | UpdateChannelPost
  | UpdateEditedChannelPost
  | UpdateBusinessConnection
  | UpdateBusinessMessage
  | UpdateEditedBusinessMessage
  | UpdateDeletedBusinessMessages
  | UpdateMessageReaction
  | UpdateMessageReactionCount
  | UpdateInlineQuery
  | UpdateChosenInlineResult
  | UpdateCallbackQuery
  | UpdateShippingQuery
  | UpdatePreCheckoutQuery
  | UpdatePoll
  | UpdatePollAnswer
  | UpdateMyChatMember
  | UpdateChatMember
  | UpdateChatJoinRequest
  | UpdateChatBoost
  | UpdateRemovedChatBoost
  deriving ((forall x. UpdateType -> Rep UpdateType x)
-> (forall x. Rep UpdateType x -> UpdateType) -> Generic UpdateType
forall x. Rep UpdateType x -> UpdateType
forall x. UpdateType -> Rep UpdateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateType -> Rep UpdateType x
from :: forall x. UpdateType -> Rep UpdateType x
$cto :: forall x. Rep UpdateType x -> UpdateType
to :: forall x. Rep UpdateType x -> UpdateType
Generic)

instance ToJSON   UpdateType where toJSON :: UpdateType -> Value
toJSON = UpdateType -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON UpdateType where parseJSON :: Value -> Parser UpdateType
parseJSON = Value -> Parser UpdateType
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON

makeDefault ''GetUpdatesRequest