{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

module Network.Mattermost.WebSocket.Types
( WebsocketEventType(..)
, WebsocketEvent(..)
, WEData(..)
, WEBroadcast(..)
, WebsocketAction(..)
, WebsocketActionResponse(..)
, WebsocketActionStatus(..)
) where

import           Control.Applicative
import           Control.Exception ( throw )
import           Data.Aeson ( FromJSON(..)
                            , ToJSON(..)
                            , (.:)
                            , (.:?)
                            , (.=)
                            )
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid ( (<>) )
#endif
import           Data.ByteString.Lazy (fromStrict, toStrict)
import qualified Data.ByteString.Lazy.Char8 as BC
import qualified Data.HashMap.Strict as HM
import           Data.Int (Int64)
import           Data.Sequence (Seq)
import           Data.Set (Set)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8, encodeUtf8)
import           Network.WebSockets (WebSocketsData(..))
import qualified Network.WebSockets as WS

import           Network.Mattermost.Types
import           Network.Mattermost.Exceptions


data WebsocketEventType
  = WMTyping
  | WMPosted
  | WMPostEdited
  | WMPostDeleted
  | WMChannelDeleted
  | WMChannelCreated
  | WMDirectAdded
  | WMGroupAdded
  | WMNewUser
  | WMAddedToTeam
  | WMLeaveTeam
  | WMUpdateTeam
  | WMTeamDeleted
  | WMUserAdded
  | WMUserUpdated
  | WMUserRemoved
  | WMPreferenceChanged
  | WMPreferenceDeleted
  | WMEphemeralMessage
  | WMStatusChange
  | WMHello
  | WMWebRTC
  | WMAuthenticationChallenge
  | WMReactionAdded
  | WMReactionRemoved
  | WMChannelViewed
  | WMChannelUpdated
  | WMChannelMemberUpdated
  | WMEmojiAdded
  | WMUserRoleUpdated
  | WMPluginStatusesChanged
  | WMPluginEnabled
  | WMPluginDisabled
  | WMUnknownEvent T.Text
  deriving (ReadPrec [WebsocketEventType]
ReadPrec WebsocketEventType
Int -> ReadS WebsocketEventType
ReadS [WebsocketEventType]
(Int -> ReadS WebsocketEventType)
-> ReadS [WebsocketEventType]
-> ReadPrec WebsocketEventType
-> ReadPrec [WebsocketEventType]
-> Read WebsocketEventType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsocketEventType]
$creadListPrec :: ReadPrec [WebsocketEventType]
readPrec :: ReadPrec WebsocketEventType
$creadPrec :: ReadPrec WebsocketEventType
readList :: ReadS [WebsocketEventType]
$creadList :: ReadS [WebsocketEventType]
readsPrec :: Int -> ReadS WebsocketEventType
$creadsPrec :: Int -> ReadS WebsocketEventType
Read, Int -> WebsocketEventType -> ShowS
[WebsocketEventType] -> ShowS
WebsocketEventType -> String
(Int -> WebsocketEventType -> ShowS)
-> (WebsocketEventType -> String)
-> ([WebsocketEventType] -> ShowS)
-> Show WebsocketEventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketEventType] -> ShowS
$cshowList :: [WebsocketEventType] -> ShowS
show :: WebsocketEventType -> String
$cshow :: WebsocketEventType -> String
showsPrec :: Int -> WebsocketEventType -> ShowS
$cshowsPrec :: Int -> WebsocketEventType -> ShowS
Show, WebsocketEventType -> WebsocketEventType -> Bool
(WebsocketEventType -> WebsocketEventType -> Bool)
-> (WebsocketEventType -> WebsocketEventType -> Bool)
-> Eq WebsocketEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsocketEventType -> WebsocketEventType -> Bool
$c/= :: WebsocketEventType -> WebsocketEventType -> Bool
== :: WebsocketEventType -> WebsocketEventType -> Bool
$c== :: WebsocketEventType -> WebsocketEventType -> Bool
Eq, Eq WebsocketEventType
Eq WebsocketEventType
-> (WebsocketEventType -> WebsocketEventType -> Ordering)
-> (WebsocketEventType -> WebsocketEventType -> Bool)
-> (WebsocketEventType -> WebsocketEventType -> Bool)
-> (WebsocketEventType -> WebsocketEventType -> Bool)
-> (WebsocketEventType -> WebsocketEventType -> Bool)
-> (WebsocketEventType -> WebsocketEventType -> WebsocketEventType)
-> (WebsocketEventType -> WebsocketEventType -> WebsocketEventType)
-> Ord WebsocketEventType
WebsocketEventType -> WebsocketEventType -> Bool
WebsocketEventType -> WebsocketEventType -> Ordering
WebsocketEventType -> WebsocketEventType -> WebsocketEventType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
$cmin :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
max :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
$cmax :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
>= :: WebsocketEventType -> WebsocketEventType -> Bool
$c>= :: WebsocketEventType -> WebsocketEventType -> Bool
> :: WebsocketEventType -> WebsocketEventType -> Bool
$c> :: WebsocketEventType -> WebsocketEventType -> Bool
<= :: WebsocketEventType -> WebsocketEventType -> Bool
$c<= :: WebsocketEventType -> WebsocketEventType -> Bool
< :: WebsocketEventType -> WebsocketEventType -> Bool
$c< :: WebsocketEventType -> WebsocketEventType -> Bool
compare :: WebsocketEventType -> WebsocketEventType -> Ordering
$ccompare :: WebsocketEventType -> WebsocketEventType -> Ordering
$cp1Ord :: Eq WebsocketEventType
Ord)

instance FromJSON WebsocketEventType where
  parseJSON :: Value -> Parser WebsocketEventType
