{-# 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]
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
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
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
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
Ord)

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

--

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

fromValueString :: FromJSON a => A.Value -> A.Parser a
fromValueString :: forall a. FromJSON a => Value -> Parser a
fromValueString = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"string-encoded json" forall a b. (a -> b) -> a -> b
$ \Text
s -> do
    case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (ByteString -> ByteString
fromStrict (Text -> ByteString
encodeUtf8 Text
s)) of
      Right a
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
      Left String
err -> 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]
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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebsocketEvent" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    WebsocketEventType
weEvent     <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event"
    WEData
weData      <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    WEBroadcast
weBroadcast <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"broadcast"
    Int64
weSeq       <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"seq"
    forall (m :: * -> *) a. Monad m => a -> m a
return 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
    [ Key
"event"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebsocketEventType
weEvent
    , Key
"data"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WEData
weData
    , Key
"broadcast"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WEBroadcast
weBroadcast
    , Key
"seq"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int64
weSeq
    ]

instance WebSocketsData WebsocketEvent where
  fromDataMessage :: DataMessage -> WebsocketEvent
fromDataMessage (WS.Text ByteString
bs Maybe Text
_) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromDataMessage (WS.Binary ByteString
bs) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromLazyByteString :: ByteString -> WebsocketEvent
fromLazyByteString ByteString
s = case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
s of
    Left String
err -> 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 = 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 PostId
wepParentId           :: Maybe PostId
  , 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]
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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebSocketEvent Data" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe ChannelId
wepChannelId          <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id")
    Maybe TeamId
wepTeamId             <- forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"team_id")
    Maybe Text
wepSenderName         <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sender_name"
    Maybe UserId
wepUserId             <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id"
    Maybe PostId
wepParentId           <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent_id")
    Maybe User
wepUser               <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
    Maybe Text
wepChannelDisplayName <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_name"
    Maybe Post
wepPost               <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
fromValueString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"post"
    Maybe Text
wepStatus             <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status"
    Maybe Reaction
wepReaction           <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
fromValueString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reaction"
    Maybe (Set UserId)
wepMentions           <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
fromValueString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mentions"
    Maybe (Seq Preference)
wepPreferences        <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
fromValueString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"preferences"
    Maybe ChannelMember
wepChannelMember      <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
fromValueString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channelMember"
    forall (m :: * -> *) a. Monad m => a -> m a
return WEData { Maybe Text
Maybe (Seq Preference)
Maybe (Set UserId)
Maybe ChannelMember
Maybe Reaction
Maybe Post
Maybe PostId
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
wepParentId :: Maybe PostId
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
wepParentId :: Maybe PostId
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 PostId
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
wepParentId :: Maybe PostId
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
wepParentId :: WEData -> Maybe PostId
wepUserId :: WEData -> Maybe UserId
wepSenderName :: WEData -> Maybe Text
wepTeamId :: WEData -> Maybe TeamId
wepChannelId :: WEData -> Maybe ChannelId
.. } = [Pair] -> Value
A.object
    [ Key
"channel_id"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ChannelId
wepChannelId
    , Key
"team_id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TeamId
wepTeamId
    , Key
"sender_name"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
wepSenderName
    , Key
"user_id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserId
wepUserId
    , Key
"parent_id"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe PostId
wepParentId
    , Key
"channel_name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
wepChannelDisplayName
    , Key
"post"         forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toValueString Maybe Post
wepPost
    , Key
"reaction"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Reaction
wepReaction
    , Key
"mentions"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toValueString Maybe (Set UserId)
wepMentions
    , Key
"preferences"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toValueString Maybe (Seq Preference)
wepPreferences
    , Key
"channelMember" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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]
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
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
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 :: forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable f a
p = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

instance FromJSON WEBroadcast where
  parseJSON :: Value -> Parser WEBroadcast
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"WebSocketEvent Broadcast" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe ChannelId
webChannelId <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id")
    Maybe TeamId
webTeamId    <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"team_id")
    Maybe UserId
webUserId    <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id")
    Maybe (HashMap UserId Bool)
webOmitUsers <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"omit_users")
    forall (m :: * -> *) a. Monad m => a -> m a
return 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
    [ Key
"channel_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ChannelId
webChannelId
    , Key
"team_id"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TeamId
webTeamId
    , Key
"user_id"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe UserId
webUserId
    , Key
"omit_users" forall kv v. (KeyValue kv, ToJSON v) => Key -> 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]
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
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
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
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
Ord)

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

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

data WebsocketActionStatus =
    WebsocketActionStatusOK
    deriving (ReadPrec [WebsocketActionStatus]
ReadPrec WebsocketActionStatus
Int -> ReadS WebsocketActionStatus
ReadS [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
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
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
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
Ord)

instance FromJSON WebsocketActionStatus where
    parseJSON :: Value -> Parser WebsocketActionStatus
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"WebsocketActionStatus" forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Text
t of
            Text
"OK" -> forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketActionStatus
WebsocketActionStatusOK
            Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid WebsocketActionStatus: " forall a. Semigroup a => a -> a -> a
<> 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]
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
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
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
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
Ord)

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

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

instance WebSocketsData WebsocketActionResponse where
  fromDataMessage :: DataMessage -> WebsocketActionResponse
fromDataMessage (WS.Text ByteString
bs Maybe Text
_) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromDataMessage (WS.Binary ByteString
bs) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bs
  fromLazyByteString :: ByteString -> WebsocketActionResponse
fromLazyByteString ByteString
s = case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
s of
    Left String
err -> 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 = forall a. ToJSON a => a -> ByteString
A.encode