{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.GetMyDescription 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

-- ** 'GetMyDescription'

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

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

type GetMyDescription = "getMyDescription"
  :> ReqBody '[JSON] GetMyDescriptionRequest
  :> Post '[JSON] (Response BotDescription)

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

makeDefault ''GetMyDescriptionRequest