parseJSON = String
-> (Text -> Parser WebsocketEventType)
-> Value
-> Parser WebsocketEventType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"event type" ((Text -> Parser WebsocketEventType)
 -> Value -> Parser WebsocketEventType)
-> (Text -> Parser WebsocketEventType)
-> Value
-> Parser WebsocketEventType
forall a b. (a -> b) -> a -> b
$ \Text
s -> case Text
s of
    Text
"typing"             -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMTyping
    Text
"posted"             -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPosted
    Text
"post_edited"        -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPostEdited
    Text
"post_deleted"       -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPostDeleted
    Text
"channel_deleted"    -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelDeleted
    Text
"direct_added"       -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMDirectAdded
    Text
"new_user"           -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMNewUser
    Text
"leave_team"         -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMLeaveTeam
    Text
"user_added"         -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserAdded
    Text
"user_updated"       -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserUpdated
    Text
"user_removed"       -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserRemoved
    Text
"preferences_changed" -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPreferenceChanged
    Text
"ephemeral_message"  -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMEphemeralMessage
    Text
"status_change"      -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMStatusChange
    Text
"hello"              -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMHello
    Text
"update_team"        -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUpdateTeam
    Text
"delete_team"        -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMTeamDeleted
    Text
"reaction_added"     -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMReactionAdded
    Text
"reaction_removed"   -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMReactionRemoved
    Text
"channel_created"    -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelCreated
    Text
"group_added"        -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMGroupAdded
    Text
"added_to_team"      -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMAddedToTeam
    Text
"webrtc"             -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMWebRTC
    Text
"authentication_challenge" -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMAuthenticationChallenge
    Text
"preferences_deleted" -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPreferenceDeleted
    Text
"channel_viewed"     -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelViewed
    Text
"channel_updated"    -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelUpdated
    Text
"channel_member_updated" -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelMemberUpdated
    Text
"emoji_added"        -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMEmojiAdded
    Text
"user_role_updated"  -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserRoleUpdated
    Text
"plugin_statuses_changed" -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPluginStatusesChanged
    Text
"plugin_enabled"     -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPluginEnabled
    Text
"plugin_disabled"    -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPluginDisabled
    Text
_                    -> WebsocketEventType -> Parser WebsocketEventType
forall (m :: * -> *) a. Monad m => a -> m a
return (WebsocketEventType -> Parser WebsocketEventType)
-> WebsocketEventType -> Parser WebsocketEventType
forall a b. (a -> b) -> a -> b
$ Text -> WebsocketEventType
WMUnknownEvent Text
s

instance ToJSON WebsocketEventType where
  toJSON :: WebsocketEventType -> Value
toJSON WebsocketEventType
WMTyping                  = Value
"typing"
  toJSON WebsocketEventType
WMPosted                  = Value
"posted"
  toJSON WebsocketEventType
WMPostEdited              = Value
"post_edited"
  toJSON WebsocketEventType
WMPostDeleted             = Value
"post_deleted"
  toJSON WebsocketEventType
WMChannelDeleted          = Value
"channel_deleted"
  toJSON WebsocketEventType
WMDirectAdded             = Value
"direct_added"
  toJSON WebsocketEventType
WMNewUser                 = Value
"new_user"
  toJSON WebsocketEventType
WMLeaveTeam               = Value
"leave_team"
  toJSON WebsocketEventType
WMUserAdded               = Value
"user_added"
  toJSON WebsocketEventType
WMUserUpdated             = Value
"user_updated"
  toJSON WebsocketEventType
WMUserRemoved             = Value
"user_removed"
  toJSON WebsocketEventType
WMPreferenceChanged       = Value
"preferences_changed"
  toJSON WebsocketEventType
WMPreferenceDeleted       = Value
"preferences_deleted"
  toJSON WebsocketEventType
WMEphemeralMessage        = Value
"ephemeral_message"
  toJSON WebsocketEventType
WMStatusChange            = Value
"status_change"
  toJSON WebsocketEventType
WMHello                   = Value
"hello"
  toJSON WebsocketEventType
WMUpdateTeam              = Value
"update_team"
  toJSON WebsocketEventType
WMTeamDeleted             = Value
"delete_team"
  toJSON WebsocketEventType
WMReactionAdded           = Value
"reaction_added"
  toJSON WebsocketEventType
WMReactionRemoved         = Value
"reaction_removed"
  toJSON WebsocketEventType
WMChannelCreated          = Value
"channel_created"
  toJSON WebsocketEventType
WMGroupAdded              = Value
"group_added"
  toJSON WebsocketEventType
WMAddedToTeam             = Value
"added_to_team"
  toJSON WebsocketEventType
WMWebRTC                  = Value
"webrtc"
  toJSON WebsocketEventType
WMAuthenticationChallenge = Value
"authentication_challenge"
  toJSON WebsocketEventType
WMChannelViewed           = Value
"channel_viewed"
  toJSON WebsocketEventType
WMChannelUpdated          = Value
"channel_updated"
  toJSON WebsocketEventType
WMChannelMemberUpdated    = Value
"channel_member_updated"
  toJSON WebsocketEventType
WMEmojiAdded              = Value
"emoji_added"
  toJSON WebsocketEventType
WMUserRoleUpdated         = Value
"user_role_updated"
  toJSON WebsocketEventType
WMPluginStatusesChanged   = Value
"plugin_statuses_changed"
  toJSON WebsocketEventType
WMPluginEnabled           = Value
"plugin_enabled"
  toJSON WebsocketEventType
WMPluginDisabled          = Value
"plugin_disabled"
  toJSON (WMUnknownEvent Text
s)        = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s

--

toValueString :: ToJSON a => a -> A.Value
toValueString :: a -> Value
toValueString a
v =  Text -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString -> Text
decodeUtf8 (ByteString -> ByteString
toStrict (a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
v)))

