{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Telegram.Bot.API.Types.ChatBoostSource where

import Data.Aeson (FromJSON (..), ToJSON (..), KeyValue ((.=)), Value (..), withObject, (.:), (.:?))
import Data.Aeson.Types (Parser)
import Data.Text (Text)
import GHC.Generics (Generic)

import qualified Data.Text as Text

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.User

-- ** 'ChatBoostSource'

-- | This object describes the source of a chat boost. It can be one of
--
-- * ChatBoostSourcePremium
-- * ChatBoostSourceGiftCode
-- * ChatBoostSourceGiveaway
--
data ChatBoostSource
  -- | The boost was obtained by subscribing to Telegram Premium or by gifting a Telegram Premium subscription to another user.
  = ChatBoostSourcePremium
      { ChatBoostSource -> Text
chatBoostSourcePremiumSource :: Text -- ^ Source of the boost, always “premium”.
      , ChatBoostSource -> User
chatBoostSourcePremiumUser :: User -- ^ User that boosted the chat.
      }
  -- | The boost was obtained by the creation of Telegram Premium gift codes to boost a chat. Each such code boosts the chat 4 times for the duration of the corresponding Telegram Premium subscription.
  | ChatBoostSourceGiftCode
      { ChatBoostSource -> Text
chatBoostSourceGiftCodeSource :: Text -- ^ Source of the boost, always “gift_code”.
      , ChatBoostSource -> User
chatBoostSourceGiftCodeUser :: User -- ^ User for which the gift code was created.
      }
  -- | The boost was obtained by the creation of a Telegram Premium giveaway. This boosts the chat 4 times for the duration of the corresponding Telegram Premium subscription.
  | ChatBoostSourceGiveaway
      { ChatBoostSource -> Text
chatBoostSourceGiveawaySource :: Text -- ^ Source of the boost, always “giveaway”.
      , ChatBoostSource -> MessageId
chatBoostSourceGiveawayGiveawayMessageId :: MessageId -- ^ Identifier of a message in the chat with the giveaway; the message could have been deleted already. May be 0 if the message isn't sent yet.
      , ChatBoostSource -> Maybe User
chatBoostSourceGiveawayUser :: Maybe User -- ^ User that won the prize in the giveaway if any
      , ChatBoostSource -> Maybe Bool
chatBoostSourceGiveawayIsUnclaimed :: Maybe Bool -- ^ 'True', if the giveaway was completed, but there was no user to win the prize
      }
  deriving ((forall x. ChatBoostSource -> Rep ChatBoostSource x)
-> (forall x. Rep ChatBoostSource x -> ChatBoostSource)
-> Generic ChatBoostSource
forall x. Rep ChatBoostSource x -> ChatBoostSource
forall x. ChatBoostSource -> Rep ChatBoostSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChatBoostSource -> Rep ChatBoostSource x
from :: forall x. ChatBoostSource -> Rep ChatBoostSource x
$cto :: forall x. Rep ChatBoostSource x -> ChatBoostSource
to :: forall x. Rep ChatBoostSource x -> ChatBoostSource
Generic, Int -> ChatBoostSource -> ShowS
[ChatBoostSource] -> ShowS
ChatBoostSource -> String
(Int -> ChatBoostSource -> ShowS)
-> (ChatBoostSource -> String)
-> ([ChatBoostSource] -> ShowS)
-> Show ChatBoostSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatBoostSource -> ShowS
showsPrec :: Int -> ChatBoostSource -> ShowS
$cshow :: ChatBoostSource -> String
show :: ChatBoostSource -> String
$cshowList :: [ChatBoostSource] -> ShowS
showList :: [ChatBoostSource] -> ShowS
Show)

instance ToJSON ChatBoostSource where
  toJSON :: ChatBoostSource -> Value
toJSON = \case
    ChatBoostSourcePremium Text
_s User
u -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
      [Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"premium" :: Text), Key
"user" Key -> User -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= User
u]
    ChatBoostSourceGiftCode Text
_s User
u -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
      [Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"gift_code" :: Text), Key
"user" Key -> User -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= User
u]
    ChatBoostSourceGiveaway Text
_s MessageId
gm Maybe User
u Maybe Bool
iu -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
      [ Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"giveaway" :: Text)
      , Key
"giveaway_message_id" Key -> MessageId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageId
gm
      , Key
"user" Key -> Maybe User -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe User
u
      , Key
"is_unclaimed" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
iu
      ]
      

instance FromJSON ChatBoostSource where
  parseJSON :: Value -> Parser ChatBoostSource
parseJSON = String
-> (Object -> Parser ChatBoostSource)
-> Value
-> Parser ChatBoostSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ChatBoostSource" \Object
o ->
    (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source" :: Parser Text) Parser Text
-> (Text -> Parser ChatBoostSource) -> Parser ChatBoostSource
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"premium" -> Text -> User -> ChatBoostSource
ChatBoostSourcePremium
      (Text -> User -> ChatBoostSource)
-> Parser Text -> Parser (User -> ChatBoostSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
      Parser (User -> ChatBoostSource)
-> Parser User -> Parser ChatBoostSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"gift_code" -> Text -> User -> ChatBoostSource
ChatBoostSourceGiftCode
      (Text -> User -> ChatBoostSource)
-> Parser Text -> Parser (User -> ChatBoostSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
      Parser (User -> ChatBoostSource)
-> Parser User -> Parser ChatBoostSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"giveaway" -> Text -> MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource
ChatBoostSourceGiveaway
      (Text -> MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource)
-> Parser Text
-> Parser
     (MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
      Parser (MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource)
-> Parser MessageId
-> Parser (Maybe User -> Maybe Bool -> ChatBoostSource)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser MessageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"giveaway_message_id"
      Parser (Maybe User -> Maybe Bool -> ChatBoostSource)
-> Parser (Maybe User) -> Parser (Maybe Bool -> ChatBoostSource)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
      Parser (Maybe Bool -> ChatBoostSource)
-> Parser (Maybe Bool) -> Parser ChatBoostSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_unclaimed"
    Text
t -> String -> Parser ChatBoostSource
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChatBoostSource)
-> String -> Parser ChatBoostSource
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text
"Unknown source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)