{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE DeriveAnyClass            #-}
{-# LANGUAGE DuplicateRecordFields     #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE KindSignatures            #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE OverloadedLists           #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE StandaloneDeriving        #-}

-- |
-- Module      : Line.Bot.Types
-- Copyright   : (c) Alexandre Moreno, 2019-2021
-- License     : BSD-3-Clause
-- Maintainer  : alexmorenocano@gmail.com
-- Stability   : experimental

module Line.Bot.Types
  ( ChannelToken(..)
  , ChannelSecret(..)
  , ChannelId(..)
  , ChatType(..)
  , Id(..)
  , MessageId
  , URL(..)
  , Message(..)
  , ReplyToken(..)
  , LinkToken(..)
  , ReplyMessageBody(ReplyMessageBody)
  , PushMessageBody(PushMessageBody)
  , MulticastMessageBody(MulticastMessageBody)
  , BroadcastMessageBody(BroadcastMessageBody)
  , Profile(..)
  , QuickReply(..)
  , QuickReplyButton(..)
  , Action(..)
  , ClientCredentials(..)
  , ShortLivedChannelToken(..)
  , LineDate(..)
  , MessageCount(..)
  , MessageQuota(..)
  , MemberIds(..)
  , JPEG
  , RichMenuSize(..)
  , RichMenuBounds(..)
  , RichMenuArea(..)
  , RichMenu(..)
  , RichMenuResponse(..)
  , RichMenuId(..)
  , RichMenuResponseList(..)
  , RichMenuBulkLinkBody(..)
  , RichMenuBulkUnlinkBody(..)
  )
where

import           Control.Arrow         ((>>>))
import           Control.DeepSeq
import           Data.Aeson
import           Data.ByteString       (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy  as LB
import           Data.Char             (toLower)
import           Data.List             as L (stripPrefix)
import           Data.String
import           Data.Text             as T hiding (count, drop, toLower)
import           Data.Text.Encoding
import           Data.Time.Calendar    (Day)
import           Data.Time.Format
import           Data.Typeable
import           GHC.Generics          hiding (to)
import           Network.HTTP.Media    ((//))
import           Servant.API
import           Web.FormUrlEncoded    (ToForm (..))

newtype ChannelToken = ChannelToken { ChannelToken -> Text
unChannelToken :: Text }
  deriving (ChannelToken -> ChannelToken -> Bool
(ChannelToken -> ChannelToken -> Bool)
-> (ChannelToken -> ChannelToken -> Bool) -> Eq ChannelToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelToken -> ChannelToken -> Bool
$c/= :: ChannelToken -> ChannelToken -> Bool
== :: ChannelToken -> ChannelToken -> Bool
$c== :: ChannelToken -> ChannelToken -> Bool
Eq, Int -> ChannelToken -> ShowS
[ChannelToken] -> ShowS
ChannelToken -> String
(Int -> ChannelToken -> ShowS)
-> (ChannelToken -> String)
-> ([ChannelToken] -> ShowS)
-> Show ChannelToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelToken] -> ShowS
$cshowList :: [ChannelToken] -> ShowS
show :: ChannelToken -> String
$cshow :: ChannelToken -> String
showsPrec :: Int -> ChannelToken -> ShowS
$cshowsPrec :: Int -> ChannelToken -> ShowS
Show, (forall x. ChannelToken -> Rep ChannelToken x)
-> (forall x. Rep ChannelToken x -> ChannelToken)
-> Generic ChannelToken
forall x. Rep ChannelToken x -> ChannelToken
forall x. ChannelToken -> Rep ChannelToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelToken x -> ChannelToken
$cfrom :: forall x. ChannelToken -> Rep ChannelToken x
Generic, ChannelToken -> ()
(ChannelToken -> ()) -> NFData ChannelToken
forall a. (a -> ()) -> NFData a
rnf :: ChannelToken -> ()
$crnf :: ChannelToken -> ()
NFData)

instance FromJSON ChannelToken where
  parseJSON :: Value -> Parser ChannelToken
parseJSON = String
-> (Text -> Parser ChannelToken) -> Value -> Parser ChannelToken
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ChannelToken" ((Text -> Parser ChannelToken) -> Value -> Parser ChannelToken)
-> (Text -> Parser ChannelToken) -> Value -> Parser ChannelToken
forall a b. (a -> b) -> a -> b
$ ChannelToken -> Parser ChannelToken
forall (m :: * -> *) a. Monad m => a -> m a
return (ChannelToken -> Parser ChannelToken)
-> (Text -> ChannelToken) -> Text -> Parser ChannelToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ChannelToken
ChannelToken

instance IsString ChannelToken where
  fromString :: String -> ChannelToken
fromString String
s = Text -> ChannelToken
ChannelToken (String -> Text
forall a. IsString a => String -> a
fromString String
s)

instance ToHttpApiData ChannelToken where
  toHeader :: ChannelToken -> ByteString
toHeader (ChannelToken Text
t)     = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"Bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  toQueryParam :: ChannelToken -> Text
toQueryParam (ChannelToken Text
t) = Text
t

instance ToForm ChannelToken where
  toForm :: ChannelToken -> Form
toForm (ChannelToken Text
t) = [ (Text
"access_token", Text
t) ]

newtype ChannelSecret = ChannelSecret { ChannelSecret -> ByteString
unChannelSecret :: C8.ByteString }

instance IsString ChannelSecret where
  fromString :: String -> ChannelSecret
fromString String
s = ByteString -> ChannelSecret
ChannelSecret (String -> ByteString
C8.pack String
s)

instance ToHttpApiData ChannelSecret where
  toQueryParam :: ChannelSecret -> Text
toQueryParam = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ChannelSecret -> ByteString) -> ChannelSecret -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelSecret -> ByteString
unChannelSecret

newtype ChannelId = ChannelId { ChannelId -> Text
unChannelId :: Text }
  deriving (ChannelId -> ChannelId -> Bool
(ChannelId -> ChannelId -> Bool)
-> (ChannelId -> ChannelId -> Bool) -> Eq ChannelId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelId -> ChannelId -> Bool
$c/= :: ChannelId -> ChannelId -> Bool
== :: ChannelId -> ChannelId -> Bool
$c== :: ChannelId -> ChannelId -> Bool
Eq, Int -> ChannelId -> ShowS
[ChannelId] -> ShowS
ChannelId -> String
(Int -> ChannelId -> ShowS)
-> (ChannelId -> String)
-> ([ChannelId] -> ShowS)
-> Show ChannelId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelId] -> ShowS
$cshowList :: [ChannelId] -> ShowS
show :: ChannelId -> String
$cshow :: ChannelId -> String
showsPrec :: Int -> ChannelId -> ShowS
$cshowsPrec :: Int -> ChannelId -> ShowS
Show, (forall x. ChannelId -> Rep ChannelId x)
-> (forall x. Rep ChannelId x -> ChannelId) -> Generic ChannelId
forall x. Rep ChannelId x -> ChannelId
forall x. ChannelId -> Rep ChannelId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelId x -> ChannelId
$cfrom :: forall x. ChannelId -> Rep ChannelId x
Generic, ChannelId -> ()
(ChannelId -> ()) -> NFData ChannelId
forall a. (a -> ()) -> NFData a
rnf :: ChannelId -> ()
$crnf :: ChannelId -> ()
NFData)

instance IsString ChannelId where
  fromString :: String -> ChannelId
fromString String
s = Text -> ChannelId
ChannelId (String -> Text
forall a. IsString a => String -> a
fromString String
s)

instance ToHttpApiData ChannelId where
  toQueryParam :: ChannelId -> Text
toQueryParam (ChannelId Text
t) = Text
t

data ChatType = User | Group | Room

-- | ID of a chat user, group or room
data Id :: ChatType -> * where
  UserId  :: Text -> Id 'User
  GroupId :: Text -> Id 'Group
  RoomId  :: Text -> Id 'Room

deriving instance Eq (Id a)
deriving instance Show (Id a)

instance NFData (Id a) where
    rnf :: Id a -> ()
rnf (UserId Text
a)  = Text -> ()
forall a. NFData a => a -> ()
rnf Text
a
    rnf (GroupId Text
a) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
a
    rnf (RoomId Text
a)  = Text -> ()
forall a. NFData a => a -> ()
rnf Text
a

instance ToHttpApiData (Id a) where
  toQueryParam :: Id a -> Text
toQueryParam = \case
    UserId Text
a  -> Text
a
    GroupId Text
a -> Text
a
    RoomId Text
a  -> Text
a

instance ToJSON (Id a) where
  toJSON :: Id a -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Id a -> Text) -> Id a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam

instance FromHttpApiData (Id 'User) where
  parseUrlPiece :: Text -> Either Text (Id 'User)
parseUrlPiece = Id 'User -> Either Text (Id 'User)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id 'User -> Either Text (Id 'User))
-> (Text -> Id 'User) -> Text -> Either Text (Id 'User)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id 'User
UserId