fromValueString :: FromJSON a => A.Value -> A.Parser a
fromValueString :: Value -> Parser a
fromValueString = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"string-encoded json" ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Text
s -> do
    case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (ByteString -> ByteString
fromStrict (Text -> ByteString
encodeUtf8 Text
s)) of
      Right a
v  -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
      Left String
err -> JSONDecodeException -> Parser a
forall a e. Exception e => e -> a
throw (String -> String -> JSONDecodeException
JSONDecodeException String
err (Text -> String
T.unpack Text
s))

--

data WebsocketEvent = WebsocketEvent
  { WebsocketEvent -> WebsocketEventType
weEvent     :: WebsocketEventType
  , WebsocketEvent -> WEData
weData      :: WEData
  , WebsocketEvent -> WEBroadcast
weBroadcast :: WEBroadcast
  , WebsocketEvent -> Int64
weSeq       :: Int64
  } deriving (ReadPrec [WebsocketEvent]
ReadPrec WebsocketEvent
Int -> ReadS WebsocketEvent
ReadS [WebsocketEvent]
(Int -> ReadS WebsocketEvent)
-> ReadS [WebsocketEvent]
-> ReadPrec WebsocketEvent
-> ReadPrec [WebsocketEvent]
-> Read WebsocketEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsocketEvent]
$creadListPrec :: ReadPrec [WebsocketEvent]
readPrec :: ReadPrec WebsocketEvent
$creadPrec :: ReadPrec WebsocketEvent
readList :: ReadS [WebsocketEvent]
$creadList :: ReadS [WebsocketEvent]
readsPrec :: Int -> ReadS WebsocketEvent
$creadsPrec :: Int -> ReadS WebsocketEvent
Read, Int -> WebsocketEvent -> ShowS
[WebsocketEvent] -> ShowS
WebsocketEvent -> String
(Int -> WebsocketEvent -> ShowS)
-> (WebsocketEvent -> String)
-> ([WebsocketEvent] -> ShowS)
-> Show WebsocketEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketEvent] -> ShowS
$cshowList :: [WebsocketEvent] -> ShowS
show :: WebsocketEvent -> String
$cshow :: WebsocketEvent -> String
showsPrec :: Int -> WebsocketEvent -> ShowS
$cshowsPrec :: Int -> WebsocketEvent -> ShowS
Show, WebsocketEvent -> WebsocketEvent -> Bool
(WebsocketEvent -> WebsocketEvent -> Bool)
-> (WebsocketEvent -> WebsocketEvent -> Bool) -> Eq WebsocketEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsocketEvent -> WebsocketEvent -> Bool
$c/= :: WebsocketEvent -> WebsocketEvent -> Bool
== :: WebsocketEvent -> WebsocketEvent -> Bool
$c== :: WebsocketEvent -> WebsocketEvent -> Bool
Eq)

instance FromJSON WebsocketEvent where
  parseJSON :: Value -> Parser WebsocketEvent
parseJSON = String
-> (Object -> Parser WebsocketEvent)
-> Value
-> Parser WebsocketEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebsocketEvent" ((Object -> Parser WebsocketEvent)
 -> Value -> Parser WebsocketEvent)
-> (Object -> Parser WebsocketEvent)
-> Value
-> Parser WebsocketEvent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    WebsocketEventType
weEvent     <- Object
o Object -> Text -> Parser WebsocketEventType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event"
    WEData
weData      <- Object
o Object -> Text -> Parser WEData
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data"
    WEBroadcast
weBroadcast <- Object
o Object -> Text -> Parser WEBroadcast
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"broadcast"
    Int64
weSeq       <- Object
o Object -> Text -> Parser Int64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"seq"
    WebsocketEvent -> Parser WebsocketEvent
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEvent :: WebsocketEventType
-> WEData -> WEBroadcast -> Int64 -> WebsocketEvent
WebsocketEvent { Int64
WEBroadcast
WEData
WebsocketEventType
weSeq :: Int64
weBroadcast :: WEBroadcast
weData :: WEData
weEvent :: WebsocketEventType
weSeq :: Int64
weBroadcast :: WEBroadcast
weData :: WEData
weEvent :: WebsocketEventType
.. }

instance ToJSON WebsocketEvent where
  toJSON :: WebsocketEvent -> Value
toJSON WebsocketEvent { Int64
WEBroadcast
WEData
WebsocketEventType
weSeq :: Int64
weBroadcast :: WEBroadcast
weData :: WEData
weEvent :: WebsocketEventType
weSeq :: WebsocketEvent -> Int64
weBroadcast :: WebsocketEvent -> WEBroadcast
weData :: WebsocketEvent -> WEData
weEvent :: WebsocketEvent -> WebsocketEventType
.. } = [Pair] -> Value
A.object
    [ Text
"event"      Text -> WebsocketEventType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WebsocketEventType
weEvent
    , Text
"data"       Text -> WEData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WEData
weData
    , Text
"broadcast"  Text -> WEBroadcast -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WEBroadcast
weBroadcast
    , Text
"seq"        Text -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int64
weSeq
    ]

instance WebSocketsData WebsocketEvent where
  fromDataMessage :: DataMessage -> WebsocketEvent
fromDataMessage (WS.Text ByteString
bs Maybe Text
_) = ByteString -> WebsocketEvent
forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromDataMessage (WS.Binary ByteString
bs) = ByteString -> WebsocketEvent
forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromLazyByteString :: ByteString -> WebsocketEvent
fromLazyByteString ByteString
s = case ByteString -> Either String WebsocketEvent
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
s of
    Left String
err -> JSONDecodeException -> WebsocketEvent
forall a e. Exception e => e -> a
throw (String -> String -> JSONDecodeException
JSONDecodeException String
err (ByteString -> String
BC.unpack ByteString
s))
    Right WebsocketEvent
