{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.GetMyShortDescription where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
import GHC.Generics (Generic)
import Data.Text (Text)
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.Internal.TH

-- ** 'GetMyShortDescription'

newtype GetMyShortDescriptionRequest = GetMyShortDescriptionRequest
  { GetMyShortDescriptionRequest -> Maybe Text
getMyShortDescriptionLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code or an empty string.
  }
  deriving forall x.
Rep GetMyShortDescriptionRequest x -> GetMyShortDescriptionRequest
forall x.
GetMyShortDescriptionRequest -> Rep GetMyShortDescriptionRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetMyShortDescriptionRequest x -> GetMyShortDescriptionRequest
$cfrom :: forall x.
GetMyShortDescriptionRequest -> Rep GetMyShortDescriptionRequest x
Generic

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

type GetMyShortDescription = "getMyShortDescription"
  :> ReqBody '[JSON] GetMyShortDescriptionRequest
  :> Post '[JSON] (Response BotShortDescription)

-- | Use this method to get the current bot short description for the given user language.
--   Returns 'BotShortDescription' on success.
getMyShortDescription :: GetMyShortDescriptionRequest -> ClientM (Response BotShortDescription)
getMyShortDescription :: GetMyShortDescriptionRequest
-> ClientM (Response BotShortDescription)
getMyShortDescription = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @GetMyShortDescription)

makeDefault ''GetMyShortDescriptionRequest