{-# 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           Control.Monad ( forM )
import           Data.Aeson ( FromJSON(..)
                            , ToJSON(..)
                            , (.:)
                            , (.:?)
                            , (.=)
                            )
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as A
import qualified Data.Aeson.KeyMap 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
  | WMMultipleChannelsViewed
  | 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
$creadsPrec :: Int -> ReadS WebsocketEventType
readsPrec :: Int -> ReadS WebsocketEventType
$creadList :: ReadS [WebsocketEventType]
readList :: ReadS [WebsocketEventType]
$creadPrec :: ReadPrec WebsocketEventType
readPrec :: ReadPrec WebsocketEventType
$creadListPrec :: ReadPrec [WebsocketEventType]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WebsocketEventType -> ShowS
showsPrec :: Int -> WebsocketEventType -> ShowS
$cshow :: WebsocketEventType -> String
show :: WebsocketEventType -> String
$cshowList :: [WebsocketEventType] -> ShowS
showList :: [WebsocketEventType] -> ShowS
Show, WebsocketEventType -> WebsocketEventType -> Bool
(WebsocketEventType -> WebsocketEventType -> Bool)
-> (WebsocketEventType -> WebsocketEventType -> Bool)
-> Eq WebsocketEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebsocketEventType -> WebsocketEventType -> Bool
== :: WebsocketEventType -> WebsocketEventType -> Bool
$c/= :: WebsocketEventType -> WebsocketEventType -> Bool
/= :: 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
$ccompare :: WebsocketEventType -> WebsocketEventType -> Ordering
compare :: WebsocketEventType -> WebsocketEventType -> Ordering
$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
>= :: WebsocketEventType -> WebsocketEventType -> Bool
$cmax :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
max :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
$cmin :: WebsocketEventType -> WebsocketEventType -> WebsocketEventType
min :: WebsocketEventType -> WebsocketEventType -> 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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMTyping
    Text
"posted"             -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPosted
    Text
"post_edited"        -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPostEdited
    Text
"post_deleted"       -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPostDeleted
    Text
"channel_deleted"    -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelDeleted
    Text
"direct_added"       -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMDirectAdded
    Text
"new_user"           -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMNewUser
    Text
"leave_team"         -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMLeaveTeam
    Text
"user_added"         -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserAdded
    Text
"user_updated"       -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserUpdated
    Text
"user_removed"       -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserRemoved
    Text
"preferences_changed" -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPreferenceChanged
    Text
"ephemeral_message"  -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMEphemeralMessage
    Text
"status_change"      -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMStatusChange
    Text
"hello"              -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMHello
    Text
"update_team"        -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUpdateTeam
    Text
"delete_team"        -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMTeamDeleted
    Text
"reaction_added"     -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMReactionAdded
    Text
"reaction_removed"   -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMReactionRemoved
    Text
"channel_created"    -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelCreated
    Text
"group_added"        -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMGroupAdded
    Text
"added_to_team"      -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMAddedToTeam
    Text
"webrtc"             -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMWebRTC
    Text
"authentication_challenge" -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMAuthenticationChallenge
    Text
"preferences_deleted" -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPreferenceDeleted
    Text
"channel_viewed"     -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelViewed
    Text
"multiple_channels_viewed"     -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMMultipleChannelsViewed
    Text
"channel_updated"    -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelUpdated
    Text
"channel_member_updated" -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMChannelMemberUpdated
    Text
"emoji_added"        -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMEmojiAdded
    Text
"user_role_updated"  -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMUserRoleUpdated
    Text
"plugin_statuses_changed" -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPluginStatusesChanged
    Text
"plugin_enabled"     -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPluginEnabled
    Text
"plugin_disabled"    -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEventType
WMPluginDisabled
    Text
_                    -> WebsocketEventType -> Parser WebsocketEventType
forall a. a -> Parser a
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
WMMultipleChannelsViewed  = Value
"multiple_channels_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 :: forall a. ToJSON a => 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 :: forall a. FromJSON a => 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 a. 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))

fromChannelTimesMap :: A.Value -> A.Parser (HM.HashMap ChannelId ServerTime)
fromChannelTimesMap :: Value -> Parser (HashMap ChannelId ServerTime)
fromChannelTimesMap = String
-> (Object -> Parser (HashMap ChannelId ServerTime))
-> Value
-> Parser (HashMap ChannelId ServerTime)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Channel times map" ((Object -> Parser (HashMap ChannelId ServerTime))
 -> Value -> Parser (HashMap ChannelId ServerTime))
