module Network.API.Telegram.Bot.Object.Member
( module Exports, Member (..), Until (..), Can (..), Cannot (..)
, Kick (..), Unban (..), Restrict (..), Promote (..)) where
import Network.API.Telegram.Bot.Object.Member.Powers as Exports
import Network.API.Telegram.Bot.Object.Member.Restrictions as Exports
import "aeson" Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:))
import "base" Control.Applicative ((<*>))
import "base" Control.Monad (fail, (>>=))
import "base" Data.Bool (Bool (True, False))
import "base" Data.Function (($))
import "base" Data.Functor ((<$>))
import "base" Data.Int (Int, Int64)
import "base" Data.Semigroup ((<>))
import "base" Text.Show (Show)
import "data-default" Data.Default (Default (def))
import "text" Data.Text (Text)
import Network.API.Telegram.Bot.Object.Sender (Sender)
import Network.API.Telegram.Bot.Property.Accessible (Accessible (access))
import Network.API.Telegram.Bot.Property.Identifiable (Identifiable (Identificator, ident))
import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, Returning, payload, endpoint))
import Network.API.Telegram.Bot.Utils (field)
data Member
= Creator Sender
| Administrator Sender Bool Powers
| Member Sender
| Restricted Sender Restrictions Int
| Left Sender
| Kicked Sender Int
deriving Show
instance Accessible Sender Member where
access f (Creator sender) = (\sender' -> Creator sender') <$> f sender
access f (Administrator sender cbe powers) = (\sender' -> Administrator sender' cbe powers) <$> f sender
access f (Member sender) = (\sender' -> Member sender') <$> f sender
access f (Restricted sender restrictions until) = (\sender' -> Restricted sender' restrictions until) <$> f sender
access f (Left sender) = (\sender' -> Left sender') <$> f sender
access f (Kicked sender until) = (\sender' -> Kicked sender' until) <$> f sender
instance Identifiable Member where
type Identificator Member = Sender
ident (Creator sender) = sender
ident (Administrator sender _ _) = sender
ident (Member sender) = sender
ident (Restricted sender _ _) = sender
ident (Left sender) = sender
ident (Kicked sender _) = sender
instance FromJSON Member where
parseJSON = withObject "Member" $ \v -> v .: "status" >>= \case
("creator" :: Text) -> Creator <$> v .: "user"
("administrator" :: Text) -> Administrator <$> v .: "user" <*> v .: "can_be_edited" <*> parseJSON (Object v)
("member" :: Text) -> Member <$> v .: "user"
("restricted" :: Text) -> Restricted <$> v .: "user" <*> parseJSON (Object v) <*> v .: "until_date"
("left" :: Text) -> Left <$> v .: "user"
("kicked" :: Text) -> Kicked <$> v .: "user" <*> v.: "until_date"
_ -> fail "Status of chat member is not defined"
newtype Can a = Can a
instance Default (Can Restrictions) where
def = Can $ Restrictions True True True True
instance Default (Can Powers) where
def = Can $ Powers True True True True True True True True
newtype Cannot a = Cannot a
instance Default (Cannot Restrictions) where
def = Cannot $ Restrictions False False False False
instance Default (Cannot Powers) where
def = Cannot $ Powers False False False False False False False False
data Until = Forever | Until Int
data Kick a where
Kick :: Int64 -> Int -> Until -> Kick Member
instance Persistable (Kick Member) where
type Payload (Kick Member) = Kick Member
type Returning (Kick Member) = ()
payload (Kick chat_id user_id Forever) =
field "chat_id" chat_id <> field "user_id" user_id
payload (Kick chat_id user_id (Until until_date)) = field "chat_id" chat_id
<> field "user_id" user_id <> field "until_date" until_date
endpoint _ = "kickChatMember"
data Unban a where
Unban :: Int64 -> Int -> Unban Member
instance Persistable (Unban Member) where
type Payload (Unban Member) = Unban Member
type Returning (Unban Member) = ()
payload (Unban chat_id user_id) =
field "chat_id" chat_id
<> field "user_id" user_id
endpoint _ = "unbanChatMember"
data Restrict a where
Restrict :: Int64 -> Int -> Until -> Restrictions -> Restrict Member
instance Persistable (Restrict Member) where
type Payload (Restrict Member) = Restrict Member
type Returning (Restrict Member) = ()
payload (Restrict chat_id user_id Forever (Restrictions send_msgs send_media_msgs send_other_msgs wp_previews)) =
field "chat_id" chat_id <> field "user_id" user_id
<> field "can_send_messages" send_msgs <> field "can_send_media_messages" send_media_msgs
<> field "can_send_other_messages" send_other_msgs <> field "can_add_web_page_previews" wp_previews
payload (Restrict chat_id user_id (Until until_date) (Restrictions send_msgs send_media_msgs send_other_msgs wp_previews)) =
field "chat_id" chat_id <> field "user_id" user_id <> field "until_date" until_date
<> field "can_send_messages" send_msgs <> field "can_send_media_messages" send_media_msgs
<> field "can_send_other_messages" send_other_msgs <> field "can_add_web_page_previews" wp_previews
endpoint _ = "restrictChatMember"
data Promote a where
Promote :: Int64 -> Int -> Until -> Powers -> Promote Member
instance Persistable (Promote Member) where
type Payload (Promote Member) = Promote Member
type Returning (Promote Member) = ()
payload (Promote chat_id user_id Forever (Powers change_info post_msgs edit_msgs delete_msgs invite_users restrict_members pin_msgs promote_members)) =
field "chat_id" chat_id <> field "user_id" user_id
<> field "can_change_info" change_info <> field "can_post_messages" post_msgs
<> field "can_edit_messages" edit_msgs <> field "can_delete_messages" delete_msgs
<> field "can_invite_users" invite_users <> field "can_restrict_members" restrict_members
<> field "can_pin_messages" pin_msgs <> field "can_promote_members" promote_members
payload (Promote chat_id user_id (Until until_date) (Powers change_info post_msgs edit_msgs delete_msgs invite_users restrict_members pin_msgs promote_members)) =
field "chat_id" chat_id <> field "user_id" user_id <> field "until_date" until_date
<> field "can_change_info" change_info <> field "can_post_messages" post_msgs
<> field "can_edit_messages" edit_msgs <> field "can_delete_messages" delete_msgs
<> field "can_invite_users" invite_users <> field "can_restrict_members" restrict_members
<> field "can_pin_messages" pin_msgs <> field "can_promote_members" promote_members
endpoint _ = "promoteChatMember"