instance FromHttpApiData (Id 'Group) where
  parseUrlPiece :: Text -> Either Text (Id 'Group)
parseUrlPiece = Id 'Group -> Either Text (Id 'Group)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id 'Group -> Either Text (Id 'Group))
-> (Text -> Id 'Group) -> Text -> Either Text (Id 'Group)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id 'Group
GroupId

instance FromHttpApiData (Id 'Room) where
  parseUrlPiece :: Text -> Either Text (Id 'Room)
parseUrlPiece = Id 'Room -> Either Text (Id 'Room)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id 'Room -> Either Text (Id 'Room))
-> (Text -> Id 'Room) -> Text -> Either Text (Id 'Room)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id 'Room
RoomId

instance IsString (Id 'User) where
  fromString :: String -> Id 'User
fromString String
s = Text -> Id 'User
UserId (String -> Text
forall a. IsString a => String -> a
fromString String
s)

instance IsString (Id 'Group) where
  fromString :: String -> Id 'Group
fromString String
s = Text -> Id 'Group
GroupId (String -> Text
forall a. IsString a => String -> a
fromString String
s)

instance IsString (Id 'Room) where
  fromString :: String -> Id 'Room
fromString String
s = Text -> Id 'Room
RoomId (String -> Text
forall a. IsString a => String -> a
fromString String
s)

instance FromJSON (Id 'User) where
  parseJSON :: Value -> Parser (Id 'User)
parseJSON = String -> (Text -> Parser (Id 'User)) -> Value -> Parser (Id 'User)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Id 'User" ((Text -> Parser (Id 'User)) -> Value -> Parser (Id 'User))
-> (Text -> Parser (Id 'User)) -> Value -> Parser (Id 'User)
forall a b. (a -> b) -> a -> b
$ Id 'User -> Parser (Id 'User)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id 'User -> Parser (Id 'User))
-> (Text -> Id 'User) -> Text -> Parser (Id 'User)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id 'User
UserId

instance FromJSON (Id 'Group) where
  parseJSON :: Value -> Parser (Id 'Group)
parseJSON = String
-> (Text -> Parser (Id 'Group)) -> Value -> Parser (Id 'Group)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Id 'Group" ((Text -> Parser (Id 'Group)) -> Value -> Parser (Id 'Group))
-> (Text -> Parser (Id 'Group)) -> Value -> Parser (Id 'Group)
forall a b. (a -> b) -> a -> b
$ Id 'Group -> Parser (Id 'Group)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id 'Group -> Parser (Id 'Group))
-> (Text -> Id 'Group) -> Text -> Parser (Id 'Group)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id 'Group
GroupId

instance FromJSON (Id 'Room) where
  parseJSON :: Value -> Parser (Id 'Room)
parseJSON = String -> (Text -> Parser (Id 'Room)) -> Value -> Parser (Id 'Room)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Id 'Room" ((Text -> Parser (Id 'Room)) -> Value -> Parser (Id 'Room))
-> (Text -> Parser (Id 'Room)) -> Value -> Parser (Id 'Room)
forall a b. (a -> b) -> a -> b
$ Id 'Room -> Parser (Id 'Room)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id 'Room -> Parser (Id 'Room))
-> (Text -> Id 'Room) -> Text -> Parser (Id 'Room)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id 'Room
RoomId

type MessageId = Text

newtype URL = URL Text
  deriving (Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show, URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, (forall x. URL -> Rep URL x)
-> (forall x. Rep URL x -> URL) -> Generic URL
forall x. Rep URL x -> URL
forall x. URL -> Rep URL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URL x -> URL
$cfrom :: forall x. URL -> Rep URL x
Generic, URL -> ()
(URL -> ()) -> NFData URL
forall a. (a -> ()) -> NFData a
rnf :: URL -> ()
$crnf :: URL -> ()
NFData)

instance ToJSON URL
instance FromJSON URL

data Message =
    MessageText     { Message -> Text
text       :: Text
                    , Message -> Maybe QuickReply
quickReply :: Maybe QuickReply
                    }
  | MessageSticker  { Message -> Text
packageId  :: Text
                    , Message -> Text
stickerId  :: Text
                    , quickReply :: Maybe QuickReply
                    }
  | MessageImage    { Message -> URL
originalContentUrl :: URL
                    , Message -> URL
previewImageUrl    :: URL
                    , quickReply         :: Maybe QuickReply
                    }
  | MessageVideo    { originalContentUrl :: URL
                    , previewImageUrl    :: URL
                    , quickReply         :: Maybe QuickReply
                    }
  | MessageAudio    { originalContentUrl :: URL
                    , Message -> Int
duration           :: Int
                    , quickReply         :: Maybe QuickReply
                    }
  | MessageLocation { Message -> Text
title      :: Text
                    , Message -> Text
address    :: Text
                    , Message -> Double
latitude   :: Double
                    , Message -> Double
longitude  :: Double
                    , quickReply :: Maybe QuickReply
                    }
  | MessageFlex     { Message -> Text
altText    :: Text
                    , Message -> Value
contents   :: Value
                    , quickReply :: Maybe QuickReply
                    }
  deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic, Message -> ()
(Message -> ()) -> NFData Message
forall a. (a -> ()) -> NFData a
rnf :: Message -> ()
$crnf :: Message -> ()
NFData)

instance ToJSON Message where
  toJSON :: Message -> Value
toJSON = Options -> Message -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
messageJSONOptions

messageJSONOptions :: Options
messageJSONOptions :: Options
messageJSONOptions = Options
defaultOptions
  { sumEncoding :: SumEncoding
sumEncoding            = TaggedObject :: String -> String -> SumEncoding
TaggedObject
    { tagFieldName :: String
tagFieldName      = String
"type"
    , contentsFieldName :: String
contentsFieldName = String
forall a. HasCallStack => a
undefined
    }
  , constructorTagModifier :: ShowS
constructorTagModifier = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
7
  , omitNothingFields :: Bool
omitNothingFields      = Bool
True
  }

data Profile = Profile
  { Profile -> Text
displayName   :: Text
  , Profile -> Text
userId        :: Text
  , Profile -> URL
pictureUrl    :: URL
  , Profile -> Maybe Text
statusMessage :: Maybe Text
  }
  deriving (Profile -> Profile -> Bool
(Profile -> Profile -> Bool)
-> (Profile -> Profile -> Bool) -> Eq Profile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Profile -> Profile -> Bool
$c/= :: Profile -> Profile -> Bool
== :: Profile -> Profile -> Bool
$c== :: Profile -> Profile -> Bool
Eq, Int -> Profile -> ShowS
[Profile] -> ShowS
Profile -> String
(Int -> Profile -> ShowS)
-> (Profile -> String) -> ([Profile] -> ShowS) -> Show Profile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Profile] -> ShowS
$cshowList :: [Profile] -> ShowS
show :: Profile -> String
$cshow :: Profile -> String
showsPrec :: Int -> Profile -> ShowS
$cshowsPrec :: Int -> Profile -> ShowS
Show, (forall x. Profile -> Rep Profile x)
-> (forall x. Rep Profile x -> Profile) -> Generic Profile
forall x. Rep Profile x -> Profile
forall x. Profile -> Rep Profile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Profile x -> Profile
$cfrom :: forall x. Profile -> Rep Profile x
Generic, Profile -> ()
(Profile -> ()) -> NFData Profile
forall a. (a -> ()) -> NFData a
rnf :: Profile -> ()
$crnf :: Profile -> ()
NFData)

instance FromJSON Profile

newtype ReplyToken = ReplyToken Text
  deriving (ReplyToken -> ReplyToken -> Bool
(ReplyToken -> ReplyToken -> Bool)
-> (ReplyToken -> ReplyToken -> Bool) -> Eq ReplyToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplyToken -> ReplyToken -> Bool
$c/= :: ReplyToken -> ReplyToken -> Bool
== :: ReplyToken -> ReplyToken -> Bool
$c== :: ReplyToken -> ReplyToken -> Bool
Eq, Int -> ReplyToken -> ShowS
[ReplyToken] -> ShowS
ReplyToken -> String
(Int -> ReplyToken -> ShowS)
-> (ReplyToken -> String)
-> ([ReplyToken] -> ShowS)
-> Show ReplyToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyToken] -> ShowS
$cshowList :: [ReplyToken] -> ShowS
show :: ReplyToken -> String
$cshow :: ReplyToken -> String
showsPrec :: Int -> ReplyToken -> ShowS
$cshowsPrec :: Int -> ReplyToken -> ShowS
Show, (forall x. ReplyToken -> Rep ReplyToken x)
-> (forall x. Rep ReplyToken x -> ReplyToken) -> Generic ReplyToken
forall x. Rep ReplyToken x -> ReplyToken
forall x. ReplyToken -> Rep ReplyToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplyToken x -> ReplyToken
$cfrom :: forall x. ReplyToken -> Rep ReplyToken x
Generic, ReplyToken -> ()
(ReplyToken -> ()) -> NFData ReplyToken
forall a. (a -> ()) -> NFData a
rnf :: ReplyToken -> ()
$crnf :: ReplyToken -> ()
NFData)