-> (Object -> Parser (HashMap ChannelId ServerTime))
-> Value
-> Parser (HashMap ChannelId ServerTime)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [(ChannelId, ServerTime)]
pairs <- [(Key, Value)]
-> ((Key, Value) -> Parser (ChannelId, ServerTime))
-> Parser [(ChannelId, ServerTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
A.toList Object
o) (((Key, Value) -> Parser (ChannelId, ServerTime))
 -> Parser [(ChannelId, ServerTime)])
-> ((Key, Value) -> Parser (ChannelId, ServerTime))
-> Parser [(ChannelId, ServerTime)]
forall a b. (a -> b) -> a -> b
$ \(Key
k, Value
v) -> do
        ServerTime
t <- Integer -> ServerTime
timeFromServer (Integer -> ServerTime) -> Parser Integer -> Parser ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v
        (ChannelId, ServerTime) -> Parser (ChannelId, ServerTime)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> ChannelId
forall x. IsId x => Id -> x
fromId (Id -> ChannelId) -> Id -> ChannelId
forall a b. (a -> b) -> a -> b
$ Text -> Id
Id (Text -> Id) -> Text -> Id
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Key -> String
A.toString Key
k, ServerTime
t)

    HashMap ChannelId ServerTime
-> Parser (HashMap ChannelId ServerTime)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap ChannelId ServerTime
 -> Parser (HashMap ChannelId ServerTime))
-> HashMap ChannelId ServerTime
-> Parser (HashMap ChannelId ServerTime)
forall a b. (a -> b) -> a -> b
$ [(ChannelId, ServerTime)] -> HashMap ChannelId ServerTime
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(ChannelId, ServerTime)]
pairs

--

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
$creadsPrec :: Int -> ReadS WebsocketEvent
readsPrec :: Int -> ReadS WebsocketEvent
$creadList :: ReadS [WebsocketEvent]
readList :: ReadS [WebsocketEvent]
$creadPrec :: ReadPrec WebsocketEvent
readPrec :: ReadPrec WebsocketEvent
$creadListPrec :: ReadPrec [WebsocketEvent]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WebsocketEvent -> ShowS
showsPrec :: Int -> WebsocketEvent -> ShowS
$cshow :: WebsocketEvent -> String
show :: WebsocketEvent -> String
$cshowList :: [WebsocketEvent] -> ShowS
showList :: [WebsocketEvent] -> ShowS
Show, WebsocketEvent -> WebsocketEvent -> Bool
(WebsocketEvent -> WebsocketEvent -> Bool)
-> (WebsocketEvent -> WebsocketEvent -> Bool) -> Eq WebsocketEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebsocketEvent -> WebsocketEvent -> Bool
== :: WebsocketEvent -> WebsocketEvent -> Bool
$c/= :: WebsocketEvent -> WebsocketEvent -> Bool
/= :: 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 -> Key -> Parser WebsocketEventType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event"
    WEData
weData      <- Object
o Object -> Key -> Parser WEData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    WEBroadcast
weBroadcast <- Object
o Object -> Key -> Parser WEBroadcast
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"broadcast"
    Int64
weSeq       <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"seq"
    WebsocketEvent -> Parser WebsocketEvent
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketEvent { Int64
WEBroadcast
WEData
WebsocketEventType
weEvent :: WebsocketEventType
weData :: WEData
weBroadcast :: WEBroadcast
weSeq :: Int64
weEvent :: WebsocketEventType
weData :: WEData
weBroadcast :: WEBroadcast
weSeq :: Int64
.. }

instance ToJSON WebsocketEvent where
  toJSON :: WebsocketEvent -> Value
toJSON WebsocketEvent { Int64
WEBroadcast
WEData
WebsocketEventType
weEvent :: WebsocketEvent -> WebsocketEventType
weData :: WebsocketEvent -> WEData
weBroadcast :: WebsocketEvent -> WEBroadcast
weSeq :: WebsocketEvent -> Int64
weEvent :: WebsocketEventType
weData :: WEData
weBroadcast :: WEBroadcast
weSeq :: Int64
.. } = [(Key, Value)] -> Value
A.object
    [ Key
"event"      Key -> WebsocketEventType -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= WebsocketEventType
weEvent
    , Key
"data"       Key -> WEData -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= WEData
weData
    , Key
"broadcast"  Key -> WEBroadcast -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= WEBroadcast
weBroadcast
    , Key
"seq"        Key -> Int64 -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= 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 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
  , WEData -> Maybe (HashMap ChannelId ServerTime)
wepChannelTimes       :: Maybe (HM.HashMap ChannelId ServerTime)
  } 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
