module Line.Messaging.Webhook.Types (
module Line.Messaging.Common.Types,
Signature,
WebhookFailure (..),
Body (..),
Event (..),
EventTuple,
ReplyToken,
ReplyableEvent,
NonReplyableEvent,
getSource,
getDatetime,
getReplyToken,
getMessage,
getPostback,
getBeacon,
EventSource (..),
EventMessage (..),
Postback (..),
PostbackParams (..),
BeaconData (..),
getHWID,
getDeviceMessage,
) where
import Data.Aeson
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Line.Messaging.API.Types
import Line.Messaging.Common.Types
import qualified Data.Text as T
import qualified Data.ByteString as B
type Signature = B.ByteString
data WebhookFailure = SignatureVerificationFailed
| MessageDecodeFailed
deriving (Eq, Show)
newtype Body = Body [Event]
deriving (Eq, Show)
instance FromJSON Body where
parseJSON (Object v) = Body <$> v .: "events"
parseJSON _ = fail "Body"
data Event = MessageEvent (ReplyableEvent EventMessage)
| FollowEvent (ReplyableEvent ())
| UnfollowEvent (NonReplyableEvent ())
| JoinEvent (ReplyableEvent ())
| LeaveEvent (NonReplyableEvent ())
| PostbackEvent (ReplyableEvent Postback)
| BeaconEvent (ReplyableEvent BeaconData)
deriving (Eq, Show)
type EventTuple r a = (EventSource, UTCTime, r, a)
type ReplyToken = T.Text
type ReplyableEvent a = EventTuple ReplyToken a
type NonReplyableEvent a = EventTuple () a
getSource :: EventTuple r a -> EventSource
getSource (s, _, _, _) = s
getDatetime :: EventTuple r a -> UTCTime
getDatetime (_, t, _, _) = t
getReplyToken :: ReplyableEvent a -> ReplyToken
getReplyToken (_, _, r, _) = r
getMessage :: ReplyableEvent EventMessage -> EventMessage
getMessage (_, _, _, m) = m
getPostback :: ReplyableEvent Postback -> Postback
getPostback (_, _, _, d) = d
getBeacon :: ReplyableEvent BeaconData -> BeaconData
getBeacon (_, _, _, b) = b
instance FromJSON Event where
parseJSON (Object v) = v .: "type" >>= \ t ->
case t :: T.Text of
"message" -> MessageEvent <$> (replyable v <*> v .: "message")
"follow" -> FollowEvent <$> (replyable v <*> none)
"unfollow" -> UnfollowEvent <$> (nonReplyable v <*> none)
"join" -> JoinEvent <$> (replyable v <*> none)
"leave" -> LeaveEvent <$> (nonReplyable v <*> none)
"postback" -> PostbackEvent <$> (replyable v <*> v .: "postback")
"beacon" -> BeaconEvent <$> (replyable v <*> v .: "beacon")
_ -> fail "Event"
where
common o = (,,,) <$> (o .: "source")
<*> (posixSecondsToUTCTime . (/ 1000) . fromInteger <$> o .: "timestamp")
withReplyToken p o = p <*> o .: "replyToken"
none = return ()
replyable o = common o `withReplyToken` o
nonReplyable o = common o <*> none
parseJSON _ = fail "Event"
data EventSource = User { userID :: ID }
| Group { groupID :: ID, groupUserId :: Maybe ID }
| Room { roomID :: ID, roomUserId :: Maybe ID }
deriving (Eq, Show)
instance FromJSON EventSource where
parseJSON (Object v) = v .: "type" >>= \ t ->
case t :: T.Text of
"user" -> User <$> v .: "userId"
"group" -> Group <$> v .: "groupId" <*> v .:? "userId"
"room" -> Room <$> v .: "roomId" <*> v .:? "userId"
_ -> fail "EventSource"
parseJSON _ = fail "EventSource"
data EventMessage = TextEM ID Text
| ImageEM ID
| VideoEM ID
| AudioEM ID
| FileEM ID T.Text Integer
| LocationEM ID Location
| StickerEM ID Sticker
deriving (Eq, Show)
instance FromJSON EventMessage where
parseJSON (Object v) = v .: "type" >>= \ t ->
case t :: T.Text of
"text" -> TextEM <$> v .: "id" <*> parseJSON (Object v)
"image" -> ImageEM <$> v .: "id"
"video" -> VideoEM <$> v .: "id"
"audio" -> AudioEM <$> v .: "id"
"file" -> FileEM <$> v .: "id" <*> v .: "fileName" <*> (read <$> v .: "fileSize")
"location" -> LocationEM <$> v .: "id" <*> parseJSON (Object v)
"sticker" -> StickerEM <$> v .: "id" <*> parseJSON (Object v)
_ -> fail "EventMessage"
parseJSON _ = fail "IncommingMessage"
data Postback = Postback { data' :: T.Text
, params :: Maybe PostbackParams
}
deriving (Eq, Show)
instance FromJSON Postback where
parseJSON (Object v) = Postback <$> v .: "data" <*> v .:? "params"
parseJSON _ = fail "Postback"
data PostbackParams = PostbackParamsDate T.Text
| PostbackParamsTime T.Text
| PostbackParamsDatetime T.Text
| PostbackParamsUnknown
deriving (Eq, Show)
instance FromJSON PostbackParams where
parseJSON (Object v) = go [ ("date", PostbackParamsDate)
, ("time", PostbackParamsTime)
, ("datetime", PostbackParamsDatetime)
]
where
go ((field, constructor):xs) = v .:? field >>= \m -> case m of
Just str -> return $ constructor str
Nothing -> go xs
go [] = return PostbackParamsUnknown
parseJSON _ = fail "PostbackParams"
data BeaconData = BeaconEnter ID (Maybe T.Text)
| BeaconLeave ID (Maybe T.Text)
| BeaconBanner ID (Maybe T.Text)
deriving (Eq, Show)
getHWID :: BeaconData -> ID
getHWID (BeaconEnter hwid _) = hwid
getHWID (BeaconLeave hwid _) = hwid
getHWID (BeaconBanner hwid _) = hwid
getDeviceMessage :: BeaconData -> Maybe T.Text
getDeviceMessage (BeaconEnter _ dm) = dm
getDeviceMessage (BeaconLeave _ dm) = dm
getDeviceMessage (BeaconBanner _ dm) = dm
instance FromJSON BeaconData where
parseJSON (Object v) = v .: "type" >>= \ t ->
case t :: T.Text of
"enter" -> parseBeacon BeaconEnter
"leave" -> parseBeacon BeaconLeave
"banner" -> parseBeacon BeaconBanner
_ -> fail "BeaconData"
where
parseBeacon f = f <$> v .: "hwid" <*> v .:? "dm"
parseJSON _ = fail "BeaconData"