v  -> WebsocketEvent
v
  toLazyByteString :: WebsocketEvent -> ByteString
toLazyByteString = WebsocketEvent -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode

--

data WEData = WEData
  { WEData -> Maybe ChannelId
wepChannelId          :: Maybe ChannelId
  , WEData -> Maybe TeamId
wepTeamId             :: Maybe TeamId
  , WEData -> Maybe Text
wepSenderName         :: Maybe Text
  , WEData -> Maybe UserId
wepUserId             :: Maybe UserId
  , WEData -> Maybe User
wepUser               :: Maybe User
  , WEData -> Maybe Text
wepChannelDisplayName :: Maybe Text
  , WEData -> Maybe Post
wepPost               :: Maybe Post
  , WEData -> Maybe Text
wepStatus             :: Maybe Text
  , WEData -> Maybe Reaction
wepReaction           :: Maybe Reaction
  , WEData -> Maybe (Set UserId)
wepMentions           :: Maybe (Set UserId)
  , WEData -> Maybe (Seq Preference)
wepPreferences        :: Maybe (Seq Preference)
  , WEData -> Maybe ChannelMember
wepChannelMember      :: Maybe ChannelMember
  } deriving (ReadPrec [WEData]
ReadPrec WEData
Int -> ReadS WEData
ReadS [WEData]
(Int -> ReadS WEData)
-> ReadS [WEData]
-> ReadPrec WEData
-> ReadPrec [WEData]
-> Read WEData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WEData]
$creadListPrec :: ReadPrec [WEData]
readPrec :: ReadPrec WEData
$creadPrec :: ReadPrec WEData
readList :: ReadS [WEData]
$creadList :: ReadS [WEData]
readsPrec :: Int -> ReadS WEData
$creadsPrec :: Int -> ReadS WEData
Read, Int -> WEData -> ShowS
[WEData] -> ShowS
WEData -> String
(Int -> WEData -> ShowS)
-> (WEData -> String) -> ([WEData] -> ShowS) -> Show WEData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WEData] -> ShowS
$cshowList :: [WEData] -> ShowS
show :: WEData -> String
$cshow :: WEData -> String
showsPrec :: Int -> WEData -> ShowS
$cshowsPrec :: Int -> WEData -> ShowS
Show, WEData -> WEData -> Bool
(WEData -> WEData -> Bool)
-> (WEData -> WEData -> Bool) -> Eq WEData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WEData -> WEData -> Bool
$c/= :: WEData -> WEData -> Bool
== :: WEData -> WEData -> Bool
$c== :: WEData -> WEData -> Bool
Eq)

instance FromJSON WEData where
  parseJSON :: Value -> Parser WEData
