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 (..),
getID,
EventMessage (..),
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") >>= (.: "data")))
"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 ID
| Group ID
| Room ID
deriving (Eq, Show)
getID :: EventSource -> ID
getID (User i) = i
getID (Group i) = i
getID (Room i) = i
instance FromJSON EventSource where
parseJSON (Object v) = v .: "type" >>= \ t ->
case t :: T.Text of
"user" -> User <$> v .: "userId"
"group" -> Group <$> v .: "groupId"
"room" -> Room <$> v .: "roomId"
_ -> 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 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"