$creadsPrec :: Int -> ReadS WEData
readsPrec :: Int -> ReadS WEData
$creadList :: ReadS [WEData]
readList :: ReadS [WEData]
$creadPrec :: ReadPrec WEData
readPrec :: ReadPrec WEData
$creadListPrec :: ReadPrec [WEData]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WEData -> ShowS
showsPrec :: Int -> WEData -> ShowS
$cshow :: WEData -> String
show :: WEData -> String
$cshowList :: [WEData] -> ShowS
showList :: [WEData] -> ShowS
Show, WEData -> WEData -> Bool
(WEData -> WEData -> Bool)
-> (WEData -> WEData -> Bool) -> Eq WEData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WEData -> WEData -> Bool
== :: WEData -> WEData -> Bool
$c/= :: WEData -> WEData -> Bool
/= :: 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 -> Key -> Parser ChannelId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id")
    Maybe TeamId
wepTeamId             <- Parser TeamId -> Parser (Maybe TeamId)
forall a. Parser a -> Parser (Maybe a)
maybeFail (Object
o Object -> Key -> Parser TeamId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"team_id")
    Maybe Text
wepSenderName         <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sender_name"
    Maybe UserId
wepUserId             <- Object
o Object -> Key -> Parser (Maybe UserId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id"
    Maybe PostId
wepParentId           <- Parser PostId -> Parser (Maybe PostId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Key -> Parser PostId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent_id")
    Maybe User
wepUser               <- Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
    Maybe Text
wepChannelDisplayName <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe 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 -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"post"
    Maybe Text
wepStatus             <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe 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 -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe 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 -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe 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 -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe 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 -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channelMember"
    Maybe (HashMap ChannelId ServerTime)
wepChannelTimes       <- (Value -> Parser (HashMap ChannelId ServerTime))
-> Maybe Value -> Parser (Maybe (HashMap ChannelId ServerTime))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM Value -> Parser (HashMap ChannelId ServerTime)
fromChannelTimesMap (Maybe Value -> Parser (Maybe (HashMap ChannelId ServerTime)))
-> Parser (Maybe Value)
-> Parser (Maybe (HashMap ChannelId ServerTime))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_times"
    WEData -> Parser WEData
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WEData { Maybe (HashMap ChannelId ServerTime)
Maybe Text
Maybe (Set UserId)
Maybe (Seq Preference)
Maybe ChannelMember
Maybe Reaction
Maybe Post
Maybe PostId
Maybe User
Maybe UserId
Maybe ChannelId
Maybe TeamId
wepChannelId :: Maybe ChannelId
wepTeamId :: Maybe TeamId
wepSenderName :: Maybe Text
wepUserId :: Maybe UserId
wepParentId :: Maybe PostId
wepUser :: Maybe User
wepChannelDisplayName :: Maybe Text
wepPost :: Maybe Post
wepStatus :: Maybe Text
wepReaction :: Maybe Reaction
wepMentions :: Maybe (Set UserId)
wepPreferences :: Maybe (Seq Preference)
wepChannelMember :: Maybe ChannelMember
wepChannelTimes :: Maybe (HashMap ChannelId ServerTime)
wepChannelId :: Maybe ChannelId
wepTeamId :: Maybe TeamId
wepSenderName :: Maybe Text
wepUserId :: Maybe UserId
wepParentId :: Maybe PostId
wepUser :: Maybe User
wepChannelDisplayName :: Maybe Text
wepPost :: Maybe Post
wepStatus :: Maybe Text
wepReaction :: Maybe Reaction
wepMentions :: Maybe (Set UserId)
wepPreferences :: Maybe (Seq Preference)
wepChannelMember :: Maybe ChannelMember
wepChannelTimes :: Maybe (HashMap ChannelId ServerTime)
.. }

instance ToJSON WEData where
  toJSON :: WEData -> Value
toJSON WEData { Maybe (HashMap ChannelId ServerTime)
Maybe Text
Maybe (Set UserId)
Maybe (Seq Preference)
Maybe ChannelMember
Maybe Reaction
Maybe Post
Maybe PostId
Maybe User
Maybe UserId
Maybe ChannelId
Maybe TeamId
wepChannelId :: WEData -> Maybe ChannelId
wepTeamId :: WEData -> Maybe TeamId
wepSenderName :: WEData -> Maybe Text
wepUserId :: WEData -> Maybe UserId
wepParentId :: WEData -> Maybe PostId
wepUser :: WEData -> Maybe User
wepChannelDisplayName :: WEData -> Maybe Text
wepPost :: WEData -> Maybe Post
wepStatus :: WEData -> Maybe Text
wepReaction :: WEData -> Maybe Reaction
wepMentions :: WEData -> Maybe (Set UserId)
wepPreferences :: WEData -> Maybe (Seq Preference)
wepChannelMember :: WEData -> Maybe ChannelMember
wepChannelTimes :: WEData -> Maybe (HashMap ChannelId ServerTime)
wepChannelId :: Maybe ChannelId
wepTeamId :: Maybe TeamId
wepSenderName :: Maybe Text
wepUserId :: Maybe UserId
wepParentId :: Maybe PostId
wepUser :: Maybe User
wepChannelDisplayName :: Maybe Text
wepPost :: Maybe Post
wepStatus :: Maybe Text
wepReaction :: Maybe Reaction
wepMentions :: Maybe (Set UserId)
wepPreferences :: Maybe (Seq Preference)
wepChannelMember :: Maybe ChannelMember
wepChannelTimes :: Maybe (HashMap ChannelId ServerTime)
.. } = [(Key, Value)] -> Value
A.object
    [ Key
"channel_id"   Key -> Maybe ChannelId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ChannelId
wepChannelId
    , Key
"team_id"      Key -> Maybe TeamId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe TeamId
wepTeamId
    , Key
"sender_name"  Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wepSenderName
    , Key
"user_id"      Key -> Maybe UserId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe UserId
wepUserId
    , Key
"parent_id"    Key -> Maybe PostId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PostId
wepParentId
    , Key
"channel_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wepChannelDisplayName
    , Key
"post"         Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Post -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe Post
wepPost
    , Key
"reaction"     Key -> Maybe Reaction -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Reaction
wepReaction
    , Key
"mentions"     Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Set UserId) -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe (Set UserId)
wepMentions
    , Key
"preferences"  Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Seq Preference) -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe (Seq Preference)
wepPreferences
    , Key
"channelMember" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ChannelMember -> Value
forall a. ToJSON a => a -> Value
toValueString Maybe ChannelMember
wepChannelMember
    , Key
"channelTimes" Key -> Maybe (KeyMap Int) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= do
          HashMap ChannelId ServerTime
m <- Maybe (HashMap ChannelId ServerTime)
wepChannelTimes
          let pairs :: [(ChannelId, ServerTime)]
pairs = HashMap ChannelId ServerTime -> [(ChannelId, ServerTime)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap ChannelId ServerTime
m
              mkEntry :: (x, ServerTime) -> (Key, Int)
mkEntry (x
cId, ServerTime
t) = (String -> Key
A.fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Id -> Text
unId (Id -> Text) -> Id -> Text
forall a b. (a -> b) -> a -> b
$ x -> Id
forall x. IsId x => x -> Id
toId x
cId, ServerTime -> Int
timeToServer ServerTime
t)
          KeyMap Int -> Maybe (KeyMap Int)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMap Int -> Maybe (KeyMap Int))
-> KeyMap Int -> Maybe (KeyMap Int)
forall a b. (a -> b) -> a -> b
$ [(Key, Int)] -> KeyMap Int
forall v. [(Key, v)] -> KeyMap v
A.fromList ([(Key, Int)] -> KeyMap Int) -> [(Key, Int)] -> KeyMap Int
forall a b. (a -> b) -> a -> b
$ (ChannelId, ServerTime) -> (Key, Int)
forall {x}. IsId x => (x, ServerTime) -> (Key, Int)
mkEntry ((ChannelId, ServerTime) -> (Key, Int))
-> [(ChannelId, ServerTime)] -> [(Key, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ChannelId, ServerTime)]
pairs
    ]