parseJSON = String -> (Object -> Parser WEData) -> Value -> Parser WEData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebSocketEvent Data" ((Object -> Parser WEData) -> Value -> Parser WEData)
-> (Object -> Parser WEData) -> Value -> Parser WEData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe ChannelId
wepChannelId          <- Parser ChannelId -> Parser (Maybe ChannelId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id")
    Maybe TeamId
wepTeamId             <- Parser TeamId -> Parser (Maybe TeamId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
o Object -> Text -> Parser TeamId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"team_id")
    Maybe Text
wepSenderName         <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"sender_name"
    Maybe UserId
wepUserId             <- Object
o Object -> Text -> Parser (Maybe UserId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"user_id"
    Maybe User
wepUser               <- Object
o Object -> Text -> Parser (Maybe User)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"user"
    Maybe Text
wepChannelDisplayName <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channel_name"
    Maybe Post
wepPost               <- (Value -> Parser Post) -> Maybe Value -> Parser (Maybe Post)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Post
forall a. FromJSON a => Value -> Parser a
fromValueString (Maybe Value -> Parser (Maybe Post))
-> Parser (Maybe Value) -> Parser (Maybe Post)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"post"
    Maybe Text
wepStatus             <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"status"
    Maybe Reaction
wepReaction           <- (Value -> Parser Reaction)
-> Maybe Value -> Parser (Maybe Reaction)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Reaction
forall a. FromJSON a => Value -> Parser a
fromValueString (Maybe Value -> Parser (Maybe Reaction))
-> Parser (Maybe Value) -> Parser (Maybe Reaction)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"reaction"
    Maybe (Set UserId)
wepMentions           <- (Value -> Parser (Set UserId))
-> Maybe Value -> Parser (Maybe (Set UserId))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser (Set UserId)
forall a. FromJSON a => Value -> Parser a
fromValueString (Maybe Value -> Parser (Maybe (Set UserId)))
-> Parser (Maybe Value) -> Parser (Maybe (Set UserId))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"mentions"
    Maybe (Seq Preference)
wepPreferences        <- (Value -> Parser (Seq Preference))
-> Maybe Value -> Parser (Maybe (Seq Preference))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser (Seq Preference)
forall a. FromJSON a => Value -> Parser a
fromValueString (Maybe Value -> Parser (Maybe (Seq Preference)))
-> Parser (Maybe Value) -> Parser (Maybe (Seq Preference))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"preferences"
    Maybe ChannelMember
wepChannelMember      <- (Value -> Parser ChannelMember)
-> Maybe Value -> Parser (Maybe ChannelMember)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser ChannelMember
forall a. FromJSON a => Value -> Parser a
fromValueString (Maybe Value -> Parser (Maybe ChannelMember))
-> Parser (Maybe Value) -> Parser (Maybe ChannelMember)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"channelMember"
    WEData -> Parser WEData
forall (m :: * -> *) a. Monad m => a -> m a
return WEData :: Maybe ChannelId
-> Maybe TeamId
-> Maybe Text
-> Maybe UserId
-> Maybe User
-> Maybe Text
-> Maybe Post
-> Maybe Text
-> Maybe Reaction
-> Maybe (Set UserId)
-> Maybe (Seq Preference)
-> Maybe ChannelMember
-> WEData
WEData { Maybe Text
Maybe (Seq Preference)
Maybe (Set UserId)
Maybe ChannelMember
Maybe Reaction
Maybe Post
Maybe User
Maybe UserId
Maybe ChannelId
Maybe TeamId
wepChannelMember :: Maybe ChannelMember
wepPreferences :: Maybe (Seq Preference)
wepMentions :: Maybe (Set UserId)
wepReaction :: Maybe Reaction
wepStatus :: Maybe Text
wepPost :: Maybe Post
wepChannelDisplayName :: Maybe Text
wepUser :: Maybe User
wepUserId :: Maybe UserId
wepSenderName :: Maybe Text
wepTeamId :: Maybe TeamId
wepChannelId :: Maybe ChannelId
wepChannelMember :: Maybe ChannelMember
wepPreferences :: Maybe (Seq Preference)
wepMentions :: Maybe (Set UserId)
wepReaction :: Maybe Reaction
wepStatus :: Maybe Text
wepPost :: Maybe Post
wepChannelDisplayName :: Maybe Text
wepUser :: Maybe User
wepUserId :: Maybe UserId
wepSenderName :: Maybe Text
wepTeamId :: Maybe TeamId
wepChannelId :: Maybe ChannelId
.. }

instance ToJSON WEData where
  toJSON :: WEData -> Value
toJSON WEData { Maybe Text
Maybe (Seq Preference)
Maybe (Set UserId)
Maybe ChannelMember
Maybe Reaction
Maybe Post
Maybe User
Maybe UserId
Maybe ChannelId
Maybe TeamId
wepChannelMember :: Maybe ChannelMember
wepPreferences :: Maybe (Seq Preference)
wepMentions :: Maybe (Set UserId)
wepReaction :: Maybe Reaction
wepStatus :: Maybe Text
wepPost :: Maybe Post
wepChannelDisplayName :: Maybe Text
wepUser :: Maybe User
wepUserId :: Maybe UserId
wepSenderName :: Maybe Text
wepTeamId :: Maybe TeamId
wepChannelId :: Maybe ChannelId
wepChannelMember :: WEData -> Maybe ChannelMember
wepPreferences :: WEData -> Maybe (Seq Preference)
wepMentions :: WEData -> Maybe (Set UserId)
wepReaction :: WEData -> Maybe Reaction
wepStatus :: WEData -> Maybe Text
wepPost :: WEData -> Maybe Post
wepChannelDisplayName :: WEData -> Maybe Text
wepUser :: WEData -> Maybe User
wepUserId :: WEData -> Maybe UserId
wepSenderName :: WEData -> Maybe Text
wepTeamId :: WEData -> Maybe TeamId
wepChannelId :: WEData -> Maybe ChannelId
.. } = [Pair] -> Value
A.object
    [ Text
"channel_id"   Text -> Maybe ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ChannelId
wepChannelId
    , Text
"team_id"      Text -> Maybe TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe TeamId
wepTeamId
    , Text
"sender_name"  Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
wepSenderName
    , Text
"user_id"      Text -> Maybe UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe UserId
wepUserId
    , Text
"channel_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
wepChannelDisplayName
    , Text
"post"         Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Post -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe Post
wepPost
    , Text
"reaction"     Text -> Maybe Reaction -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Reaction
wepReaction
    , Text
"mentions"     Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Set UserId) -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe (Set UserId)
wepMentions
    , Text
"preferences"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Seq Preference) -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe (Seq Preference)
wepPreferences
    , Text
"channelMember" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ChannelMember -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe ChannelMember
wepChannelMember
    ]

--

data WEBroadcast = WEBroadcast
  { WEBroadcast -> Maybe ChannelId
webChannelId :: Maybe ChannelId
  , WEBroadcast -> Maybe UserId
webUserId    :: Maybe UserId
  , WEBroadcast -> Maybe TeamId
webTeamId    :: Maybe TeamId
  , WEBroadcast -> Maybe (HashMap UserId Bool)
webOmitUsers :: Maybe (HM.HashMap UserId Bool)
  } deriving (ReadPrec [WEBroadcast]
ReadPrec WEBroadcast
Int -> ReadS WEBroadcast
ReadS [WEBroadcast]
(Int -> ReadS WEBroadcast)
-> ReadS [WEBroadcast]
-> ReadPrec WEBroadcast
-> ReadPrec [WEBroadcast]
-> Read WEBroadcast
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WEBroadcast]
$creadListPrec :: ReadPrec [WEBroadcast]
readPrec :: ReadPrec WEBroadcast
$creadPrec :: ReadPrec WEBroadcast
readList :: ReadS [WEBroadcast]
$creadList :: ReadS [WEBroadcast]
readsPrec :: Int -> ReadS WEBroadcast
$creadsPrec :: Int -> ReadS WEBroadcast
Read, Int -> WEBroadcast -> ShowS
[WEBroadcast] -> ShowS
WEBroadcast -> String
(Int -> WEBroadcast -> ShowS)
-> (WEBroadcast -> String)
-> ([WEBroadcast] -> ShowS)
-> Show WEBroadcast
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WEBroadcast] -> ShowS
$cshowList :: [WEBroadcast] -> ShowS
show :: WEBroadcast -> String
$cshow :: WEBroadcast -> String
showsPrec :: Int -> WEBroadcast -> ShowS
$cshowsPrec :: Int -> WEBroadcast -> ShowS
Show, WEBroadcast -> WEBroadcast -> Bool
(WEBroadcast -> WEBroadcast -> Bool)
-> (WEBroadcast -> WEBroadcast -> Bool) -> Eq WEBroadcast
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WEBroadcast -> WEBroadcast -> Bool
$c/= :: WEBroadcast -> WEBroadcast -> Bool
== :: WEBroadcast -> WEBroadcast -> Bool
$c== :: WEBroadcast -> WEBroadcast -> Bool
Eq)