instance ToJSON ReplyToken
instance FromJSON ReplyToken

newtype LinkToken = LinkToken { LinkToken -> Text
linkToken :: Text }
  deriving (LinkToken -> LinkToken -> Bool
(LinkToken -> LinkToken -> Bool)
-> (LinkToken -> LinkToken -> Bool) -> Eq LinkToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkToken -> LinkToken -> Bool
$c/= :: LinkToken -> LinkToken -> Bool
== :: LinkToken -> LinkToken -> Bool
$c== :: LinkToken -> LinkToken -> Bool
Eq, Int -> LinkToken -> ShowS
[LinkToken] -> ShowS
LinkToken -> String
(Int -> LinkToken -> ShowS)
-> (LinkToken -> String)
-> ([LinkToken] -> ShowS)
-> Show LinkToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkToken] -> ShowS
$cshowList :: [LinkToken] -> ShowS
show :: LinkToken -> String
$cshow :: LinkToken -> String
showsPrec :: Int -> LinkToken -> ShowS
$cshowsPrec :: Int -> LinkToken -> ShowS
Show, (forall x. LinkToken -> Rep LinkToken x)
-> (forall x. Rep LinkToken x -> LinkToken) -> Generic LinkToken
forall x. Rep LinkToken x -> LinkToken
forall x. LinkToken -> Rep LinkToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LinkToken x -> LinkToken
$cfrom :: forall x. LinkToken -> Rep LinkToken x
Generic, LinkToken -> ()
(LinkToken -> ()) -> NFData LinkToken
forall a. (a -> ()) -> NFData a
rnf :: LinkToken -> ()
$crnf :: LinkToken -> ()
NFData)

instance FromJSON LinkToken

data ReplyMessageBody = ReplyMessageBody
  { ReplyMessageBody -> ReplyToken
replyToken :: ReplyToken
  , ReplyMessageBody -> [Message]
messages   :: [Message]
  }
  deriving (Int -> ReplyMessageBody -> ShowS
[ReplyMessageBody] -> ShowS
ReplyMessageBody -> String
(Int -> ReplyMessageBody -> ShowS)
-> (ReplyMessageBody -> String)
-> ([ReplyMessageBody] -> ShowS)
-> Show ReplyMessageBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyMessageBody] -> ShowS
$cshowList :: [ReplyMessageBody] -> ShowS
show :: ReplyMessageBody -> String
$cshow :: ReplyMessageBody -> String
showsPrec :: Int -> ReplyMessageBody -> ShowS
$cshowsPrec :: Int -> ReplyMessageBody -> ShowS
Show, (forall x. ReplyMessageBody -> Rep ReplyMessageBody x)
-> (forall x. Rep ReplyMessageBody x -> ReplyMessageBody)
-> Generic ReplyMessageBody
forall x. Rep ReplyMessageBody x -> ReplyMessageBody
forall x. ReplyMessageBody -> Rep ReplyMessageBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplyMessageBody x -> ReplyMessageBody
$cfrom :: forall x. ReplyMessageBody -> Rep ReplyMessageBody x
Generic, ReplyMessageBody -> ()
(ReplyMessageBody -> ()) -> NFData ReplyMessageBody
forall a. (a -> ()) -> NFData a
rnf :: ReplyMessageBody -> ()
$crnf :: ReplyMessageBody -> ()
NFData)

instance ToJSON ReplyMessageBody

data PushMessageBody = forall a. PushMessageBody
  { ()
to       :: Id a
  , PushMessageBody -> [Message]
messages :: [Message]
  }

deriving instance Show PushMessageBody

instance ToJSON PushMessageBody where
  toJSON :: PushMessageBody -> Value
toJSON PushMessageBody {[Message]
Id a
messages :: [Message]
to :: Id a
$sel:messages:PushMessageBody :: PushMessageBody -> [Message]
$sel:to:PushMessageBody :: ()
..} = [Pair] -> Value
object
    [ Text
"to"       Text -> Id a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Id a
to
    , Text
"messages" Text -> [Message] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Message]
messages
    ]

