{-# 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)
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)
data Update = Update
{ Update -> UpdateId
updateUpdateId :: UpdateId
, Update -> Maybe Message
updateMessage :: Maybe Message
, Update -> Maybe Message
updateEditedMessage :: Maybe Message
, Update -> Maybe Message
updateChannelPost :: Maybe Message
, Update -> Maybe Message
updateEditedChannelPost :: Maybe Message
, Update -> Maybe BusinessConnection
updateBusinessConnection :: Maybe BusinessConnection
, Update -> Maybe Message
updateBusinessMessage :: Maybe Message
, Update -> Maybe Message
updateEditedBusinessMessage :: Maybe Message
, Update -> Maybe BusinessMessagesDeleted
updateDeletedBusinessMessages :: Maybe BusinessMessagesDeleted
, Update -> Maybe MessageReactionUpdated
updateMessageReaction :: Maybe MessageReactionUpdated
, Update -> Maybe MessageReactionCountUpdated
updateMessageReactionCount :: Maybe MessageReactionCountUpdated
, Update -> Maybe InlineQuery
updateInlineQuery :: Maybe InlineQuery
, Update -> Maybe ChosenInlineResult
updateChosenInlineResult :: Maybe ChosenInlineResult
, Update -> Maybe CallbackQuery
updateCallbackQuery :: Maybe CallbackQuery
, Update -> Maybe ShippingQuery
updateShippingQuery :: Maybe ShippingQuery
, Update -> Maybe PreCheckoutQuery
updatePreCheckoutQuery :: Maybe PreCheckoutQuery
, Update -> Maybe Poll
updatePoll :: Maybe Poll
, Update -> Maybe PollAnswer
updatePollAnswer :: Maybe PollAnswer
, Update -> Maybe ChatMemberUpdated
updateMyChatMember :: Maybe ChatMemberUpdated
, Update -> Maybe ChatMemberUpdated
updateChatMember :: Maybe ChatMemberUpdated
, Update -> Maybe ChatJoinRequest
updateChatJoinRequest :: Maybe ChatJoinRequest
, Update -> Maybe ChatBoostUpdated
updateChatBoost :: Maybe ChatBoostUpdated
, Update -> Maybe ChatBoostRemoved
updateRemovedChatBoost :: Maybe ChatBoostRemoved
} 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
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
]
type GetUpdatesAs a
= "getUpdates" :> ReqBody '[JSON] GetUpdatesRequest :> Get '[JSON] (Response [a])
type GetUpdates = GetUpdatesAs Update
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)
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))
data GetUpdatesRequest = GetUpdatesRequest
{ GetUpdatesRequest -> Maybe UpdateId
getUpdatesOffset :: Maybe UpdateId
, GetUpdatesRequest -> Maybe Int
getUpdatesLimit :: Maybe Int
, GetUpdatesRequest -> Maybe Seconds
getUpdatesTimeout :: Maybe Seconds
, GetUpdatesRequest -> Maybe [UpdateType]
getUpdatesAllowedUpdates :: Maybe [UpdateType]
} 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