nullable :: Alternative f => f a -> f (Maybe a)
nullable :: f a -> f (Maybe a)
nullable f a
p = (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p) f (Maybe a) -> f (Maybe a) -> f (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> f (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

instance FromJSON WEBroadcast where
  parseJSON :: Value -> Parser WEBroadcast
parseJSON = String
-> (Object -> Parser WEBroadcast) -> Value -> Parser WEBroadcast
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebSocketEvent Broadcast" ((Object -> Parser WEBroadcast) -> Value -> Parser WEBroadcast)
-> (Object -> Parser WEBroadcast) -> Value -> Parser WEBroadcast
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe ChannelId
webChannelId <- Parser ChannelId -> Parser (Maybe ChannelId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id")
    Maybe TeamId
webTeamId    <- Parser TeamId -> Parser (Maybe TeamId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Text -> Parser TeamId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"team_id")
    Maybe UserId
webUserId    <- Parser UserId -> Parser (Maybe UserId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id")
    Maybe (HashMap UserId Bool)
webOmitUsers <- Parser (HashMap UserId Bool)
-> Parser (Maybe (HashMap UserId Bool))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Text -> Parser (HashMap UserId Bool)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"omit_users")
    WEBroadcast -> Parser WEBroadcast
forall (m :: * -> *) a. Monad m => a -> m a
return WEBroadcast :: Maybe ChannelId
-> Maybe UserId
-> Maybe TeamId
-> Maybe (HashMap UserId Bool)
-> WEBroadcast
WEBroadcast { Maybe (HashMap UserId Bool)
Maybe UserId
Maybe ChannelId
Maybe TeamId
webOmitUsers :: Maybe (HashMap UserId Bool)
webUserId :: Maybe UserId
webTeamId :: Maybe TeamId
webChannelId :: Maybe ChannelId
webOmitUsers :: Maybe (HashMap UserId Bool)
webTeamId :: Maybe TeamId
webUserId :: Maybe UserId
webChannelId :: Maybe ChannelId
.. }

instance ToJSON WEBroadcast where
  toJSON :: WEBroadcast -> Value
toJSON WEBroadcast { Maybe (HashMap UserId Bool)
Maybe UserId
Maybe ChannelId
Maybe TeamId
webOmitUsers :: Maybe (HashMap UserId Bool)
webTeamId :: Maybe TeamId
webUserId :: Maybe UserId
webChannelId :: Maybe ChannelId
webOmitUsers :: WEBroadcast -> Maybe (HashMap UserId Bool)
webTeamId :: WEBroadcast -> Maybe TeamId
webUserId :: WEBroadcast -> Maybe UserId
webChannelId :: WEBroadcast -> Maybe ChannelId
.. } = [Pair] -> Value
A.object
    [ Text
"channel_id" Text -> Maybe ChannelId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ChannelId
webChannelId
    , Text
"team_id"    Text -> Maybe TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe TeamId
webTeamId
    , Text
"user_id"    Text -> Maybe UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe UserId
webUserId
    , Text
"omit_users" Text -> Maybe (HashMap UserId Bool) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (HashMap UserId Bool)
webOmitUsers
    ]

--

data WebsocketAction =
    UserTyping { WebsocketAction -> Int64
waSeq          :: Int64
               , WebsocketAction -> ChannelId
waChannelId    :: ChannelId
               , WebsocketAction -> Maybe PostId
waParentPostId :: Maybe PostId
               }
  -- --  | GetStatuses { waSeq :: Int64 }
  -- --  | GetStatusesByIds { waSeq :: Int64, waUserIds :: [UserId] }
  deriving (ReadPrec [WebsocketAction]
ReadPrec WebsocketAction
Int -> ReadS WebsocketAction
ReadS [WebsocketAction]
(Int -> ReadS WebsocketAction)
-> ReadS [WebsocketAction]
-> ReadPrec WebsocketAction
-> ReadPrec [WebsocketAction]
-> Read WebsocketAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsocketAction]
$creadListPrec :: ReadPrec [WebsocketAction]
readPrec :: ReadPrec WebsocketAction
$creadPrec :: ReadPrec WebsocketAction
readList :: ReadS [WebsocketAction]
$creadList :: ReadS [WebsocketAction]
readsPrec :: Int -> ReadS WebsocketAction
$creadsPrec :: Int -> ReadS WebsocketAction
Read, Int -> WebsocketAction -> ShowS
[WebsocketAction] -> ShowS
WebsocketAction -> String
(Int -> WebsocketAction -> ShowS)
-> (WebsocketAction -> String)
-> ([WebsocketAction] -> ShowS)
-> Show WebsocketAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketAction] -> ShowS
$cshowList :: [WebsocketAction] -> ShowS
show :: WebsocketAction -> String
$cshow :: WebsocketAction -> String
showsPrec :: Int -> WebsocketAction -> ShowS
$cshowsPrec :: Int -> WebsocketAction -> ShowS
Show, WebsocketAction -> WebsocketAction -> Bool
(WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> Eq WebsocketAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsocketAction -> WebsocketAction -> Bool
$c/= :: WebsocketAction -> WebsocketAction -> Bool
== :: WebsocketAction -> WebsocketAction -> Bool
$c== :: WebsocketAction -> WebsocketAction -> Bool
Eq, Eq WebsocketAction
Eq WebsocketAction
-> (WebsocketAction -> WebsocketAction -> Ordering)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> WebsocketAction)
-> (WebsocketAction -> WebsocketAction -> WebsocketAction)
-> Ord WebsocketAction
WebsocketAction -> WebsocketAction -> Bool
WebsocketAction -> WebsocketAction -> Ordering
WebsocketAction -> WebsocketAction -> WebsocketAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebsocketAction -> WebsocketAction -> WebsocketAction
$cmin :: WebsocketAction -> WebsocketAction -> WebsocketAction
max :: WebsocketAction -> WebsocketAction -> WebsocketAction
$cmax :: WebsocketAction -> WebsocketAction -> WebsocketAction
>= :: WebsocketAction -> WebsocketAction -> Bool
$c>= :: WebsocketAction -> WebsocketAction -> Bool
> :: WebsocketAction -> WebsocketAction -> Bool
$c> :: WebsocketAction -> WebsocketAction -> Bool
<= :: WebsocketAction -> WebsocketAction -> Bool
$c<= :: WebsocketAction -> WebsocketAction -> Bool
< :: WebsocketAction -> WebsocketAction -> Bool
$c< :: WebsocketAction -> WebsocketAction -> Bool
compare :: WebsocketAction -> WebsocketAction -> Ordering
$ccompare :: WebsocketAction -> WebsocketAction -> Ordering
$cp1Ord :: Eq WebsocketAction
Ord)

instance ToJSON WebsocketAction where
  toJSON :: WebsocketAction -> Value
toJSON (UserTyping Int64
s ChannelId
cId Maybe PostId
pId) = [Pair] -> Value
A.object
    [ Text
"seq"    Text -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int64
s
    , Text
"action" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
"user_typing"
    , Text
"data"   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
A.object
                  [ Text
"channel_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Id -> Text
unId (ChannelId -> Id
forall x. IsId x => x -> Id
toId ChannelId
cId)
                  , Text
"parent_id"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> (PostId -> Text) -> Maybe PostId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Id -> Text
unId (Id -> Text) -> (PostId -> Id) -> PostId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostId -> Id
forall x. IsId x => x -> Id
toId) Maybe PostId
pId
                  ]
    ]