data MulticastMessageBody = MulticastMessageBody
  { MulticastMessageBody -> [Id 'User]
to       :: [Id 'User]
  , MulticastMessageBody -> [Message]
messages :: [Message]
  }
  deriving (Int -> MulticastMessageBody -> ShowS
[MulticastMessageBody] -> ShowS
MulticastMessageBody -> String
(Int -> MulticastMessageBody -> ShowS)
-> (MulticastMessageBody -> String)
-> ([MulticastMessageBody] -> ShowS)
-> Show MulticastMessageBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MulticastMessageBody] -> ShowS
$cshowList :: [MulticastMessageBody] -> ShowS
show :: MulticastMessageBody -> String
$cshow :: MulticastMessageBody -> String
showsPrec :: Int -> MulticastMessageBody -> ShowS
$cshowsPrec :: Int -> MulticastMessageBody -> ShowS
Show, (forall x. MulticastMessageBody -> Rep MulticastMessageBody x)
-> (forall x. Rep MulticastMessageBody x -> MulticastMessageBody)
-> Generic MulticastMessageBody
forall x. Rep MulticastMessageBody x -> MulticastMessageBody
forall x. MulticastMessageBody -> Rep MulticastMessageBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MulticastMessageBody x -> MulticastMessageBody
$cfrom :: forall x. MulticastMessageBody -> Rep MulticastMessageBody x
Generic, MulticastMessageBody -> ()
(MulticastMessageBody -> ()) -> NFData MulticastMessageBody
forall a. (a -> ()) -> NFData a
rnf :: MulticastMessageBody -> ()
$crnf :: MulticastMessageBody -> ()
NFData)

instance ToJSON MulticastMessageBody

newtype BroadcastMessageBody = BroadcastMessageBody
  { BroadcastMessageBody -> [Message]
messages :: [Message] }
  deriving (Int -> BroadcastMessageBody -> ShowS
[BroadcastMessageBody] -> ShowS
BroadcastMessageBody -> String
(Int -> BroadcastMessageBody -> ShowS)
-> (BroadcastMessageBody -> String)
-> ([BroadcastMessageBody] -> ShowS)
-> Show BroadcastMessageBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BroadcastMessageBody] -> ShowS
$cshowList :: [BroadcastMessageBody] -> ShowS
show :: BroadcastMessageBody -> String
$cshow :: BroadcastMessageBody -> String
showsPrec :: Int -> BroadcastMessageBody -> ShowS
$cshowsPrec :: Int -> BroadcastMessageBody -> ShowS
Show, (forall x. BroadcastMessageBody -> Rep BroadcastMessageBody x)
-> (forall x. Rep BroadcastMessageBody x -> BroadcastMessageBody)
-> Generic BroadcastMessageBody
forall x. Rep BroadcastMessageBody x -> BroadcastMessageBody
forall x. BroadcastMessageBody -> Rep BroadcastMessageBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BroadcastMessageBody x -> BroadcastMessageBody
$cfrom :: forall x. BroadcastMessageBody -> Rep BroadcastMessageBody x
Generic, BroadcastMessageBody -> ()
(BroadcastMessageBody -> ()) -> NFData BroadcastMessageBody
forall a. (a -> ()) -> NFData a
rnf :: BroadcastMessageBody -> ()
$crnf :: BroadcastMessageBody -> ()
NFData)

instance ToJSON BroadcastMessageBody

newtype QuickReply = QuickReply
  { QuickReply -> [QuickReplyButton]
items :: [QuickReplyButton] }
  deriving (QuickReply -> QuickReply -> Bool
(QuickReply -> QuickReply -> Bool)
-> (QuickReply -> QuickReply -> Bool) -> Eq QuickReply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickReply -> QuickReply -> Bool
$c/= :: QuickReply -> QuickReply -> Bool
== :: QuickReply -> QuickReply -> Bool
$c== :: QuickReply -> QuickReply -> Bool
Eq, Int -> QuickReply -> ShowS
[QuickReply] -> ShowS
QuickReply -> String
(Int -> QuickReply -> ShowS)
-> (QuickReply -> String)
-> ([QuickReply] -> ShowS)
-> Show QuickReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuickReply] -> ShowS
$cshowList :: [QuickReply] -> ShowS
show :: QuickReply -> String
$cshow :: QuickReply -> String
showsPrec :: Int -> QuickReply -> ShowS
$cshowsPrec :: Int -> QuickReply -> ShowS
Show, (forall x. QuickReply -> Rep QuickReply x)
-> (forall x. Rep QuickReply x -> QuickReply) -> Generic QuickReply
forall x. Rep QuickReply x -> QuickReply
forall x. QuickReply -> Rep QuickReply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuickReply x -> QuickReply
$cfrom :: forall x. QuickReply -> Rep QuickReply x
Generic, QuickReply -> ()
(QuickReply -> ()) -> NFData QuickReply
forall a. (a -> ()) -> NFData a
rnf :: QuickReply -> ()
$crnf :: QuickReply -> ()
NFData)

instance ToJSON QuickReply

data QuickReplyButton = QuickReplyButton
  { QuickReplyButton -> Maybe URL
imageUrl :: Maybe URL
  , QuickReplyButton -> Action
action   :: Action
  }
  deriving (QuickReplyButton -> QuickReplyButton -> Bool
(QuickReplyButton -> QuickReplyButton -> Bool)
-> (QuickReplyButton -> QuickReplyButton -> Bool)
-> Eq QuickReplyButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickReplyButton -> QuickReplyButton -> Bool
$c/= :: QuickReplyButton -> QuickReplyButton -> Bool
== :: QuickReplyButton -> QuickReplyButton -> Bool
$c== :: QuickReplyButton -> QuickReplyButton -> Bool
Eq, Int -> QuickReplyButton -> ShowS
[QuickReplyButton] -> ShowS
QuickReplyButton -> String
(Int -> QuickReplyButton -> ShowS)
-> (QuickReplyButton -> String)
-> ([QuickReplyButton] -> ShowS)
-> Show QuickReplyButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuickReplyButton] -> ShowS
$cshowList :: [QuickReplyButton] -> ShowS
show :: QuickReplyButton -> String
$cshow :: QuickReplyButton -> String
showsPrec :: Int -> QuickReplyButton -> ShowS
$cshowsPrec :: Int -> QuickReplyButton -> ShowS
Show, (forall x. QuickReplyButton -> Rep QuickReplyButton x)
-> (forall x. Rep QuickReplyButton x -> QuickReplyButton)
-> Generic QuickReplyButton
forall x. Rep QuickReplyButton x -> QuickReplyButton
forall x. QuickReplyButton -> Rep QuickReplyButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuickReplyButton x -> QuickReplyButton
$cfrom :: forall x. QuickReplyButton -> Rep QuickReplyButton x
Generic, QuickReplyButton -> ()
(QuickReplyButton -> ()) -> NFData QuickReplyButton
forall a. (a -> ()) -> NFData a
rnf :: QuickReplyButton -> ()
$crnf :: QuickReplyButton -> ()
NFData)

instance ToJSON QuickReplyButton where
  toJSON :: QuickReplyButton -> Value
toJSON QuickReplyButton{Maybe URL
Action
action :: Action
imageUrl :: Maybe URL
$sel:action:QuickReplyButton :: QuickReplyButton -> Action
$sel:imageUrl:QuickReplyButton :: QuickReplyButton -> Maybe URL
..} = [Pair] -> Value
object
    [ Text
"type"     Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
pack String
"action"
    , Text
"imageUrl" Text -> Maybe URL -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe URL
imageUrl
    , Text
"action"   Text -> Action -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Action
action
    ]

data Action =
    ActionPostback   { Action -> Text
label        :: Text
                     , Action -> Text
postbackData :: Text
                     , Action -> Text
displayText  :: Text
                     }
  | ActionMessage    { label :: Text
                     , Action -> Text
text  :: Text
                     }
  | ActionUri        { label :: Text
                     , Action -> URL
uri   :: URL
                     }
  | ActionCamera     { label :: Text
                     }
  | ActionCameraRoll { label :: Text
                     }
  | ActionLocation   { label :: Text
                     }
  deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show, (forall x. Action -> Rep Action x)
-> (forall x. Rep Action x -> Action) -> Generic Action
forall x. Rep Action x -> Action
forall x. Action -> Rep Action x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Action x -> Action
$cfrom :: forall x. Action -> Rep Action x
Generic, Action -> ()
(Action -> ()) -> NFData Action
forall a. (a -> ()) -> NFData a
rnf :: Action -> ()
$crnf :: Action -> ()
NFData)