--

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
$creadsPrec :: Int -> ReadS WEBroadcast
readsPrec :: Int -> ReadS WEBroadcast
$creadList :: ReadS [WEBroadcast]
readList :: ReadS [WEBroadcast]
$creadPrec :: ReadPrec WEBroadcast
readPrec :: ReadPrec WEBroadcast
$creadListPrec :: ReadPrec [WEBroadcast]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WEBroadcast -> ShowS
showsPrec :: Int -> WEBroadcast -> ShowS
$cshow :: WEBroadcast -> String
show :: WEBroadcast -> String
$cshowList :: [WEBroadcast] -> ShowS
showList :: [WEBroadcast] -> ShowS
Show, WEBroadcast -> WEBroadcast -> Bool
(WEBroadcast -> WEBroadcast -> Bool)
-> (WEBroadcast -> WEBroadcast -> Bool) -> Eq WEBroadcast
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WEBroadcast -> WEBroadcast -> Bool
== :: WEBroadcast -> WEBroadcast -> Bool
$c/= :: WEBroadcast -> WEBroadcast -> Bool
/= :: 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 = (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 a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> f (Maybe a)
forall a. a -> f 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 -> Key -> Parser ChannelId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id")
    Maybe TeamId
webTeamId    <- Parser TeamId -> Parser (Maybe TeamId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Key -> Parser TeamId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"team_id")
    Maybe UserId
webUserId    <- Parser UserId -> Parser (Maybe UserId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
nullable (Object
o Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser (HashMap UserId Bool)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"omit_users")
    WEBroadcast -> Parser WEBroadcast
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WEBroadcast { Maybe (HashMap UserId Bool)
Maybe UserId
Maybe ChannelId
Maybe TeamId
webChannelId :: Maybe ChannelId
webUserId :: Maybe UserId
webTeamId :: Maybe TeamId
webOmitUsers :: Maybe (HashMap UserId Bool)
webChannelId :: Maybe ChannelId
webTeamId :: Maybe TeamId
webUserId :: Maybe UserId
webOmitUsers :: Maybe (HashMap UserId Bool)
.. }

instance ToJSON WEBroadcast where
  toJSON :: WEBroadcast -> Value
toJSON WEBroadcast { Maybe (HashMap UserId Bool)
Maybe UserId
Maybe ChannelId
Maybe TeamId
webChannelId :: WEBroadcast -> Maybe ChannelId
webUserId :: WEBroadcast -> Maybe UserId
webTeamId :: WEBroadcast -> Maybe TeamId
webOmitUsers :: WEBroadcast -> Maybe (HashMap UserId Bool)
webChannelId :: Maybe ChannelId
webUserId :: Maybe UserId
webTeamId :: Maybe TeamId
webOmitUsers :: Maybe (HashMap UserId Bool)
.. } = [(Key, Value)] -> Value
A.object
    [ Key
"channel_id" Key -> Maybe ChannelId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ChannelId
webChannelId
    , Key
"team_id"    Key -> Maybe TeamId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe TeamId
webTeamId
    , Key
"user_id"    Key -> Maybe UserId -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe UserId
webUserId
    , Key
"omit_users" Key -> Maybe (HashMap UserId Bool) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= 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
$creadsPrec :: Int -> ReadS WebsocketAction
readsPrec :: Int -> ReadS WebsocketAction
$creadList :: ReadS [WebsocketAction]
readList :: ReadS [WebsocketAction]
$creadPrec :: ReadPrec WebsocketAction
readPrec :: ReadPrec WebsocketAction
$creadListPrec :: ReadPrec [WebsocketAction]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WebsocketAction -> ShowS
showsPrec :: Int -> WebsocketAction -> ShowS
$cshow :: WebsocketAction -> String
show :: WebsocketAction -> String
$cshowList :: [WebsocketAction] -> ShowS
showList :: [WebsocketAction] -> ShowS
Show, WebsocketAction -> WebsocketAction -> Bool
(WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> Eq WebsocketAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebsocketAction -> WebsocketAction -> Bool
== :: WebsocketAction -> WebsocketAction -> Bool
$c/= :: WebsocketAction -> WebsocketAction -> Bool
/= :: 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
$ccompare :: WebsocketAction -> WebsocketAction -> Ordering
compare :: WebsocketAction -> WebsocketAction -> Ordering
$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
>= :: WebsocketAction -> WebsocketAction -> Bool
$cmax :: WebsocketAction -> WebsocketAction -> WebsocketAction
max :: WebsocketAction -> WebsocketAction -> WebsocketAction
$cmin :: WebsocketAction -> WebsocketAction -> WebsocketAction
min :: WebsocketAction -> WebsocketAction -> WebsocketAction
Ord)

instance ToJSON WebsocketAction where
  toJSON :: WebsocketAction -> Value
toJSON (UserTyping Int64
s ChannelId
cId Maybe PostId
pId) = [(Key, Value)] -> Value
A.object
    [ Key
"seq"    Key -> Int64 -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Int64
s
    , Key
"action" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= String -> Text
T.pack String
"user_typing"
    , Key
"data"   Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= [(Key, Value)] -> Value
A.object
                  [ Key
"channel_id" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Id -> Text
unId (ChannelId -> Id
forall x. IsId x => x -> Id
toId ChannelId
cId)
                  , Key
"parent_id"  Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= 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
$creadsPrec :: Int -> ReadS WebsocketActionStatus
readsPrec :: Int -> ReadS WebsocketActionStatus
$creadList :: ReadS [WebsocketActionStatus]
readList :: ReadS [WebsocketActionStatus]
$creadPrec :: ReadPrec WebsocketActionStatus
readPrec :: ReadPrec WebsocketActionStatus
$creadListPrec :: ReadPrec [WebsocketActionStatus]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WebsocketActionStatus -> ShowS
showsPrec :: Int -> WebsocketActionStatus -> ShowS
$cshow :: WebsocketActionStatus -> String
show :: WebsocketActionStatus -> String
$cshowList :: [WebsocketActionStatus] -> ShowS
showList :: [WebsocketActionStatus] -> ShowS
Show, WebsocketActionStatus -> WebsocketActionStatus -> Bool
(WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> (WebsocketActionStatus -> WebsocketActionStatus -> Bool)
-> Eq WebsocketActionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
== :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$c/= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
/= :: 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
$ccompare :: WebsocketActionStatus -> WebsocketActionStatus -> Ordering
compare :: WebsocketActionStatus -> WebsocketActionStatus -> Ordering
$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
>= :: WebsocketActionStatus -> WebsocketActionStatus -> Bool
$cmax :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
max :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
$cmin :: WebsocketActionStatus
-> WebsocketActionStatus -> WebsocketActionStatus
min :: WebsocketActionStatus
-> WebsocketActionStatus -> 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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsocketActionStatus
WebsocketActionStatusOK
            Text
_ -> String -> Parser WebsocketActionStatus
forall a. String -> Parser a
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
$creadsPrec :: Int -> ReadS WebsocketActionResponse
readsPrec :: Int -> ReadS WebsocketActionResponse
$creadList :: ReadS [WebsocketActionResponse]
readList :: ReadS [WebsocketActionResponse]
$creadPrec :: ReadPrec WebsocketActionResponse
readPrec :: ReadPrec WebsocketActionResponse
$creadListPrec :: ReadPrec [WebsocketActionResponse]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WebsocketActionResponse -> ShowS
showsPrec :: Int -> WebsocketActionResponse -> ShowS
$cshow :: WebsocketActionResponse -> String
show :: WebsocketActionResponse -> String
$cshowList :: [WebsocketActionResponse] -> ShowS
showList :: [WebsocketActionResponse] -> ShowS
Show, WebsocketActionResponse -> WebsocketActionResponse -> Bool
(WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> (WebsocketActionResponse -> WebsocketActionResponse -> Bool)
-> Eq WebsocketActionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
== :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$c/= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
/= :: 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
$ccompare :: WebsocketActionResponse -> WebsocketActionResponse -> Ordering
compare :: WebsocketActionResponse -> WebsocketActionResponse -> Ordering
$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
>= :: WebsocketActionResponse -> WebsocketActionResponse -> Bool
$cmax :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
max :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
$cmin :: WebsocketActionResponse
-> WebsocketActionResponse -> WebsocketActionResponse
min :: WebsocketActionResponse
-> WebsocketActionResponse -> 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 -> Key -> Parser WebsocketActionStatus
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"status"
                                  Parser (Int64 -> WebsocketActionResponse)
-> Parser Int64 -> Parser WebsocketActionResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int64
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) =
        [(Key, Value)] -> Value
A.object [ Key
"status" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
A..= WebsocketActionStatus -> Value
forall a. ToJSON a => a -> Value
A.toJSON WebsocketActionStatus
status
                 , Key
"seq" Key -> Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
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