1{-# LANGUAGE CPP #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE FlexibleInstances #-} 4{-# LANGUAGE RecordWildCards #-} 5 6module Network.Mattermost.WebSocket.Types 7( WebsocketEventType(..) 8, WebsocketEvent(..) 9, WEData(..) 10, WEBroadcast(..) 11, WebsocketAction(..) 12, WebsocketActionResponse(..) 13, WebsocketActionStatus(..) 14) where 15 16import Control.Applicative 17import Control.Exception ( throw ) 18import Data.Aeson ( FromJSON(..) 19 , ToJSON(..) 20 , (.:) 21 , (.:?) 22 , (.=) 23 ) 24import qualified Data.Aeson as A 25import qualified Data.Aeson.Types as A 26#if !MIN_VERSION_base(4,11,0) 27import Data.Monoid ( (<>) ) 28#endif 29import Data.ByteString.Lazy (fromStrict, toStrict) 30import qualified Data.ByteString.Lazy.Char8 as BC 31import qualified Data.HashMap.Strict as HM 32import Data.Int (Int64) 33import Data.Sequence (Seq) 34import Data.Set (Set) 35import Data.Text (Text) 36import qualified Data.Text as T 37import Data.Text.Encoding (decodeUtf8, encodeUtf8) 38import Network.WebSockets (WebSocketsData(..)) 39import qualified Network.WebSockets as WS 40 41import Network.Mattermost.Types 42import Network.Mattermost.Exceptions 43 44 45data WebsocketEventType 46 = WMTyping 47 | WMPosted 48 | WMPostEdited 49 | WMPostDeleted 50 | WMChannelDeleted 51 | WMChannelCreated 52 | WMDirectAdded 53 | WMGroupAdded 54 | WMNewUser 55 | WMAddedToTeam 56 | WMLeaveTeam 57 | WMUpdateTeam 58 | WMTeamDeleted 59 | WMUserAdded 60 | WMUserUpdated 61 | WMUserRemoved 62 | WMPreferenceChanged 63 | WMPreferenceDeleted 64 | WMEphemeralMessage 65 | WMStatusChange 66 | WMHello 67 | WMWebRTC 68 | WMAuthenticationChallenge 69 | WMReactionAdded 70 | WMReactionRemoved 71 | WMChannelViewed 72 | WMChannelUpdated 73 | WMChannelMemberUpdated 74 | WMEmojiAdded 75 | WMUserRoleUpdated 76 | WMPluginStatusesChanged 77 | WMPluginEnabled 78 | WMPluginDisabled 79 | WMUnknownEvent T.Text 80 deriving (Read, Show, Eq, Ord) 81 82instance FromJSON WebsocketEventType where 83 parseJSON = A.withText "event type" $ \s -> case s of 84 "typing" -> return WMTyping 85 "posted" -> return WMPosted 86 "post_edited" -> return WMPostEdited 87 "post_deleted" -> return WMPostDeleted 88 "channel_deleted" -> return WMChannelDeleted 89 "direct_added" -> return WMDirectAdded 90 "new_user" -> return WMNewUser 91 "leave_team" -> return WMLeaveTeam 92 "user_added" -> return WMUserAdded 93 "user_updated" -> return WMUserUpdated 94 "user_removed" -> return WMUserRemoved 95 "preferences_changed" -> return WMPreferenceChanged 96 "ephemeral_message" -> return WMEphemeralMessage 97 "status_change" -> return WMStatusChange 98 "hello" -> return WMHello 99 "update_team" -> return WMUpdateTeam 100 "delete_team" -> return WMTeamDeleted 101 "reaction_added" -> return WMReactionAdded 102 "reaction_removed" -> return WMReactionRemoved 103 "channel_created" -> return WMChannelCreated 104 "group_added" -> return WMGroupAdded 105 "added_to_team" -> return WMAddedToTeam 106 "webrtc" -> return WMWebRTC 107 "authentication_challenge" -> return WMAuthenticationChallenge 108 "preferences_deleted" -> return WMPreferenceDeleted 109 "channel_viewed" -> return WMChannelViewed 110 "channel_updated" -> return WMChannelUpdated 111 "channel_member_updated" -> return WMChannelMemberUpdated 112 "emoji_added" -> return WMEmojiAdded 113 "user_role_updated" -> return WMUserRoleUpdated 114 "plugin_statuses_changed" -> return WMPluginStatusesChanged 115 "plugin_enabled" -> return WMPluginEnabled 116 "plugin_disabled" -> return WMPluginDisabled 117 _ -> return $ WMUnknownEvent s 118 119instance ToJSON WebsocketEventType where 120 toJSON WMTyping = "typing" 121 toJSON WMPosted = "posted" 122 toJSON WMPostEdited = "post_edited" 123 toJSON WMPostDeleted = "post_deleted" 124 toJSON WMChannelDeleted = "channel_deleted" 125 toJSON WMDirectAdded = "direct_added" 126 toJSON WMNewUser = "new_user" 127 toJSON WMLeaveTeam = "leave_team" 128 toJSON WMUserAdded = "user_added" 129 toJSON WMUserUpdated = "user_updated" 130 toJSON WMUserRemoved = "user_removed" 131 toJSON WMPreferenceChanged = "preferences_changed" 132 toJSON WMPreferenceDeleted = "preferences_deleted" 133 toJSON WMEphemeralMessage = "ephemeral_message" 134 toJSON WMStatusChange = "status_change" 135 toJSON WMHello = "hello" 136 toJSON WMUpdateTeam = "update_team" 137 toJSON WMTeamDeleted = "delete_team" 138 toJSON WMReactionAdded = "reaction_added" 139 toJSON WMReactionRemoved = "reaction_removed" 140 toJSON WMChannelCreated = "channel_created" 141 toJSON WMGroupAdded = "group_added" 142 toJSON WMAddedToTeam = "added_to_team" 143 toJSON WMWebRTC = "webrtc" 144 toJSON WMAuthenticationChallenge = "authentication_challenge" 145 toJSON WMChannelViewed = "channel_viewed" 146 toJSON WMChannelUpdated = "channel_updated" 147 toJSON WMChannelMemberUpdated = "channel_member_updated" 148 toJSON WMEmojiAdded = "emoji_added" 149 toJSON WMUserRoleUpdated = "user_role_updated" 150 toJSON WMPluginStatusesChanged = "plugin_statuses_changed" 151 toJSON WMPluginEnabled = "plugin_enabled" 152 toJSON WMPluginDisabled = "plugin_disabled" 153 toJSON (WMUnknownEvent s) = toJSON s 154 155-- 156 157toValueString :: ToJSON a => a -> A.Value 158toValueString v = toJSON (decodeUtf8 (toStrict (A.encode v))) 159 160fromValueString :: FromJSON a => A.Value -> A.Parser a 161fromValueString = A.withText "string-encoded json" $ \s -> do 162 case A.eitherDecode (fromStrict (encodeUtf8 s)) of 163 Right v -> return v 164 Left err -> throw (JSONDecodeException err (T.unpack s)) 165 166-- 167 168data WebsocketEvent = WebsocketEvent 169 { weEvent :: WebsocketEventType 170 , weData :: WEData 171 , weBroadcast :: WEBroadcast 172 , weSeq :: Int64 173 } deriving (Read, Show, Eq) 174 175instance FromJSON WebsocketEvent where 176 parseJSON = A.withObject "WebsocketEvent" $ \o -> do 177 weEvent <- o .: "event" 178 weData <- o .: "data" 179 weBroadcast <- o .: "broadcast" 180 weSeq <- o .: "seq" 181 return WebsocketEvent { .. } 182 183instance ToJSON WebsocketEvent where 184 toJSON WebsocketEvent { .. } = A.object 185 [ "event" .= weEvent 186 , "data" .= weData 187 , "broadcast" .= weBroadcast 188 , "seq" .= weSeq 189 ] 190 191instance WebSocketsData WebsocketEvent where 192 fromDataMessage (WS.Text bs _) = fromLazyByteString bs 193 fromDataMessage (WS.Binary bs) = fromLazyByteString bs 194 fromLazyByteString s = case A.eitherDecode s of 195 Left err -> throw (JSONDecodeException err (BC.unpack s)) 196 Right v -> v 197 toLazyByteString = A.encode 198 199-- 200 201data WEData = WEData 202 { wepChannelId :: Maybe ChannelId 203 , wepTeamId :: Maybe TeamId 204 , wepSenderName :: Maybe Text 205 , wepUserId :: Maybe UserId 206 , wepUser :: Maybe User 207 , wepChannelDisplayName :: Maybe Text 208 , wepPost :: Maybe Post 209 , wepStatus :: Maybe Text 210 , wepReaction :: Maybe Reaction 211 , wepMentions :: Maybe (Set UserId) 212 , wepPreferences :: Maybe (Seq Preference) 213 , wepChannelMember :: Maybe ChannelMember 214 } deriving (Read, Show, Eq) 215 216instance FromJSON WEData where 217 parseJSON = A.withObject "WebSocketEvent Data" $ \o -> do 218 wepChannelId <- nullable (o .: "channel_id") 219 wepTeamId <- maybeFail (o .: "team_id") 220 wepSenderName <- o .:? "sender_name" 221 wepUserId <- o .:? "user_id" 222 wepUser <- o .:? "user" 223 wepChannelDisplayName <- o .:? "channel_name" 224 wepPost <- mapM fromValueString =<< o .:? "post" 225 wepStatus <- o .:? "status" 226 wepReaction <- mapM fromValueString =<< o .:? "reaction" 227 wepMentions <- mapM fromValueString =<< o .:? "mentions" 228 wepPreferences <- mapM fromValueString =<< o .:? "preferences" 229 wepChannelMember <- mapM fromValueString =<< o .:? "channelMember" 230 return WEData { .. } 231 232instance ToJSON WEData where 233 toJSON WEData { .. } = A.object 234 [ "channel_id" .= wepChannelId 235 , "team_id" .= wepTeamId 236 , "sender_name" .= wepSenderName 237 , "user_id" .= wepUserId 238 , "channel_name" .= wepChannelDisplayName 239 , "post" .= toValueString wepPost 240 , "reaction" .= wepReaction 241 , "mentions" .= toValueString wepMentions 242 , "preferences" .= toValueString wepPreferences 243 , "channelMember" .= toValueString wepChannelMember 244 ] 245 246-- 247 248data WEBroadcast = WEBroadcast 249 { webChannelId :: Maybe ChannelId 250 , webUserId :: Maybe UserId 251 , webTeamId :: Maybe TeamId 252 , webOmitUsers :: Maybe (HM.HashMap UserId Bool) 253 } deriving (Read, Show, Eq) 254 255nullable :: Alternative f => f a -> f (Maybe a) 256nullable p = (Just <$> p) <|> pure Nothing 257 258instance FromJSON WEBroadcast where 259 parseJSON = A.withObject "WebSocketEvent Broadcast" $ \o -> do 260 webChannelId <- nullable (o .: "channel_id") 261 webTeamId <- nullable (o .: "team_id") 262 webUserId <- nullable (o .: "user_id") 263 webOmitUsers <- nullable (o .: "omit_users") 264 return WEBroadcast { .. } 265 266instance ToJSON WEBroadcast where 267 toJSON WEBroadcast { .. } = A.object 268 [ "channel_id" .= webChannelId 269 , "team_id" .= webTeamId 270 , "user_id" .= webUserId 271 , "omit_users" .= webOmitUsers 272 ] 273 274-- 275 276data WebsocketAction = 277 UserTyping { waSeq :: Int64 278 , waChannelId :: ChannelId 279 , waParentPostId :: Maybe PostId 280 } 281 -- -- | GetStatuses { waSeq :: Int64 } 282 -- -- | GetStatusesByIds { waSeq :: Int64, waUserIds :: [UserId] } 283 deriving (Read, Show, Eq, Ord) 284 285instance ToJSON WebsocketAction where 286 toJSON (UserTyping s cId pId) = A.object 287 [ "seq" .= s 288 , "action" .= T.pack "user_typing" 289 , "data" .= A.object 290 [ "channel_id" .= unId (toId cId) 291 , "parent_id" .= maybe "" (unId . toId) pId 292 ] 293 ] 294 295instance WebSocketsData WebsocketAction where 296 fromDataMessage _ = error "Not implemented" 297 fromLazyByteString _ = error "Not implemented" 298 toLazyByteString = A.encode 299 300data WebsocketActionStatus = 301 WebsocketActionStatusOK 302 deriving (Read, Show, Eq, Ord) 303 304instance FromJSON WebsocketActionStatus where 305 parseJSON = A.withText "WebsocketActionStatus" $ \t -> 306 case t of 307 "OK" -> return WebsocketActionStatusOK 308 _ -> fail $ "Invalid WebsocketActionStatus: " <> show t 309 310instance ToJSON WebsocketActionStatus where 311 toJSON WebsocketActionStatusOK = "OK" 312 313data WebsocketActionResponse = 314 WebsocketActionResponse { warStatus :: WebsocketActionStatus 315 , warSeqReply :: Int64 316 } 317 deriving (Read, Show, Eq, Ord) 318 319instance FromJSON WebsocketActionResponse where 320 parseJSON = 321 A.withObject "WebsocketActionResponse" $ \o -> 322 WebsocketActionResponse <$> o A..: "status" 323 <*> o A..: "seq_reply" 324 325instance ToJSON WebsocketActionResponse where 326 toJSON (WebsocketActionResponse status s) = 327 A.object [ "status" A..= A.toJSON status 328 , "seq" A..= A.toJSON s 329 ] 330 331instance WebSocketsData WebsocketActionResponse where 332 fromDataMessage (WS.Text bs _) = fromLazyByteString bs 333 fromDataMessage (WS.Binary bs) = fromLazyByteString bs 334 fromLazyByteString s = case A.eitherDecode s of 335 Left err -> throw (JSONDecodeException err (BC.unpack s)) 336 Right v -> v 337 toLazyByteString = A.encode 338