instance ToJSON Action where
  toJSON :: Action -> Value
toJSON = Options -> Action -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
actionJSONOptions

instance FromJSON Action where
  parseJSON :: Value -> Parser Action
parseJSON = Options -> Value -> Parser Action
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
actionJSONOptions

actionJSONOptions :: Options
actionJSONOptions :: Options
actionJSONOptions = Options
defaultOptions
  { sumEncoding :: SumEncoding
sumEncoding            = TaggedObject :: String -> String -> SumEncoding
TaggedObject
    { tagFieldName :: String
tagFieldName      = String
"type"
    , contentsFieldName :: String
contentsFieldName = String
forall a. HasCallStack => a
undefined
    }
  , constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6 ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \(Char
x:String
xs) -> Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
  , omitNothingFields :: Bool
omitNothingFields      = Bool
True
  , fieldLabelModifier :: ShowS
fieldLabelModifier     = \String
x -> String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
x ((Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix String
"postback" String
x
  }

data ClientCredentials = ClientCredentials
  { ClientCredentials -> ChannelId
clientId     :: ChannelId
  , ClientCredentials -> ChannelSecret
clientSecret :: ChannelSecret
  }

instance ToForm ClientCredentials where
  toForm :: ClientCredentials -> Form
toForm ClientCredentials{ChannelId
ChannelSecret
clientSecret :: ChannelSecret
clientId :: ChannelId
$sel:clientSecret:ClientCredentials :: ClientCredentials -> ChannelSecret
$sel:clientId:ClientCredentials :: ClientCredentials -> ChannelId
..} =
    [ (Text
"grant_type", Text
"client_credentials")
    , (Text
"client_id", ChannelId -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ChannelId
clientId)
    , (Text
"client_secret", ChannelSecret -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ChannelSecret
clientSecret)
    ]

data ShortLivedChannelToken = ShortLivedChannelToken
  { ShortLivedChannelToken -> ChannelToken
accessToken :: ChannelToken
  , ShortLivedChannelToken -> Int
expiresIn   :: Int
  } deriving (ShortLivedChannelToken -> ShortLivedChannelToken -> Bool
(ShortLivedChannelToken -> ShortLivedChannelToken -> Bool)
-> (ShortLivedChannelToken -> ShortLivedChannelToken -> Bool)
-> Eq ShortLivedChannelToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortLivedChannelToken -> ShortLivedChannelToken -> Bool
$c/= :: ShortLivedChannelToken -> ShortLivedChannelToken -> Bool
== :: ShortLivedChannelToken -> ShortLivedChannelToken -> Bool
$c== :: ShortLivedChannelToken -> ShortLivedChannelToken -> Bool
Eq, Int -> ShortLivedChannelToken -> ShowS
[ShortLivedChannelToken] -> ShowS
ShortLivedChannelToken -> String
(Int -> ShortLivedChannelToken -> ShowS)
-> (ShortLivedChannelToken -> String)
-> ([ShortLivedChannelToken] -> ShowS)
-> Show ShortLivedChannelToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortLivedChannelToken] -> ShowS
$cshowList :: [ShortLivedChannelToken] -> ShowS
show :: ShortLivedChannelToken -> String
$cshow :: ShortLivedChannelToken -> String
showsPrec :: Int -> ShortLivedChannelToken -> ShowS
$cshowsPrec :: Int -> ShortLivedChannelToken -> ShowS
Show, (forall x. ShortLivedChannelToken -> Rep ShortLivedChannelToken x)
-> (forall x.
    Rep ShortLivedChannelToken x -> ShortLivedChannelToken)
-> Generic ShortLivedChannelToken
forall x. Rep ShortLivedChannelToken x -> ShortLivedChannelToken
forall x. ShortLivedChannelToken -> Rep ShortLivedChannelToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShortLivedChannelToken x -> ShortLivedChannelToken
$cfrom :: forall x. ShortLivedChannelToken -> Rep ShortLivedChannelToken x
Generic, ShortLivedChannelToken -> ()
(ShortLivedChannelToken -> ()) -> NFData ShortLivedChannelToken
forall a. (a -> ()) -> NFData a
rnf :: ShortLivedChannelToken -> ()
$crnf :: ShortLivedChannelToken -> ()
NFData)

instance FromJSON ShortLivedChannelToken where
  parseJSON :: Value -> Parser ShortLivedChannelToken
parseJSON = Options -> Value -> Parser ShortLivedChannelToken
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions
    { fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' }

newtype LineDate = LineDate { LineDate -> Day
unLineDate :: Day } deriving (LineDate -> LineDate -> Bool
(LineDate -> LineDate -> Bool)
-> (LineDate -> LineDate -> Bool) -> Eq LineDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineDate -> LineDate -> Bool
$c/= :: LineDate -> LineDate -> Bool
== :: LineDate -> LineDate -> Bool
$c== :: LineDate -> LineDate -> Bool
Eq)

instance Show LineDate where
  show :: LineDate -> String
show = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d" (Day -> String) -> (LineDate -> Day) -> LineDate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineDate -> Day
unLineDate

instance ToHttpApiData LineDate where
  toQueryParam :: LineDate -> Text
toQueryParam = String -> Text
T.pack (String -> Text) -> (LineDate -> String) -> LineDate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineDate -> String
forall a. Show a => a -> String
show

data MessageCount = MessageCount
  { MessageCount -> Maybe Int
count  :: Maybe Int
  , MessageCount -> String
status :: String
  } deriving (MessageCount -> MessageCount -> Bool
(MessageCount -> MessageCount -> Bool)
-> (MessageCount -> MessageCount -> Bool) -> Eq MessageCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageCount -> MessageCount -> Bool
$c/= :: MessageCount -> MessageCount -> Bool
== :: MessageCount -> MessageCount -> Bool
$c== :: MessageCount -> MessageCount -> Bool
Eq, Int -> MessageCount -> ShowS
[MessageCount] -> ShowS
MessageCount -> String
(Int -> MessageCount -> ShowS)
-> (MessageCount -> String)
-> ([MessageCount] -> ShowS)
-> Show MessageCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageCount] -> ShowS
$cshowList :: [MessageCount] -> ShowS
show :: MessageCount -> String
$cshow :: MessageCount -> String
showsPrec :: Int -> MessageCount -> ShowS
$cshowsPrec :: Int -> MessageCount -> ShowS
Show)

instance FromJSON MessageCount where
  parseJSON :: Value -> Parser MessageCount
parseJSON = String
-> (Object -> Parser MessageCount) -> Value -> Parser MessageCount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MessageCount" ((Object -> Parser MessageCount) -> Value -> Parser MessageCount)
-> (Object -> Parser MessageCount) -> Value -> Parser MessageCount
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Int
count  <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"success"
    String
status <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"status"
    MessageCount -> Parser MessageCount
forall (m :: * -> *) a. Monad m => a -> m a
return MessageCount :: Maybe Int -> String -> MessageCount
MessageCount{String
Maybe Int
status :: String
count :: Maybe Int
$sel:status:MessageCount :: String
$sel:count:MessageCount :: Maybe Int
..}

newtype MessageQuota = MessageQuota { MessageQuota -> Int
totalUsage :: Int }
  deriving (MessageQuota -> MessageQuota -> Bool
(MessageQuota -> MessageQuota -> Bool)
-> (MessageQuota -> MessageQuota -> Bool) -> Eq MessageQuota
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageQuota -> MessageQuota -> Bool
$c/= :: MessageQuota -> MessageQuota -> Bool
== :: MessageQuota -> MessageQuota -> Bool
$c== :: MessageQuota -> MessageQuota -> Bool
Eq, Int -> MessageQuota -> ShowS
[MessageQuota] -> ShowS
MessageQuota -> String
(Int -> MessageQuota -> ShowS)
-> (MessageQuota -> String)
-> ([MessageQuota] -> ShowS)
-> Show MessageQuota
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageQuota] -> ShowS
$cshowList :: [MessageQuota] -> ShowS
show :: MessageQuota -> String
$cshow :: MessageQuota -> String
showsPrec :: Int -> MessageQuota -> ShowS
$cshowsPrec :: Int -> MessageQuota -> ShowS
Show, (forall x. MessageQuota -> Rep MessageQuota x)
-> (forall x. Rep MessageQuota x -> MessageQuota)
-> Generic MessageQuota
forall x. Rep MessageQuota x -> MessageQuota
forall x. MessageQuota -> Rep MessageQuota x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageQuota x -> MessageQuota
$cfrom :: forall x. MessageQuota -> Rep MessageQuota x
Generic, MessageQuota -> ()
(MessageQuota -> ()) -> NFData MessageQuota
forall a. (a -> ()) -> NFData a
rnf :: MessageQuota -> ()
$crnf :: MessageQuota -> ()
NFData)

instance FromJSON MessageQuota

data MemberIds = MemberIds
  { MemberIds -> [Id 'User]
memberIds :: [Id 'User]
  , MemberIds -> Maybe String
next      :: Maybe String
  } deriving (MemberIds -> MemberIds -> Bool
(MemberIds -> MemberIds -> Bool)
-> (MemberIds -> MemberIds -> Bool) -> Eq MemberIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemberIds -> MemberIds -> Bool
$c/= :: MemberIds -> MemberIds -> Bool
== :: MemberIds -> MemberIds -> Bool
$c== :: MemberIds -> MemberIds -> Bool
Eq, Int -> MemberIds -> ShowS
[MemberIds] -> ShowS
MemberIds -> String
(Int -> MemberIds -> ShowS)
-> (MemberIds -> String)
-> ([MemberIds] -> ShowS)
-> Show MemberIds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemberIds] -> ShowS
$cshowList :: [MemberIds] -> ShowS
show :: MemberIds -> String
$cshow :: MemberIds -> String
showsPrec :: Int -> MemberIds -> ShowS
$cshowsPrec :: Int -> MemberIds -> ShowS
Show, (forall x. MemberIds -> Rep MemberIds x)
-> (forall x. Rep MemberIds x -> MemberIds) -> Generic MemberIds
forall x. Rep MemberIds x -> MemberIds
forall x. MemberIds -> Rep MemberIds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MemberIds x -> MemberIds
$cfrom :: forall x. MemberIds -> Rep MemberIds x
Generic, MemberIds -> ()
(MemberIds -> ()) -> NFData MemberIds
forall a. (a -> ()) -> NFData a
rnf :: MemberIds -> ()
$crnf :: MemberIds -> ()
NFData)

instance FromJSON MemberIds

data JPEG deriving Typeable

instance Accept JPEG where
  contentType :: Proxy JPEG -> MediaType
contentType Proxy JPEG
_ = ByteString
"image" ByteString -> ByteString -> MediaType
// ByteString
"jpeg"

instance MimeRender JPEG ByteString where
  mimeRender :: Proxy JPEG -> ByteString -> ByteString
mimeRender Proxy JPEG
_ = ByteString -> ByteString
LB.fromStrict

data RichMenuSize = RichMenuSize
  { RichMenuSize -> Int
width  :: Int
  , RichMenuSize -> Int
height :: Int
  } deriving (RichMenuSize -> RichMenuSize -> Bool
(RichMenuSize -> RichMenuSize -> Bool)
-> (RichMenuSize -> RichMenuSize -> Bool) -> Eq RichMenuSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuSize -> RichMenuSize -> Bool
$c/= :: RichMenuSize -> RichMenuSize -> Bool
== :: RichMenuSize -> RichMenuSize -> Bool
$c== :: RichMenuSize -> RichMenuSize -> Bool
Eq, Int -> RichMenuSize -> ShowS
[RichMenuSize] -> ShowS
RichMenuSize -> String
(Int -> RichMenuSize -> ShowS)
-> (RichMenuSize -> String)
-> ([RichMenuSize] -> ShowS)
-> Show RichMenuSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuSize] -> ShowS
$cshowList :: [RichMenuSize] -> ShowS
show :: RichMenuSize -> String
$cshow :: RichMenuSize -> String
showsPrec :: Int -> RichMenuSize -> ShowS
$cshowsPrec :: Int -> RichMenuSize -> ShowS
Show, (forall x. RichMenuSize -> Rep RichMenuSize x)
-> (forall x. Rep RichMenuSize x -> RichMenuSize)
-> Generic RichMenuSize
forall x. Rep RichMenuSize x -> RichMenuSize
forall x. RichMenuSize -> Rep RichMenuSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuSize x -> RichMenuSize
$cfrom :: forall x. RichMenuSize -> Rep RichMenuSize x
Generic, RichMenuSize -> ()
(RichMenuSize -> ()) -> NFData RichMenuSize
forall a. (a -> ()) -> NFData a
rnf :: RichMenuSize -> ()
$crnf :: RichMenuSize -> ()
NFData)

instance FromJSON RichMenuSize
instance ToJSON RichMenuSize

data RichMenuBounds = RichMenuBounds
  { RichMenuBounds -> Int
x      :: Int
  , RichMenuBounds -> Int
y      :: Int
  , RichMenuBounds -> Int
width  :: Int
  , RichMenuBounds -> Int
height :: Int
  } deriving (RichMenuBounds -> RichMenuBounds -> Bool
(RichMenuBounds -> RichMenuBounds -> Bool)
-> (RichMenuBounds -> RichMenuBounds -> Bool) -> Eq RichMenuBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuBounds -> RichMenuBounds -> Bool
$c/= :: RichMenuBounds -> RichMenuBounds -> Bool
== :: RichMenuBounds -> RichMenuBounds -> Bool
$c== :: RichMenuBounds -> RichMenuBounds -> Bool
Eq, Int -> RichMenuBounds -> ShowS
[RichMenuBounds] -> ShowS
RichMenuBounds -> String
(Int -> RichMenuBounds -> ShowS)
-> (RichMenuBounds -> String)
-> ([RichMenuBounds] -> ShowS)
-> Show RichMenuBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuBounds] -> ShowS
$cshowList :: [RichMenuBounds] -> ShowS
show :: RichMenuBounds -> String
$cshow :: RichMenuBounds -> String
showsPrec :: Int -> RichMenuBounds -> ShowS
$cshowsPrec :: Int -> RichMenuBounds -> ShowS
Show, (forall x. RichMenuBounds -> Rep RichMenuBounds x)
-> (forall x. Rep RichMenuBounds x -> RichMenuBounds)
-> Generic RichMenuBounds
forall x. Rep RichMenuBounds x -> RichMenuBounds
forall x. RichMenuBounds -> Rep RichMenuBounds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuBounds x -> RichMenuBounds
$cfrom :: forall x. RichMenuBounds -> Rep RichMenuBounds x
Generic, RichMenuBounds -> ()
(RichMenuBounds -> ()) -> NFData RichMenuBounds
forall a. (a -> ()) -> NFData a
rnf :: RichMenuBounds -> ()
$crnf :: RichMenuBounds -> ()
NFData)

instance FromJSON RichMenuBounds
instance ToJSON RichMenuBounds