instance WebSocketsData WebsocketAction where
  fromDataMessage :: DataMessage -> WebsocketAction
fromDataMessage DataMessage
_ = String -> WebsocketAction
forall a. HasCallStack => String -> a
error String
"Not implemented"
  fromLazyByteString :: ByteString -> WebsocketAction
fromLazyByteString ByteString
_ = String -> WebsocketAction
forall a. HasCallStack => String -> a
error String
"Not implemented"
  toLazyByteString :: WebsocketAction -> ByteString
toLazyByteString = WebsocketAction -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode

data WebsocketActionStatus =
    WebsocketActionStatusOK
    deriving (ReadPrec [WebsocketActionStatus]
ReadPrec WebsocketActionStatus
Int -> ReadS WebsocketActionStatus
ReadS [WebsocketActionStatus]
(Int -> ReadS WebsocketActionStatus)
-> ReadS [WebsocketActionStatus]
-> ReadPrec WebsocketActionStatus
-> ReadPrec [WebsocketActionStatus]
-> Read WebsocketActionStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsocketActionStatus]
$creadListPrec :: ReadPrec [WebsocketActionStatus]
readPrec :: ReadPrec WebsocketActionStatus
$creadPrec :: ReadPrec WebsocketActionStatus
readList :: ReadS [WebsocketActionStatus]
$creadList :: ReadS [WebsocketActionStatus]
readsPrec :: Int -> ReadS WebsocketActionStatus
$creadsPrec :: Int -> ReadS WebsocketActionStatus
Read, Int -> WebsocketActionStatus -> ShowS
[WebsocketActionStatus] -> ShowS
WebsocketActionStatus -> String
(Int -> WebsocketActionStatus -> ShowS)
-> (WebsocketActionStatus -> String)
-> ([WebsocketActionStatus] -> ShowS)
-> Show WebsocketActionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketActionStatus] -> ShowS
$cshowList :: [WebsocketActionStatus] -> ShowS
show :: WebsocketActionStatus -> String
$cshow :: WebsocketActionStatus -> String
showsPrec :: Int -> WebsocketActionStatus -> ShowS
$cshowsPrec :: Int -> WebsocketActionStatus -> ShowS
Show, WebsocketActionStatus -> WebsocketActionStatus -> Bool
(WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> (WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> Eq WebsocketActionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c/= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
== :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c== :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
Eq, Eq WebsocketActionStatus
Eq WebsocketActionStatus
-> (WebsocketActionStatus -> WebsocketActionStatus -> Ordering)
-> (WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> (WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> (WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> (WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> (WebsocketActionStatus
    -> WebsocketActionStatus -> WebsocketActionStatus)
-> (WebsocketActionStatus
    -> WebsocketActionStatus -> WebsocketActionStatus)
-> Ord WebsocketActionStatus
WebsocketActionStatus -> WebsocketActionStatus -> Bool
WebsocketActionStatus -> WebsocketActionStatus -> Ordering
WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
$cmin :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
max :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
$cmax :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
>= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c>= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
> :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c> :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
<= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c<= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
< :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c< :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
compare :: WebsocketActionStatus -> WebsocketActionStatus -> Ordering
$ccompare :: WebsocketActionStatus -> WebsocketActionStatus -> Ordering
$cp1Ord :: Eq WebsocketActionStatus
Ord)

instance FromJSON WebsocketActionStatus where
    parseJSON :: Value -> Parser WebsocketActionStatus
parseJSON = String
-> (Text -> Parser WebsocketActionStatus)
-> Value
-> Parser WebsocketActionStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebsocketActionStatus" ((Text -> Parser WebsocketActionStatus)
 -> Value -> Parser WebsocketActionStatus)
-> (Text -> Parser WebsocketActionStatus)
-> Value
-> Parser WebsocketActionStatus
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Text
t of
            Text
"OK" -> WebsocketActionStatus -> Parser WebsocketActionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketActionStatus
WebsocketActionStatusOK
            Text
_ -> String -> Parser WebsocketActionStatus
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser WebsocketActionStatus)
-> String -> Parser WebsocketActionStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid WebsocketActionStatus: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

instance ToJSON WebsocketActionStatus where
    toJSON :: WebsocketActionStatus -> Value
toJSON WebsocketActionStatus
WebsocketActionStatusOK = Value
"OK"

data WebsocketActionResponse =
    WebsocketActionResponse { WebsocketActionResponse -> WebsocketActionStatus
warStatus :: WebsocketActionStatus
                            , WebsocketActionResponse -> Int64
warSeqReply :: Int64
                            }
    deriving (ReadPrec [WebsocketActionResponse]
ReadPrec WebsocketActionResponse
Int -> ReadS WebsocketActionResponse
ReadS [WebsocketActionResponse]
(Int -> ReadS WebsocketActionResponse)
-> ReadS [WebsocketActionResponse]
-> ReadPrec WebsocketActionResponse
-> ReadPrec [WebsocketActionResponse]
-> Read WebsocketActionResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsocketActionResponse]
$creadListPrec :: ReadPrec [WebsocketActionResponse]
readPrec :: ReadPrec WebsocketActionResponse
$creadPrec :: ReadPrec WebsocketActionResponse
readList :: ReadS [WebsocketActionResponse]
$creadList :: ReadS [WebsocketActionResponse]
readsPrec :: Int -> ReadS WebsocketActionResponse
$creadsPrec :: Int -> ReadS WebsocketActionResponse
Read, Int -> WebsocketActionResponse -> ShowS
[WebsocketActionResponse] -> ShowS
WebsocketActionResponse -> String
(Int -> WebsocketActionResponse -> ShowS)
-> (WebsocketActionResponse -> String)
-> ([WebsocketActionResponse] -> ShowS)
-> Show WebsocketActionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketActionResponse] -> ShowS
$cshowList :: [WebsocketActionResponse] -> ShowS
show :: WebsocketActionResponse -> String
$cshow :: WebsocketActionResponse -> String
showsPrec :: Int -> WebsocketActionResponse -> ShowS
$cshowsPrec :: Int -> WebsocketActionResponse -> ShowS
Show, WebsocketActionResponse -> WebsocketActionResponse -> Bool
(WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> (WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> Eq WebsocketActionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c/= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
== :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c== :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
Eq, Eq WebsocketActionResponse
Eq WebsocketActionResponse
-> (WebsocketActionResponse -> WebsocketActionResponse -> Ordering)
-> (WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> (WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> (WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> (WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> (WebsocketActionResponse
    -> WebsocketActionResponse -> WebsocketActionResponse)
-> (WebsocketActionResponse
    -> WebsocketActionResponse -> WebsocketActionResponse)
-> Ord WebsocketActionResponse
WebsocketActionResponse -> WebsocketActionResponse -> Bool
WebsocketActionResponse -> WebsocketActionResponse -> Ordering
WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
$cmin :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
max :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
$cmax :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
>= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c>= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
> :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c> :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
<= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c<= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
< :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c< :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
compare :: WebsocketActionResponse -> WebsocketActionResponse -> Ordering
$ccompare :: WebsocketActionResponse -> WebsocketActionResponse -> Ordering
$cp1Ord :: Eq WebsocketActionResponse
Ord)

instance FromJSON WebsocketActionResponse where
  parseJSON :: Value -> Parser WebsocketActionResponse
parseJSON =
      String
-> (Object -> Parser WebsocketActionResponse)
-> Value
-> Parser WebsocketActionResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebsocketActionResponse" ((Object -> Parser WebsocketActionResponse)
 -> Value -> Parser WebsocketActionResponse)
-> (Object -> Parser WebsocketActionResponse)
-> Value
-> Parser WebsocketActionResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
          WebsocketActionStatus -> Int64 -> WebsocketActionResponse
WebsocketActionResponse (WebsocketActionStatus -> Int64 -> WebsocketActionResponse)
-> Parser WebsocketActionStatus
-> Parser (Int64 -> WebsocketActionResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser WebsocketActionStatus
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"status"
                                  Parser (Int64 -> WebsocketActionResponse)
-> Parser Int64 -> Parser WebsocketActionResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int64
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"seq_reply"

instance ToJSON WebsocketActionResponse where
    toJSON :: WebsocketActionResponse -> Value
toJSON (WebsocketActionResponse WebsocketActionStatus
status Int64
s) =
        [Pair] -> Value
A.object [ Text
"status" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= WebsocketActionStatus -> Value
forall a. ToJSON a => a -> Value
A.toJSON WebsocketActionStatus
status
                 , Text
"seq" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Int64 -> Value
forall a. ToJSON a => a -> Value
A.toJSON Int64
s
                 ]

instance WebSocketsData WebsocketActionResponse where
  fromDataMessage :: DataMessage -> WebsocketActionResponse
fromDataMessage (WS.Text ByteString
bs Maybe Text
_) = ByteString -> WebsocketActionResponse
forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromDataMessage (WS.Binary ByteString
bs) = ByteString -> WebsocketActionResponse
forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromLazyByteString :: ByteString -> WebsocketActionResponse
fromLazyByteString ByteString
s = case ByteString -> Either String WebsocketActionResponse
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
s of
    Left String
err -> JSONDecodeException -> WebsocketActionResponse
forall a e. Exception e => e -> a
throw (String -> String -> JSONDecodeException
JSONDecodeException String
err (ByteString -> String
BC.unpack ByteString
s))
    Right WebsocketActionResponse
v  -> WebsocketActionResponse
v
  toLazyByteString :: WebsocketActionResponse -> ByteString
toLazyByteString = WebsocketActionResponse -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode