{-# 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
( 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.Aeson.Types
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.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.String
import Data.Text as T hiding (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 (MediaType, (//))
import Servant.API
import Text.Show
import Web.FormUrlEncoded (ToForm (..))
newtype ChannelToken = ChannelToken { unChannelToken :: Text }
deriving (Eq, Show, Generic, NFData)
instance FromJSON ChannelToken where
parseJSON = withText "ChannelToken" $ return . ChannelToken
instance IsString ChannelToken where
fromString s = ChannelToken (fromString s)
instance ToHttpApiData ChannelToken where
toHeader (ChannelToken t) = encodeUtf8 $ "Bearer " <> t
toQueryParam (ChannelToken t) = t
instance ToForm ChannelToken where
toForm (ChannelToken t) = [ ("access_token", t) ]
newtype ChannelSecret = ChannelSecret { unChannelSecret :: C8.ByteString }
instance IsString ChannelSecret where
fromString s = ChannelSecret (C8.pack s)
instance ToHttpApiData ChannelSecret where
toQueryParam = decodeUtf8 . unChannelSecret
newtype ChannelId = ChannelId { unChannelId :: Text }
deriving (Eq, Show, Generic, NFData)
instance IsString ChannelId where
fromString s = ChannelId (fromString s)
instance ToHttpApiData ChannelId where
toQueryParam (ChannelId t) = t
data ChatType = User | Group | 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 (UserId a) = rnf a
rnf (GroupId a) = rnf a
rnf (RoomId a) = rnf a
instance ToHttpApiData (Id a) where
toQueryParam = \case
UserId a -> a
GroupId a -> a
RoomId a -> a
instance ToJSON (Id a) where
toJSON = String . toQueryParam
instance FromHttpApiData (Id User) where
parseUrlPiece = pure . UserId
instance FromHttpApiData (Id Group) where
parseUrlPiece = pure . GroupId
instance FromHttpApiData (Id Room) where
parseUrlPiece = pure . RoomId
instance IsString (Id User) where
fromString s = UserId (fromString s)
instance IsString (Id Group) where
fromString s = GroupId (fromString s)
instance IsString (Id Room) where
fromString s = RoomId (fromString s)
instance FromJSON (Id User) where
parseJSON = withText "Id User" $ return . UserId
instance FromJSON (Id Group) where
parseJSON = withText "Id Group" $ return . GroupId
instance FromJSON (Id Room) where
parseJSON = withText "Id Room" $ return . RoomId
type MessageId = Text
newtype URL = URL Text
deriving (Show, Eq, Generic, NFData)
instance ToJSON URL
instance FromJSON URL
data Message =
MessageText { text :: Text
, quickReply :: Maybe QuickReply
}
| MessageSticker { packageId :: Text
, stickerId :: Text
, quickReply :: Maybe QuickReply
}
| MessageImage { originalContentUrl :: URL
, previewImageUrl :: URL
, quickReply :: Maybe QuickReply
}
| MessageVideo { originalContentUrl :: URL
, previewImageUrl :: URL
, quickReply :: Maybe QuickReply
}
| MessageAudio { originalContentUrl :: URL
, duration :: Int
, quickReply :: Maybe QuickReply
}
| MessageLocation { title :: Text
, address :: Text
, latitude :: Double
, longitude :: Double
, quickReply :: Maybe QuickReply
}
| MessageFlex { altText :: Text
, contents :: Value
, quickReply :: Maybe QuickReply
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON Message where
toJSON = genericToJSON messageJSONOptions
messageJSONOptions :: Options
messageJSONOptions = defaultOptions
{ sumEncoding = TaggedObject
{ tagFieldName = "type"
, contentsFieldName = undefined
}
, constructorTagModifier = fmap toLower . drop 7
, omitNothingFields = True
}
data Profile = Profile
{ displayName :: Text
, userId :: Text
, pictureUrl :: URL
, statusMessage :: Maybe Text
}
deriving (Eq, Show, Generic, NFData)
instance FromJSON Profile
newtype ReplyToken = ReplyToken Text
deriving (Eq, Show, Generic, NFData)
instance ToJSON ReplyToken
instance FromJSON ReplyToken
newtype LinkToken = LinkToken { linkToken :: Text }
deriving (Eq, Show, Generic, NFData)
instance FromJSON LinkToken
data ReplyMessageBody = ReplyMessageBody
{ replyToken :: ReplyToken
, messages :: [Message]
}
deriving (Show, Generic, NFData)
instance ToJSON ReplyMessageBody
data PushMessageBody = forall a. PushMessageBody
{ to :: Id a
, messages :: [Message]
}
deriving instance Show PushMessageBody
instance ToJSON PushMessageBody where
toJSON PushMessageBody {..} = object
[ "to" .= to
, "messages" .= messages
]
data MulticastMessageBody = MulticastMessageBody
{ to :: [Id User]
, messages :: [Message]
}
deriving (Show, Generic, NFData)
instance ToJSON MulticastMessageBody
newtype BroadcastMessageBody = BroadcastMessageBody
{ messages :: [Message] }
deriving (Show, Generic, NFData)
instance ToJSON BroadcastMessageBody
newtype QuickReply = QuickReply
{ items :: [QuickReplyButton] }
deriving (Eq, Show, Generic, NFData)
instance ToJSON QuickReply
data QuickReplyButton = QuickReplyButton
{ imageUrl :: Maybe URL
, action :: Action
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON QuickReplyButton where
toJSON QuickReplyButton{..} = object
[ "type" .= pack "action"
, "imageUrl" .= imageUrl
, "action" .= action
]
data Action =
ActionPostback { label :: Text
, postbackData :: Text
, displayText :: Text
}
| ActionMessage { label :: Text
, text :: Text
}
| ActionUri { label :: Text
, uri :: URL
}
| ActionCamera { label :: Text
}
| ActionCameraRoll { label :: Text
}
| ActionLocation { label :: Text
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON Action where
toJSON = genericToJSON actionJSONOptions
instance FromJSON Action where
parseJSON = genericParseJSON actionJSONOptions
actionJSONOptions :: Options
actionJSONOptions = defaultOptions
{ sumEncoding = TaggedObject
{ tagFieldName = "type"
, contentsFieldName = undefined
}
, constructorTagModifier = drop 6 >>> \(x:xs) -> toLower x : xs
, omitNothingFields = True
, fieldLabelModifier = \x -> maybe x (fmap toLower) $ L.stripPrefix "postback" x
}
data ClientCredentials = ClientCredentials
{ clientId :: ChannelId
, clientSecret :: ChannelSecret
}
instance ToForm ClientCredentials where
toForm ClientCredentials{..} =
[ ("grant_type", "client_credentials")
, ("client_id", toQueryParam clientId)
, ("client_secret", toQueryParam clientSecret)
]
data ShortLivedChannelToken = ShortLivedChannelToken
{ accessToken :: ChannelToken
, expiresIn :: Int
} deriving (Eq, Show, Generic, NFData)
instance FromJSON ShortLivedChannelToken where
parseJSON = genericParseJSON defaultOptions
{ fieldLabelModifier = camelTo2 '_' }
newtype LineDate = LineDate { unLineDate :: Day } deriving (Eq)
instance Show LineDate where
show = formatTime defaultTimeLocale "%Y%m%d" . unLineDate
instance ToHttpApiData LineDate where
toQueryParam = T.pack . show
data MessageCount = MessageCount
{ count :: Maybe Int
, status :: String
} deriving (Eq, Show)
instance FromJSON MessageCount where
parseJSON = withObject "MessageCount" $ \o -> do
count <- o .:? "success"
status <- o .: "status"
return MessageCount{..}
newtype MessageQuota = MessageQuota { totalUsage :: Int }
deriving (Eq, Show, Generic, NFData)
instance FromJSON MessageQuota
data MemberIds = MemberIds
{ memberIds :: [Id User]
, next :: Maybe String
} deriving (Eq, Show, Generic, NFData)
instance FromJSON MemberIds
data JPEG deriving Typeable
instance Accept JPEG where
contentType _ = "image" // "jpeg"
instance MimeRender JPEG ByteString where
mimeRender _ = LB.fromStrict
data RichMenuSize = RichMenuSize
{ width :: Int
, height :: Int
} deriving (Eq, Show, Generic, NFData)
instance FromJSON RichMenuSize
instance ToJSON RichMenuSize
data RichMenuBounds = RichMenuBounds
{ x :: Int
, y :: Int
, width :: Int
, height :: Int
} deriving (Eq, Show, Generic, NFData)
instance FromJSON RichMenuBounds
instance ToJSON RichMenuBounds
data RichMenuArea = RichMenuArea
{ bounds :: RichMenuBounds
, action :: Action
} deriving (Eq, Show, Generic, NFData)
instance FromJSON RichMenuArea
instance ToJSON RichMenuArea
data RichMenu = RichMenu
{ size :: RichMenuSize
, selected :: Bool
, name :: Text
, chatBarText :: Text
, areas :: [RichMenuArea]
} deriving (Eq, Show, Generic, NFData)
instance FromJSON RichMenu
instance ToJSON RichMenu
data RichMenuResponse = RichMenuResponse
{ richMenuId :: Text
, richMenu :: RichMenu
}
deriving (Show, Eq, Generic, NFData)
instance FromJSON RichMenuResponse where
parseJSON = withObject "RichMenuResponse" $ \o -> do
richMenuId <- o .: "richMenuId"
richMenu <- parseJSON (Object o)
return RichMenuResponse{..}
newtype RichMenuId = RichMenuId
{ richMenuId :: Text }
deriving (Show, Eq, Generic, NFData)
instance FromJSON RichMenuId
instance ToHttpApiData RichMenuId where
toQueryParam (RichMenuId a) = a
newtype RichMenuResponseList = RichMenuResponseList
{ richmenus :: [RichMenuResponse] }
deriving (Show, Eq, Generic, NFData)
instance FromJSON RichMenuResponseList
data RichMenuBulkLinkBody = RichMenuBulkLinkBody
{ richMenuId :: Text
, userIds :: [Id User]
} deriving (Show, Eq, Generic, NFData)
instance ToJSON RichMenuBulkLinkBody
newtype RichMenuBulkUnlinkBody = RichMenuBulkUnlinkBody
{ userIds :: [Id User] }
deriving (Show, Eq, Generic, NFData)
instance ToJSON RichMenuBulkUnlinkBody