data RichMenuArea = RichMenuArea
  { RichMenuArea -> RichMenuBounds
bounds :: RichMenuBounds
  , RichMenuArea -> Action
action :: Action
  } deriving (RichMenuArea -> RichMenuArea -> Bool
(RichMenuArea -> RichMenuArea -> Bool)
-> (RichMenuArea -> RichMenuArea -> Bool) -> Eq RichMenuArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuArea -> RichMenuArea -> Bool
$c/= :: RichMenuArea -> RichMenuArea -> Bool
== :: RichMenuArea -> RichMenuArea -> Bool
$c== :: RichMenuArea -> RichMenuArea -> Bool
Eq, Int -> RichMenuArea -> ShowS
[RichMenuArea] -> ShowS
RichMenuArea -> String
(Int -> RichMenuArea -> ShowS)
-> (RichMenuArea -> String)
-> ([RichMenuArea] -> ShowS)
-> Show RichMenuArea
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuArea] -> ShowS
$cshowList :: [RichMenuArea] -> ShowS
show :: RichMenuArea -> String
$cshow :: RichMenuArea -> String
showsPrec :: Int -> RichMenuArea -> ShowS
$cshowsPrec :: Int -> RichMenuArea -> ShowS
Show, (forall x. RichMenuArea -> Rep RichMenuArea x)
-> (forall x. Rep RichMenuArea x -> RichMenuArea)
-> Generic RichMenuArea
forall x. Rep RichMenuArea x -> RichMenuArea
forall x. RichMenuArea -> Rep RichMenuArea x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuArea x -> RichMenuArea
$cfrom :: forall x. RichMenuArea -> Rep RichMenuArea x
Generic, RichMenuArea -> ()
(RichMenuArea -> ()) -> NFData RichMenuArea
forall a. (a -> ()) -> NFData a
rnf :: RichMenuArea -> ()
$crnf :: RichMenuArea -> ()
NFData)

instance FromJSON RichMenuArea
instance ToJSON RichMenuArea

data RichMenu = RichMenu
  { RichMenu -> RichMenuSize
size        :: RichMenuSize
  , RichMenu -> Bool
selected    :: Bool
  , RichMenu -> Text
name        :: Text
  , RichMenu -> Text
chatBarText :: Text
  , RichMenu -> [RichMenuArea]
areas       :: [RichMenuArea]
  } deriving (RichMenu -> RichMenu -> Bool
(RichMenu -> RichMenu -> Bool)
-> (RichMenu -> RichMenu -> Bool) -> Eq RichMenu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenu -> RichMenu -> Bool
$c/= :: RichMenu -> RichMenu -> Bool
== :: RichMenu -> RichMenu -> Bool
$c== :: RichMenu -> RichMenu -> Bool
Eq, Int -> RichMenu -> ShowS
[RichMenu] -> ShowS
RichMenu -> String
(Int -> RichMenu -> ShowS)
-> (RichMenu -> String) -> ([RichMenu] -> ShowS) -> Show RichMenu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenu] -> ShowS
$cshowList :: [RichMenu] -> ShowS
show :: RichMenu -> String
$cshow :: RichMenu -> String
showsPrec :: Int -> RichMenu -> ShowS
$cshowsPrec :: Int -> RichMenu -> ShowS
Show, (forall x. RichMenu -> Rep RichMenu x)
-> (forall x. Rep RichMenu x -> RichMenu) -> Generic RichMenu
forall x. Rep RichMenu x -> RichMenu
forall x. RichMenu -> Rep RichMenu x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenu x -> RichMenu
$cfrom :: forall x. RichMenu -> Rep RichMenu x
Generic, RichMenu -> ()
(RichMenu -> ()) -> NFData RichMenu
forall a. (a -> ()) -> NFData a
rnf :: RichMenu -> ()
$crnf :: RichMenu -> ()
NFData)

instance FromJSON RichMenu
instance ToJSON RichMenu

data RichMenuResponse = RichMenuResponse
  { RichMenuResponse -> Text
richMenuId :: Text
  , RichMenuResponse -> RichMenu
richMenu   :: RichMenu
  }
  deriving (Int -> RichMenuResponse -> ShowS
[RichMenuResponse] -> ShowS
RichMenuResponse -> String
(Int -> RichMenuResponse -> ShowS)
-> (RichMenuResponse -> String)
-> ([RichMenuResponse] -> ShowS)
-> Show RichMenuResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuResponse] -> ShowS
$cshowList :: [RichMenuResponse] -> ShowS
show :: RichMenuResponse -> String
$cshow :: RichMenuResponse -> String
showsPrec :: Int -> RichMenuResponse -> ShowS
$cshowsPrec :: Int -> RichMenuResponse -> ShowS
Show, RichMenuResponse -> RichMenuResponse -> Bool
(RichMenuResponse -> RichMenuResponse -> Bool)
-> (RichMenuResponse -> RichMenuResponse -> Bool)
-> Eq RichMenuResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuResponse -> RichMenuResponse -> Bool
$c/= :: RichMenuResponse -> RichMenuResponse -> Bool
== :: RichMenuResponse -> RichMenuResponse -> Bool
$c== :: RichMenuResponse -> RichMenuResponse -> Bool
Eq, (forall x. RichMenuResponse -> Rep RichMenuResponse x)
-> (forall x. Rep RichMenuResponse x -> RichMenuResponse)
-> Generic RichMenuResponse
forall x. Rep RichMenuResponse x -> RichMenuResponse
forall x. RichMenuResponse -> Rep RichMenuResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuResponse x -> RichMenuResponse
$cfrom :: forall x. RichMenuResponse -> Rep RichMenuResponse x
Generic, RichMenuResponse -> ()
(RichMenuResponse -> ()) -> NFData RichMenuResponse
forall a. (a -> ()) -> NFData a
rnf :: RichMenuResponse -> ()
$crnf :: RichMenuResponse -> ()
NFData)

instance FromJSON RichMenuResponse where
  parseJSON :: Value -> Parser RichMenuResponse
parseJSON = String
-> (Object -> Parser RichMenuResponse)
-> Value
-> Parser RichMenuResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RichMenuResponse" ((Object -> Parser RichMenuResponse)
 -> Value -> Parser RichMenuResponse)
-> (Object -> Parser RichMenuResponse)
-> Value
-> Parser RichMenuResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
richMenuId <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"richMenuId"
    RichMenu
richMenu   <- Value -> Parser RichMenu
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
    RichMenuResponse -> Parser RichMenuResponse
forall (m :: * -> *) a. Monad m => a -> m a
return RichMenuResponse :: Text -> RichMenu -> RichMenuResponse
RichMenuResponse{Text
RichMenu
richMenu :: RichMenu
richMenuId :: Text
$sel:richMenu:RichMenuResponse :: RichMenu
$sel:richMenuId:RichMenuResponse :: Text
..}

newtype RichMenuId = RichMenuId
  { RichMenuId -> Text
richMenuId :: Text }
  deriving (Int -> RichMenuId -> ShowS
[RichMenuId] -> ShowS
RichMenuId -> String
(Int -> RichMenuId -> ShowS)
-> (RichMenuId -> String)
-> ([RichMenuId] -> ShowS)
-> Show RichMenuId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuId] -> ShowS
$cshowList :: [RichMenuId] -> ShowS
show :: RichMenuId -> String
$cshow :: RichMenuId -> String
showsPrec :: Int -> RichMenuId -> ShowS
$cshowsPrec :: Int -> RichMenuId -> ShowS
Show, RichMenuId -> RichMenuId -> Bool
(RichMenuId -> RichMenuId -> Bool)
-> (RichMenuId -> RichMenuId -> Bool) -> Eq RichMenuId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuId -> RichMenuId -> Bool
$c/= :: RichMenuId -> RichMenuId -> Bool
== :: RichMenuId -> RichMenuId -> Bool
$c== :: RichMenuId -> RichMenuId -> Bool
Eq, (forall x. RichMenuId -> Rep RichMenuId x)
-> (forall x. Rep RichMenuId x -> RichMenuId) -> Generic RichMenuId
forall x. Rep RichMenuId x -> RichMenuId
forall x. RichMenuId -> Rep RichMenuId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuId x -> RichMenuId
$cfrom :: forall x. RichMenuId -> Rep RichMenuId x
Generic, RichMenuId -> ()
(RichMenuId -> ()) -> NFData RichMenuId
forall a. (a -> ()) -> NFData a
rnf :: RichMenuId -> ()
$crnf :: RichMenuId -> ()
NFData)

instance FromJSON RichMenuId

instance ToHttpApiData RichMenuId where
  toQueryParam :: RichMenuId -> Text
toQueryParam (RichMenuId Text
a) = Text
a

newtype RichMenuResponseList = RichMenuResponseList
  { RichMenuResponseList -> [RichMenuResponse]
richmenus :: [RichMenuResponse] }
  deriving (Int -> RichMenuResponseList -> ShowS
[RichMenuResponseList] -> ShowS
RichMenuResponseList -> String
(Int -> RichMenuResponseList -> ShowS)
-> (RichMenuResponseList -> String)
-> ([RichMenuResponseList] -> ShowS)
-> Show RichMenuResponseList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuResponseList] -> ShowS
$cshowList :: [RichMenuResponseList] -> ShowS
show :: RichMenuResponseList -> String
$cshow :: RichMenuResponseList -> String
showsPrec :: Int -> RichMenuResponseList -> ShowS
$cshowsPrec :: Int -> RichMenuResponseList -> ShowS
Show, RichMenuResponseList -> RichMenuResponseList -> Bool
(RichMenuResponseList -> RichMenuResponseList -> Bool)
-> (RichMenuResponseList -> RichMenuResponseList -> Bool)
-> Eq RichMenuResponseList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuResponseList -> RichMenuResponseList -> Bool
$c/= :: RichMenuResponseList -> RichMenuResponseList -> Bool
== :: RichMenuResponseList -> RichMenuResponseList -> Bool
$c== :: RichMenuResponseList -> RichMenuResponseList -> Bool
Eq, (forall x. RichMenuResponseList -> Rep RichMenuResponseList x)
-> (forall x. Rep RichMenuResponseList x -> RichMenuResponseList)
-> Generic RichMenuResponseList
forall x. Rep RichMenuResponseList x -> RichMenuResponseList
forall x. RichMenuResponseList -> Rep RichMenuResponseList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuResponseList x -> RichMenuResponseList
$cfrom :: forall x. RichMenuResponseList -> Rep RichMenuResponseList x
Generic, RichMenuResponseList -> ()
(RichMenuResponseList -> ()) -> NFData RichMenuResponseList
forall a. (a -> ()) -> NFData a
rnf :: RichMenuResponseList -> ()
$crnf :: RichMenuResponseList -> ()
NFData)

instance FromJSON RichMenuResponseList

data RichMenuBulkLinkBody = RichMenuBulkLinkBody
  { RichMenuBulkLinkBody -> Text
richMenuId :: Text
  , RichMenuBulkLinkBody -> [Id 'User]
userIds    :: [Id 'User]
  } deriving (Int -> RichMenuBulkLinkBody -> ShowS
[RichMenuBulkLinkBody] -> ShowS
RichMenuBulkLinkBody -> String
(Int -> RichMenuBulkLinkBody -> ShowS)
-> (RichMenuBulkLinkBody -> String)
-> ([RichMenuBulkLinkBody] -> ShowS)
-> Show RichMenuBulkLinkBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuBulkLinkBody] -> ShowS
$cshowList :: [RichMenuBulkLinkBody] -> ShowS
show :: RichMenuBulkLinkBody -> String
$cshow :: RichMenuBulkLinkBody -> String
showsPrec :: Int -> RichMenuBulkLinkBody -> ShowS
$cshowsPrec :: Int -> RichMenuBulkLinkBody -> ShowS
Show, RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool
(RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool)
-> (RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool)
-> Eq RichMenuBulkLinkBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool
$c/= :: RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool
== :: RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool
$c== :: RichMenuBulkLinkBody -> RichMenuBulkLinkBody -> Bool
Eq, (forall x. RichMenuBulkLinkBody -> Rep RichMenuBulkLinkBody x)
-> (forall x. Rep RichMenuBulkLinkBody x -> RichMenuBulkLinkBody)
-> Generic RichMenuBulkLinkBody
forall x. Rep RichMenuBulkLinkBody x -> RichMenuBulkLinkBody
forall x. RichMenuBulkLinkBody -> Rep RichMenuBulkLinkBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuBulkLinkBody x -> RichMenuBulkLinkBody
$cfrom :: forall x. RichMenuBulkLinkBody -> Rep RichMenuBulkLinkBody x
Generic, RichMenuBulkLinkBody -> ()
(RichMenuBulkLinkBody -> ()) -> NFData RichMenuBulkLinkBody
forall a. (a -> ()) -> NFData a
rnf :: RichMenuBulkLinkBody -> ()
$crnf :: RichMenuBulkLinkBody -> ()
NFData)

instance ToJSON RichMenuBulkLinkBody

newtype RichMenuBulkUnlinkBody = RichMenuBulkUnlinkBody
  { RichMenuBulkUnlinkBody -> [Id 'User]
userIds :: [Id 'User] }
  deriving (Int -> RichMenuBulkUnlinkBody -> ShowS
[RichMenuBulkUnlinkBody] -> ShowS
RichMenuBulkUnlinkBody -> String
(Int -> RichMenuBulkUnlinkBody -> ShowS)
-> (RichMenuBulkUnlinkBody -> String)
-> ([RichMenuBulkUnlinkBody] -> ShowS)
-> Show RichMenuBulkUnlinkBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichMenuBulkUnlinkBody] -> ShowS
$cshowList :: [RichMenuBulkUnlinkBody] -> ShowS
show :: RichMenuBulkUnlinkBody -> String
$cshow :: RichMenuBulkUnlinkBody -> String
showsPrec :: Int -> RichMenuBulkUnlinkBody -> ShowS
$cshowsPrec :: Int -> RichMenuBulkUnlinkBody -> ShowS
Show, RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool
(RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool)
-> (RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool)
-> Eq RichMenuBulkUnlinkBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool
$c/= :: RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool
== :: RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool
$c== :: RichMenuBulkUnlinkBody -> RichMenuBulkUnlinkBody -> Bool
Eq, (forall x. RichMenuBulkUnlinkBody -> Rep RichMenuBulkUnlinkBody x)
-> (forall x.
    Rep RichMenuBulkUnlinkBody x -> RichMenuBulkUnlinkBody)
-> Generic RichMenuBulkUnlinkBody
forall x. Rep RichMenuBulkUnlinkBody x -> RichMenuBulkUnlinkBody
forall x. RichMenuBulkUnlinkBody -> Rep RichMenuBulkUnlinkBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichMenuBulkUnlinkBody x -> RichMenuBulkUnlinkBody
$cfrom :: forall x. RichMenuBulkUnlinkBody -> Rep RichMenuBulkUnlinkBody x
Generic, RichMenuBulkUnlinkBody -> ()
(RichMenuBulkUnlinkBody -> ()) -> NFData RichMenuBulkUnlinkBody
forall a. (a -> ()) -> NFData a
rnf :: RichMenuBulkUnlinkBody -> ()
$crnf :: RichMenuBulkUnlinkBody -> ()
NFData)

instance ToJSON RichMenuBulkUnlinkBody