{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | This module contains the client-server API
-- https://matrix.org/docs/spec/client_server/r0.6.1
module Network.Matrix.Client
  ( -- * Client
    ClientSession,
    MatrixToken (..),
    getTokenFromEnv,
    createSession,

    -- * API
    MatrixM,
    MatrixIO,
    MatrixError (..),
    retry,
    retryWithLog,

    -- * User data
    UserID (..),
    getTokenOwner,

    -- * Room management
    RoomCreatePreset (..),
    RoomCreateRequest (..),
    createRoom,

    -- * Room participation
    TxnID (..),
    sendMessage,
    mkReply,
    module Network.Matrix.Events,

    -- * Room membership
    RoomID (..),
    getJoinedRooms,
    joinRoom,
    joinRoomById,
    leaveRoomById,

    -- * Filter
    EventFormat (..),
    EventFilter (..),
    defaultEventFilter,
    eventFilterAll,
    RoomEventFilter (..),
    defaultRoomEventFilter,
    roomEventFilterAll,
    StateFilter (..),
    defaultStateFilter,
    stateFilterAll,
    RoomFilter (..),
    defaultRoomFilter,
    Filter (..),
    defaultFilter,
    FilterID (..),
    messageFilter,
    createFilter,
    getFilter,

    -- * Events
    sync,
    getTimelines,
    syncPoll,
    Author (..),
    Presence (..),
    RoomEvent (..),
    RoomSummary (..),
    TimelineSync (..),
    InvitedRoomSync (..),
    JoinedRoomSync (..),
    SyncResult (..),
    SyncResultRoom (..),
  )
where

import Control.Monad (mzero)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object, String), encode, genericParseJSON, genericToJSON, object, (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import Data.Hashable (Hashable)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map, foldrWithKey)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import GHC.Generics
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types.URI (urlEncode)
import Network.Matrix.Events
import Network.Matrix.Internal
import Network.Matrix.Room

-- $setup
-- >>> import Data.Aeson (decode)

-- | The session record, use 'createSession' to create it.
data ClientSession = ClientSession
  { ClientSession -> Text
baseUrl :: Text,
    ClientSession -> MatrixToken
token :: MatrixToken,
    ClientSession -> Manager
manager :: HTTP.Manager
  }

-- | 'createSession' creates the session record.
createSession ::
  -- | The matrix client-server base url, e.g. "https://matrix.org"
  Text ->
  -- | The user token
  MatrixToken ->
  IO ClientSession
createSession :: Text -> MatrixToken -> IO ClientSession
createSession Text
baseUrl' MatrixToken
token' = Text -> MatrixToken -> Manager -> ClientSession
ClientSession Text
baseUrl' MatrixToken
token' (Manager -> ClientSession) -> IO Manager -> IO ClientSession
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Manager
mkManager

mkRequest :: ClientSession -> Bool -> Text -> IO HTTP.Request
mkRequest :: ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession {Text
Manager
MatrixToken
manager :: Manager
token :: MatrixToken
baseUrl :: Text
manager :: ClientSession -> Manager
token :: ClientSession -> MatrixToken
baseUrl :: ClientSession -> Text
..} = Text -> MatrixToken -> Bool -> Text -> IO Request
mkRequest' Text
baseUrl MatrixToken
token

doRequest :: FromJSON a => ClientSession -> HTTP.Request -> MatrixIO a
doRequest :: ClientSession -> Request -> MatrixIO a
doRequest ClientSession {Text
Manager
MatrixToken
manager :: Manager
token :: MatrixToken
baseUrl :: Text
manager :: ClientSession -> Manager
token :: ClientSession -> MatrixToken
baseUrl :: ClientSession -> Text
..} = Manager -> Request -> MatrixIO a
forall a.
FromJSON a =>
Manager -> Request -> IO (Either MatrixError a)
doRequest' Manager
manager

-- | 'getTokenOwner' gets information about the owner of a given access token.
getTokenOwner :: ClientSession -> MatrixIO UserID
getTokenOwner :: ClientSession -> MatrixIO UserID
getTokenOwner ClientSession
session =
  ClientSession -> Request -> MatrixIO UserID
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request -> MatrixIO UserID) -> IO Request -> MatrixIO UserID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
"/_matrix/client/r0/account/whoami"

-- | A workaround data type to handle room create error being reported with a {message: "error"} response
data CreateRoomResponse = CreateRoomResponse
  { CreateRoomResponse -> Maybe Text
crrMessage :: Maybe Text,
    CreateRoomResponse -> Maybe Text
crrID :: Maybe Text
  }

instance FromJSON CreateRoomResponse where
  parseJSON :: Value -> Parser CreateRoomResponse
parseJSON (Object Object
o) = Maybe Text -> Maybe Text -> CreateRoomResponse
CreateRoomResponse (Maybe Text -> Maybe Text -> CreateRoomResponse)
-> Parser (Maybe Text) -> Parser (Maybe Text -> CreateRoomResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"message" Parser (Maybe Text -> CreateRoomResponse)
-> Parser (Maybe Text) -> Parser CreateRoomResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"room_id"
  parseJSON Value
_ = Parser CreateRoomResponse
forall (m :: * -> *) a. MonadPlus m => m a
mzero

createRoom :: ClientSession -> RoomCreateRequest -> MatrixIO RoomID
createRoom :: ClientSession -> RoomCreateRequest -> MatrixIO RoomID
createRoom ClientSession
session RoomCreateRequest
rcr = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
"/_matrix/client/r0/createRoom"
  Either MatrixError CreateRoomResponse -> Either MatrixError RoomID
toRoomID
    (Either MatrixError CreateRoomResponse
 -> Either MatrixError RoomID)
-> IO (Either MatrixError CreateRoomResponse) -> MatrixIO RoomID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientSession
-> Request -> IO (Either MatrixError CreateRoomResponse)
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
      ClientSession
session
      ( Request
request
          { method :: Method
HTTP.method = Method
"POST",
            requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ RoomCreateRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode RoomCreateRequest
rcr
          }
      )
  where
    toRoomID :: Either MatrixError CreateRoomResponse -> Either MatrixError RoomID
    toRoomID :: Either MatrixError CreateRoomResponse -> Either MatrixError RoomID
toRoomID Either MatrixError CreateRoomResponse
resp = case Either MatrixError CreateRoomResponse
resp of
      Left MatrixError
err -> MatrixError -> Either MatrixError RoomID
forall a b. a -> Either a b
Left MatrixError
err
      Right CreateRoomResponse
crr -> case (CreateRoomResponse -> Maybe Text
crrID CreateRoomResponse
crr, CreateRoomResponse -> Maybe Text
crrMessage CreateRoomResponse
crr) of
        (Just Text
roomID, Maybe Text
_) -> RoomID -> Either MatrixError RoomID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RoomID -> Either MatrixError RoomID)
-> RoomID -> Either MatrixError RoomID
forall a b. (a -> b) -> a -> b
$ Text -> RoomID
RoomID Text
roomID
        (Maybe Text
_, Just Text
message) -> MatrixError -> Either MatrixError RoomID
forall a b. a -> Either a b
Left (MatrixError -> Either MatrixError RoomID)
-> MatrixError -> Either MatrixError RoomID
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Int -> MatrixError
MatrixError Text
"UNKNOWN" Text
message Maybe Int
forall a. Maybe a
Nothing
        (Maybe Text, Maybe Text)
_ -> MatrixError -> Either MatrixError RoomID
forall a b. a -> Either a b
Left (MatrixError -> Either MatrixError RoomID)
-> MatrixError -> Either MatrixError RoomID
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Int -> MatrixError
MatrixError Text
"UNKOWN" Text
"" Maybe Int
forall a. Maybe a
Nothing

newtype TxnID = TxnID Text deriving (Int -> TxnID -> ShowS
[TxnID] -> ShowS
TxnID -> String
(Int -> TxnID -> ShowS)
-> (TxnID -> String) -> ([TxnID] -> ShowS) -> Show TxnID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxnID] -> ShowS
$cshowList :: [TxnID] -> ShowS
show :: TxnID -> String
$cshow :: TxnID -> String
showsPrec :: Int -> TxnID -> ShowS
$cshowsPrec :: Int -> TxnID -> ShowS
Show, TxnID -> TxnID -> Bool
(TxnID -> TxnID -> Bool) -> (TxnID -> TxnID -> Bool) -> Eq TxnID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxnID -> TxnID -> Bool
$c/= :: TxnID -> TxnID -> Bool
== :: TxnID -> TxnID -> Bool
$c== :: TxnID -> TxnID -> Bool
Eq)

sendMessage :: ClientSession -> RoomID -> Event -> TxnID -> MatrixIO EventID
sendMessage :: ClientSession -> RoomID -> Event -> TxnID -> MatrixIO EventID
sendMessage ClientSession
session (RoomID Text
roomId) Event
event (TxnID Text
txnId) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
path
  ClientSession -> Request -> MatrixIO EventID
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
    ClientSession
session
    ( Request
request
        { method :: Method
HTTP.method = Method
"PUT",
          requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Event -> ByteString
forall a. ToJSON a => a -> ByteString
encode Event
event
        }
    )
  where
    path :: Text
path = Text
"/_matrix/client/r0/rooms/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roomId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/send/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
eventId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txnId
    eventId :: Text
eventId = Event -> Text
eventType Event
event

newtype RoomID = RoomID Text deriving (Int -> RoomID -> ShowS
[RoomID] -> ShowS
RoomID -> String
(Int -> RoomID -> ShowS)
-> (RoomID -> String) -> ([RoomID] -> ShowS) -> Show RoomID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoomID] -> ShowS
$cshowList :: [RoomID] -> ShowS
show :: RoomID -> String
$cshow :: RoomID -> String
showsPrec :: Int -> RoomID -> ShowS
$cshowsPrec :: Int -> RoomID -> ShowS
Show, RoomID -> RoomID -> Bool
(RoomID -> RoomID -> Bool)
-> (RoomID -> RoomID -> Bool) -> Eq RoomID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoomID -> RoomID -> Bool
$c/= :: RoomID -> RoomID -> Bool
== :: RoomID -> RoomID -> Bool
$c== :: RoomID -> RoomID -> Bool
Eq, Eq RoomID
Eq RoomID
-> (RoomID -> RoomID -> Ordering)
-> (RoomID -> RoomID -> Bool)
-> (RoomID -> RoomID -> Bool)
-> (RoomID -> RoomID -> Bool)
-> (RoomID -> RoomID -> Bool)
-> (RoomID -> RoomID -> RoomID)
-> (RoomID -> RoomID -> RoomID)
-> Ord RoomID
RoomID -> RoomID -> Bool
RoomID -> RoomID -> Ordering
RoomID -> RoomID -> RoomID
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 :: RoomID -> RoomID -> RoomID
$cmin :: RoomID -> RoomID -> RoomID
max :: RoomID -> RoomID -> RoomID
$cmax :: RoomID -> RoomID -> RoomID
>= :: RoomID -> RoomID -> Bool
$c>= :: RoomID -> RoomID -> Bool
> :: RoomID -> RoomID -> Bool
$c> :: RoomID -> RoomID -> Bool
<= :: RoomID -> RoomID -> Bool
$c<= :: RoomID -> RoomID -> Bool
< :: RoomID -> RoomID -> Bool
$c< :: RoomID -> RoomID -> Bool
compare :: RoomID -> RoomID -> Ordering
$ccompare :: RoomID -> RoomID -> Ordering
$cp1Ord :: Eq RoomID
Ord, Int -> RoomID -> Int
RoomID -> Int
(Int -> RoomID -> Int) -> (RoomID -> Int) -> Hashable RoomID
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: RoomID -> Int
$chash :: RoomID -> Int
hashWithSalt :: Int -> RoomID -> Int
$chashWithSalt :: Int -> RoomID -> Int
Hashable)

instance FromJSON RoomID where
  parseJSON :: Value -> Parser RoomID
parseJSON (Object Object
v) = Text -> RoomID
RoomID (Text -> RoomID) -> Parser Text -> Parser RoomID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"room_id"
  parseJSON Value
_ = Parser RoomID
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | A newtype wrapper to decoded nested list
--
-- >>> decode "{\"joined_rooms\": [\"!foo:example.com\"]}" :: Maybe JoinedRooms
-- Just (JoinedRooms {unRooms = [RoomID "!foo:example.com"]})
newtype JoinedRooms = JoinedRooms {JoinedRooms -> [RoomID]
unRooms :: [RoomID]} deriving (Int -> JoinedRooms -> ShowS
[JoinedRooms] -> ShowS
JoinedRooms -> String
(Int -> JoinedRooms -> ShowS)
-> (JoinedRooms -> String)
-> ([JoinedRooms] -> ShowS)
-> Show JoinedRooms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinedRooms] -> ShowS
$cshowList :: [JoinedRooms] -> ShowS
show :: JoinedRooms -> String
$cshow :: JoinedRooms -> String
showsPrec :: Int -> JoinedRooms -> ShowS
$cshowsPrec :: Int -> JoinedRooms -> ShowS
Show)

instance FromJSON JoinedRooms where
  parseJSON :: Value -> Parser JoinedRooms
parseJSON (Object Object
v) = do
    [Text]
rooms <- Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"joined_rooms"
    JoinedRooms -> Parser JoinedRooms
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JoinedRooms -> Parser JoinedRooms)
-> ([RoomID] -> JoinedRooms) -> [RoomID] -> Parser JoinedRooms
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RoomID] -> JoinedRooms
JoinedRooms ([RoomID] -> Parser JoinedRooms) -> [RoomID] -> Parser JoinedRooms
forall a b. (a -> b) -> a -> b
$ Text -> RoomID
RoomID (Text -> RoomID) -> [Text] -> [RoomID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rooms
  parseJSON Value
_ = Parser JoinedRooms
forall (m :: * -> *) a. MonadPlus m => m a
mzero

getJoinedRooms :: ClientSession -> MatrixIO [RoomID]
getJoinedRooms :: ClientSession -> MatrixIO [RoomID]
getJoinedRooms ClientSession
session = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
"/_matrix/client/r0/joined_rooms"
  Either MatrixError JoinedRooms
response <- ClientSession -> Request -> MatrixIO JoinedRooms
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session Request
request
  Either MatrixError [RoomID] -> MatrixIO [RoomID]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either MatrixError [RoomID] -> MatrixIO [RoomID])
-> Either MatrixError [RoomID] -> MatrixIO [RoomID]
forall a b. (a -> b) -> a -> b
$ JoinedRooms -> [RoomID]
unRooms (JoinedRooms -> [RoomID])
-> Either MatrixError JoinedRooms -> Either MatrixError [RoomID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either MatrixError JoinedRooms
response

-- | Note that this API takes either a room ID or alias, unlike 'joinRoomById'
joinRoom :: ClientSession -> Text -> MatrixIO RoomID
joinRoom :: ClientSession -> Text -> MatrixIO RoomID
joinRoom ClientSession
session Text
roomName = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True (Text -> IO Request) -> Text -> IO Request
forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/r0/join/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roomNameUrl
  ClientSession -> Request -> MatrixIO RoomID
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: Method
HTTP.method = Method
"POST"})
  where
    roomNameUrl :: Text
roomNameUrl = Method -> Text
decodeUtf8 (Method -> Text) -> (Text -> Method) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Method -> Method
urlEncode Bool
True (Method -> Method) -> (Text -> Method) -> Text -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
encodeUtf8 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
roomName

joinRoomById :: ClientSession -> RoomID -> MatrixIO RoomID
joinRoomById :: ClientSession -> RoomID -> MatrixIO RoomID
joinRoomById ClientSession
session (RoomID Text
roomId) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True (Text -> IO Request) -> Text -> IO Request
forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/r0/rooms/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roomId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/join"
  ClientSession -> Request -> MatrixIO RoomID
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: Method
HTTP.method = Method
"POST"})

leaveRoomById :: ClientSession -> RoomID -> MatrixIO ()
leaveRoomById :: ClientSession -> RoomID -> MatrixIO ()
leaveRoomById ClientSession
session (RoomID Text
roomId) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True (Text -> IO Request) -> Text -> IO Request
forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/r0/rooms/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roomId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/leave"
  (Value -> ()) -> Either MatrixError Value -> Either MatrixError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject (Either MatrixError Value -> Either MatrixError ())
-> IO (Either MatrixError Value) -> MatrixIO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientSession -> Request -> IO (Either MatrixError Value)
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: Method
HTTP.method = Method
"POST"})
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs Object -> Object -> Bool
forall a. Eq a => a -> a -> Bool
== Object
forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> String -> ()
forall a. HasCallStack => String -> a
error (String -> ()) -> String -> ()
forall a b. (a -> b) -> a -> b
$ String
"Unknown leave response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
value

-------------------------------------------------------------------------------
-- https://matrix.org/docs/spec/client_server/latest#post-matrix-client-r0-user-userid-filter
newtype FilterID = FilterID Text deriving (Int -> FilterID -> ShowS
[FilterID] -> ShowS
FilterID -> String
(Int -> FilterID -> ShowS)
-> (FilterID -> String) -> ([FilterID] -> ShowS) -> Show FilterID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterID] -> ShowS
$cshowList :: [FilterID] -> ShowS
show :: FilterID -> String
$cshow :: FilterID -> String
showsPrec :: Int -> FilterID -> ShowS
$cshowsPrec :: Int -> FilterID -> ShowS
Show, FilterID -> FilterID -> Bool
(FilterID -> FilterID -> Bool)
-> (FilterID -> FilterID -> Bool) -> Eq FilterID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterID -> FilterID -> Bool
$c/= :: FilterID -> FilterID -> Bool
== :: FilterID -> FilterID -> Bool
$c== :: FilterID -> FilterID -> Bool
Eq, Int -> FilterID -> Int
FilterID -> Int
(Int -> FilterID -> Int) -> (FilterID -> Int) -> Hashable FilterID
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FilterID -> Int
$chash :: FilterID -> Int
hashWithSalt :: Int -> FilterID -> Int
$chashWithSalt :: Int -> FilterID -> Int
Hashable)

instance FromJSON FilterID where
  parseJSON :: Value -> Parser FilterID
parseJSON (Object Object
v) = Text -> FilterID
FilterID (Text -> FilterID) -> Parser Text -> Parser FilterID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"filter_id"
  parseJSON Value
_ = Parser FilterID
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data EventFormat = Client | Federation deriving (Int -> EventFormat -> ShowS
[EventFormat] -> ShowS
EventFormat -> String
(Int -> EventFormat -> ShowS)
-> (EventFormat -> String)
-> ([EventFormat] -> ShowS)
-> Show EventFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventFormat] -> ShowS
$cshowList :: [EventFormat] -> ShowS
show :: EventFormat -> String
$cshow :: EventFormat -> String
showsPrec :: Int -> EventFormat -> ShowS
$cshowsPrec :: Int -> EventFormat -> ShowS
Show, EventFormat -> EventFormat -> Bool
(EventFormat -> EventFormat -> Bool)
-> (EventFormat -> EventFormat -> Bool) -> Eq EventFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventFormat -> EventFormat -> Bool
$c/= :: EventFormat -> EventFormat -> Bool
== :: EventFormat -> EventFormat -> Bool
$c== :: EventFormat -> EventFormat -> Bool
Eq)

instance ToJSON EventFormat where
  toJSON :: EventFormat -> Value
toJSON EventFormat
ef = case EventFormat
ef of
    EventFormat
Client -> Value
"client"
    EventFormat
Federation -> Value
"federation"

instance FromJSON EventFormat where
  parseJSON :: Value -> Parser EventFormat
parseJSON Value
v = case Value
v of
    (String Text
"client") -> EventFormat -> Parser EventFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventFormat
Client
    (String Text
"federation") -> EventFormat -> Parser EventFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventFormat
Federation
    Value
_ -> Parser EventFormat
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data EventFilter = EventFilter
  { EventFilter -> Maybe Int
efLimit :: Maybe Int,
    EventFilter -> Maybe [Text]
efNotSenders :: Maybe [Text],
    EventFilter -> Maybe [Text]
efNotTypes :: Maybe [Text],
    EventFilter -> Maybe [Text]
efSenders :: Maybe [Text],
    EventFilter -> Maybe [Text]
efTypes :: Maybe [Text]
  }
  deriving (Int -> EventFilter -> ShowS
[EventFilter] -> ShowS
EventFilter -> String
(Int -> EventFilter -> ShowS)
-> (EventFilter -> String)
-> ([EventFilter] -> ShowS)
-> Show EventFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventFilter] -> ShowS
$cshowList :: [EventFilter] -> ShowS
show :: EventFilter -> String
$cshow :: EventFilter -> String
showsPrec :: Int -> EventFilter -> ShowS
$cshowsPrec :: Int -> EventFilter -> ShowS
Show, EventFilter -> EventFilter -> Bool
(EventFilter -> EventFilter -> Bool)
-> (EventFilter -> EventFilter -> Bool) -> Eq EventFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventFilter -> EventFilter -> Bool
$c/= :: EventFilter -> EventFilter -> Bool
== :: EventFilter -> EventFilter -> Bool
$c== :: EventFilter -> EventFilter -> Bool
Eq, (forall x. EventFilter -> Rep EventFilter x)
-> (forall x. Rep EventFilter x -> EventFilter)
-> Generic EventFilter
forall x. Rep EventFilter x -> EventFilter
forall x. EventFilter -> Rep EventFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventFilter x -> EventFilter
$cfrom :: forall x. EventFilter -> Rep EventFilter x
Generic)

defaultEventFilter :: EventFilter
defaultEventFilter :: EventFilter
defaultEventFilter = Maybe Int
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> EventFilter
EventFilter Maybe Int
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing

-- | A filter that should match nothing
eventFilterAll :: EventFilter
eventFilterAll :: EventFilter
eventFilterAll = EventFilter
defaultEventFilter {efLimit :: Maybe Int
efLimit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, efNotTypes :: Maybe [Text]
efNotTypes = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"*"]}

aesonOptions :: Aeson.Options
aesonOptions :: Options
aesonOptions = (ShowS -> Options
aesonPrefix ShowS
snakeCase) {omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True}

instance ToJSON EventFilter where
  toJSON :: EventFilter -> Value
toJSON = Options -> EventFilter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON EventFilter where
  parseJSON :: Value -> Parser EventFilter
parseJSON = Options -> Value -> Parser EventFilter
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data RoomEventFilter = RoomEventFilter
  { RoomEventFilter -> Maybe Int
refLimit :: Maybe Int,
    RoomEventFilter -> Maybe [Text]
refNotSenders :: Maybe [Text],
    RoomEventFilter -> Maybe [Text]
refNotTypes :: Maybe [Text],
    RoomEventFilter -> Maybe [Text]
refSenders :: Maybe [Text],
    RoomEventFilter -> Maybe [Text]
refTypes :: Maybe [Text],
    RoomEventFilter -> Maybe Bool
refLazyLoadMembers :: Maybe Bool,
    RoomEventFilter -> Maybe Bool
refIncludeRedundantMembers :: Maybe Bool,
    RoomEventFilter -> Maybe [Text]
refNotRooms :: Maybe [Text],
    RoomEventFilter -> Maybe [Text]
refRooms :: Maybe [Text],
    RoomEventFilter -> Maybe Bool
refContainsUrl :: Maybe Bool
  }
  deriving (Int -> RoomEventFilter -> ShowS
[RoomEventFilter] -> ShowS
RoomEventFilter -> String
(Int -> RoomEventFilter -> ShowS)
-> (RoomEventFilter -> String)
-> ([RoomEventFilter] -> ShowS)
-> Show RoomEventFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoomEventFilter] -> ShowS
$cshowList :: [RoomEventFilter] -> ShowS
show :: RoomEventFilter -> String
$cshow :: RoomEventFilter -> String
showsPrec :: Int -> RoomEventFilter -> ShowS
$cshowsPrec :: Int -> RoomEventFilter -> ShowS
Show, RoomEventFilter -> RoomEventFilter -> Bool
(RoomEventFilter -> RoomEventFilter -> Bool)
-> (RoomEventFilter -> RoomEventFilter -> Bool)
-> Eq RoomEventFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoomEventFilter -> RoomEventFilter -> Bool
$c/= :: RoomEventFilter -> RoomEventFilter -> Bool
== :: RoomEventFilter -> RoomEventFilter -> Bool
$c== :: RoomEventFilter -> RoomEventFilter -> Bool
Eq, (forall x. RoomEventFilter -> Rep RoomEventFilter x)
-> (forall x. Rep RoomEventFilter x -> RoomEventFilter)
-> Generic RoomEventFilter
forall x. Rep RoomEventFilter x -> RoomEventFilter
forall x. RoomEventFilter -> Rep RoomEventFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RoomEventFilter x -> RoomEventFilter
$cfrom :: forall x. RoomEventFilter -> Rep RoomEventFilter x
Generic)

defaultRoomEventFilter :: RoomEventFilter
defaultRoomEventFilter :: RoomEventFilter
defaultRoomEventFilter = Maybe Int
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> RoomEventFilter
RoomEventFilter Maybe Int
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

-- | A filter that should match nothing
roomEventFilterAll :: RoomEventFilter
roomEventFilterAll :: RoomEventFilter
roomEventFilterAll = RoomEventFilter
defaultRoomEventFilter {refLimit :: Maybe Int
refLimit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, refNotTypes :: Maybe [Text]
refNotTypes = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"*"]}

instance ToJSON RoomEventFilter where
  toJSON :: RoomEventFilter -> Value
toJSON = Options -> RoomEventFilter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON RoomEventFilter where
  parseJSON :: Value -> Parser RoomEventFilter
parseJSON = Options -> Value -> Parser RoomEventFilter
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data StateFilter = StateFilter
  { StateFilter -> Maybe Int
sfLimit :: Maybe Int,
    StateFilter -> Maybe [Text]
sfNotSenders :: Maybe [Text],
    StateFilter -> Maybe [Text]
sfNotTypes :: Maybe [Text],
    StateFilter -> Maybe [Text]
sfSenders :: Maybe [Text],
    StateFilter -> Maybe [Text]
sfTypes :: Maybe [Text],
    StateFilter -> Maybe Bool
sfLazyLoadMembers :: Maybe Bool,
    StateFilter -> Maybe Bool
sfIncludeRedundantMembers :: Maybe Bool,
    StateFilter -> Maybe [Text]
sfNotRooms :: Maybe [Text],
    StateFilter -> Maybe [Text]
sfRooms :: Maybe [Text],
    StateFilter -> Maybe Bool
sfContains_url :: Maybe Bool
  }
  deriving (Int -> StateFilter -> ShowS
[StateFilter] -> ShowS
StateFilter -> String
(Int -> StateFilter -> ShowS)
-> (StateFilter -> String)
-> ([StateFilter] -> ShowS)
-> Show StateFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateFilter] -> ShowS
$cshowList :: [StateFilter] -> ShowS
show :: StateFilter -> String
$cshow :: StateFilter -> String
showsPrec :: Int -> StateFilter -> ShowS
$cshowsPrec :: Int -> StateFilter -> ShowS
Show, StateFilter -> StateFilter -> Bool
(StateFilter -> StateFilter -> Bool)
-> (StateFilter -> StateFilter -> Bool) -> Eq StateFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateFilter -> StateFilter -> Bool
$c/= :: StateFilter -> StateFilter -> Bool
== :: StateFilter -> StateFilter -> Bool
$c== :: StateFilter -> StateFilter -> Bool
Eq, (forall x. StateFilter -> Rep StateFilter x)
-> (forall x. Rep StateFilter x -> StateFilter)
-> Generic StateFilter
forall x. Rep StateFilter x -> StateFilter
forall x. StateFilter -> Rep StateFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StateFilter x -> StateFilter
$cfrom :: forall x. StateFilter -> Rep StateFilter x
Generic)

defaultStateFilter :: StateFilter
defaultStateFilter :: StateFilter
defaultStateFilter = Maybe Int
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> StateFilter
StateFilter Maybe Int
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

stateFilterAll :: StateFilter
stateFilterAll :: StateFilter
stateFilterAll = StateFilter
defaultStateFilter {sfLimit :: Maybe Int
sfLimit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, sfNotTypes :: Maybe [Text]
sfNotTypes = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"*"]}

instance ToJSON StateFilter where
  toJSON :: StateFilter -> Value
toJSON = Options -> StateFilter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON StateFilter where
  parseJSON :: Value -> Parser StateFilter
parseJSON = Options -> Value -> Parser StateFilter
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data RoomFilter = RoomFilter
  { RoomFilter -> Maybe [Text]
rfNotRooms :: Maybe [Text],
    RoomFilter -> Maybe [Text]
rfRooms :: Maybe [Text],
    RoomFilter -> Maybe RoomEventFilter
rfEphemeral :: Maybe RoomEventFilter,
    RoomFilter -> Maybe Bool
rfIncludeLeave :: Maybe Bool,
    RoomFilter -> Maybe StateFilter
rfState :: Maybe StateFilter,
    RoomFilter -> Maybe RoomEventFilter
rfTimeline :: Maybe RoomEventFilter,
    RoomFilter -> Maybe RoomEventFilter
rfAccountData :: Maybe RoomEventFilter
  }
  deriving (Int -> RoomFilter -> ShowS
[RoomFilter] -> ShowS
RoomFilter -> String
(Int -> RoomFilter -> ShowS)
-> (RoomFilter -> String)
-> ([RoomFilter] -> ShowS)
-> Show RoomFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoomFilter] -> ShowS
$cshowList :: [RoomFilter] -> ShowS
show :: RoomFilter -> String
$cshow :: RoomFilter -> String
showsPrec :: Int -> RoomFilter -> ShowS
$cshowsPrec :: Int -> RoomFilter -> ShowS
Show, RoomFilter -> RoomFilter -> Bool
(RoomFilter -> RoomFilter -> Bool)
-> (RoomFilter -> RoomFilter -> Bool) -> Eq RoomFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoomFilter -> RoomFilter -> Bool
$c/= :: RoomFilter -> RoomFilter -> Bool
== :: RoomFilter -> RoomFilter -> Bool
$c== :: RoomFilter -> RoomFilter -> Bool
Eq, (forall x. RoomFilter -> Rep RoomFilter x)
-> (forall x. Rep RoomFilter x -> RoomFilter) -> Generic RoomFilter
forall x. Rep RoomFilter x -> RoomFilter
forall x. RoomFilter -> Rep RoomFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RoomFilter x -> RoomFilter
$cfrom :: forall x. RoomFilter -> Rep RoomFilter x
Generic)

defaultRoomFilter :: RoomFilter
defaultRoomFilter :: RoomFilter
defaultRoomFilter = Maybe [Text]
-> Maybe [Text]
-> Maybe RoomEventFilter
-> Maybe Bool
-> Maybe StateFilter
-> Maybe RoomEventFilter
-> Maybe RoomEventFilter
-> RoomFilter
RoomFilter Maybe [Text]
forall a. Maybe a
Nothing Maybe [Text]
forall a. Maybe a
Nothing Maybe RoomEventFilter
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe StateFilter
forall a. Maybe a
Nothing Maybe RoomEventFilter
forall a. Maybe a
Nothing Maybe RoomEventFilter
forall a. Maybe a
Nothing

instance ToJSON RoomFilter where
  toJSON :: RoomFilter -> Value
toJSON = Options -> RoomFilter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON RoomFilter where
  parseJSON :: Value -> Parser RoomFilter
parseJSON = Options -> Value -> Parser RoomFilter
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data Filter = Filter
  { Filter -> Maybe [Text]
filterEventFields :: Maybe [Text],
    Filter -> Maybe EventFormat
filterEventFormat :: Maybe EventFormat,
    Filter -> Maybe EventFilter
filterPresence :: Maybe EventFilter,
    Filter -> Maybe EventFilter
filterAccountData :: Maybe EventFilter,
    Filter -> Maybe RoomFilter
filterRoom :: Maybe RoomFilter
  }
  deriving (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show, Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq, (forall x. Filter -> Rep Filter x)
-> (forall x. Rep Filter x -> Filter) -> Generic Filter
forall x. Rep Filter x -> Filter
forall x. Filter -> Rep Filter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Filter x -> Filter
$cfrom :: forall x. Filter -> Rep Filter x
Generic)

defaultFilter :: Filter
defaultFilter :: Filter
defaultFilter = Maybe [Text]
-> Maybe EventFormat
-> Maybe EventFilter
-> Maybe EventFilter
-> Maybe RoomFilter
-> Filter
Filter Maybe [Text]
forall a. Maybe a
Nothing Maybe EventFormat
forall a. Maybe a
Nothing Maybe EventFilter
forall a. Maybe a
Nothing Maybe EventFilter
forall a. Maybe a
Nothing Maybe RoomFilter
forall a. Maybe a
Nothing

-- | A filter to keep all the messages
messageFilter :: Filter
messageFilter :: Filter
messageFilter =
  Filter
defaultFilter
    { filterPresence :: Maybe EventFilter
filterPresence = EventFilter -> Maybe EventFilter
forall a. a -> Maybe a
Just EventFilter
eventFilterAll,
      filterAccountData :: Maybe EventFilter
filterAccountData = EventFilter -> Maybe EventFilter
forall a. a -> Maybe a
Just EventFilter
eventFilterAll,
      filterRoom :: Maybe RoomFilter
filterRoom = RoomFilter -> Maybe RoomFilter
forall a. a -> Maybe a
Just RoomFilter
roomFilter
    }
  where
    roomFilter :: RoomFilter
roomFilter =
      RoomFilter
defaultRoomFilter
        { rfEphemeral :: Maybe RoomEventFilter
rfEphemeral = RoomEventFilter -> Maybe RoomEventFilter
forall a. a -> Maybe a
Just RoomEventFilter
roomEventFilterAll,
          rfState :: Maybe StateFilter
rfState = StateFilter -> Maybe StateFilter
forall a. a -> Maybe a
Just StateFilter
stateFilterAll,
          rfTimeline :: Maybe RoomEventFilter
rfTimeline = RoomEventFilter -> Maybe RoomEventFilter
forall a. a -> Maybe a
Just RoomEventFilter
timelineFilter,
          rfAccountData :: Maybe RoomEventFilter
rfAccountData = RoomEventFilter -> Maybe RoomEventFilter
forall a. a -> Maybe a
Just RoomEventFilter
roomEventFilterAll
        }
    timelineFilter :: RoomEventFilter
timelineFilter =
      RoomEventFilter
defaultRoomEventFilter
        { refTypes :: Maybe [Text]
refTypes = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"m.room.message"]
        }

instance ToJSON Filter where
  toJSON :: Filter -> Value
toJSON = Options -> Filter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON Filter where
  parseJSON :: Value -> Parser Filter
parseJSON = Options -> Value -> Parser Filter
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

-- | Upload a new filter definition to the homeserver
-- https://matrix.org/docs/spec/client_server/latest#post-matrix-client-r0-user-userid-filter
createFilter ::
  -- | The client session, use 'createSession' to get one.
  ClientSession ->
  -- | The userID, use 'getTokenOwner' to get it.
  UserID ->
  -- | The filter definition, use 'defaultFilter' to create one or use the 'messageFilter' example.
  Filter ->
  -- | The function returns a 'FilterID' suitable for the 'sync' function.
  MatrixIO FilterID
createFilter :: ClientSession -> UserID -> Filter -> MatrixIO FilterID
createFilter ClientSession
session (UserID Text
userID) Filter
body = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
path
  ClientSession -> Request -> MatrixIO FilterID
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
    ClientSession
session
    ( Request
request
        { method :: Method
HTTP.method = Method
"POST",
          requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Filter -> ByteString
forall a. ToJSON a => a -> ByteString
encode Filter
body
        }
    )
  where
    path :: Text
path = Text
"/_matrix/client/r0/user/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/filter"

getFilter :: ClientSession -> UserID -> FilterID -> MatrixIO Filter
getFilter :: ClientSession -> UserID -> FilterID -> MatrixIO Filter
getFilter ClientSession
session (UserID Text
userID) (FilterID Text
filterID) =
  ClientSession -> Request -> MatrixIO Filter
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request -> MatrixIO Filter) -> IO Request -> MatrixIO Filter
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
path
  where
    path :: Text
path = Text
"/_matrix/client/r0/user/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/filter/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filterID

-------------------------------------------------------------------------------
-- https://matrix.org/docs/spec/client_server/latest#get-matrix-client-r0-sync
newtype Author = Author {Author -> Text
unAuthor :: Text}
  deriving (Int -> Author -> ShowS
[Author] -> ShowS
Author -> String
(Int -> Author -> ShowS)
-> (Author -> String) -> ([Author] -> ShowS) -> Show Author
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> String
$cshow :: Author -> String
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show, Author -> Author -> Bool
(Author -> Author -> Bool)
-> (Author -> Author -> Bool) -> Eq Author
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c== :: Author -> Author -> Bool
Eq)
  deriving newtype (Value -> Parser [Author]
Value -> Parser Author
(Value -> Parser Author)
-> (Value -> Parser [Author]) -> FromJSON Author
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Author]
$cparseJSONList :: Value -> Parser [Author]
parseJSON :: Value -> Parser Author
$cparseJSON :: Value -> Parser Author
FromJSON, [Author] -> Encoding
[Author] -> Value
Author -> Encoding
Author -> Value
(Author -> Value)
-> (Author -> Encoding)
-> ([Author] -> Value)
-> ([Author] -> Encoding)
-> ToJSON Author
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Author] -> Encoding
$ctoEncodingList :: [Author] -> Encoding
toJSONList :: [Author] -> Value
$ctoJSONList :: [Author] -> Value
toEncoding :: Author -> Encoding
$ctoEncoding :: Author -> Encoding
toJSON :: Author -> Value
$ctoJSON :: Author -> Value
ToJSON)

data RoomEvent = RoomEvent
  { RoomEvent -> Event
reContent :: Event,
    RoomEvent -> Text
reType :: Text,
    RoomEvent -> EventID
reEventId :: EventID,
    RoomEvent -> Author
reSender :: Author
  }
  deriving (Int -> RoomEvent -> ShowS
[RoomEvent] -> ShowS
RoomEvent -> String
(Int -> RoomEvent -> ShowS)
-> (RoomEvent -> String)
-> ([RoomEvent] -> ShowS)
-> Show RoomEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoomEvent] -> ShowS
$cshowList :: [RoomEvent] -> ShowS
show :: RoomEvent -> String
$cshow :: RoomEvent -> String
showsPrec :: Int -> RoomEvent -> ShowS
$cshowsPrec :: Int -> RoomEvent -> ShowS
Show, RoomEvent -> RoomEvent -> Bool
(RoomEvent -> RoomEvent -> Bool)
-> (RoomEvent -> RoomEvent -> Bool) -> Eq RoomEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoomEvent -> RoomEvent -> Bool
$c/= :: RoomEvent -> RoomEvent -> Bool
== :: RoomEvent -> RoomEvent -> Bool
$c== :: RoomEvent -> RoomEvent -> Bool
Eq, (forall x. RoomEvent -> Rep RoomEvent x)
-> (forall x. Rep RoomEvent x -> RoomEvent) -> Generic RoomEvent
forall x. Rep RoomEvent x -> RoomEvent
forall x. RoomEvent -> Rep RoomEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RoomEvent x -> RoomEvent
$cfrom :: forall x. RoomEvent -> Rep RoomEvent x
Generic)

data RoomSummary = RoomSummary
  { RoomSummary -> Maybe Int
rsJoinedMemberCount :: Maybe Int,
    RoomSummary -> Maybe Int
rsInvitedMemberCount :: Maybe Int
  }
  deriving (Int -> RoomSummary -> ShowS
[RoomSummary] -> ShowS
RoomSummary -> String
(Int -> RoomSummary -> ShowS)
-> (RoomSummary -> String)
-> ([RoomSummary] -> ShowS)
-> Show RoomSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoomSummary] -> ShowS
$cshowList :: [RoomSummary] -> ShowS
show :: RoomSummary -> String
$cshow :: RoomSummary -> String
showsPrec :: Int -> RoomSummary -> ShowS
$cshowsPrec :: Int -> RoomSummary -> ShowS
Show, RoomSummary -> RoomSummary -> Bool
(RoomSummary -> RoomSummary -> Bool)
-> (RoomSummary -> RoomSummary -> Bool) -> Eq RoomSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoomSummary -> RoomSummary -> Bool
$c/= :: RoomSummary -> RoomSummary -> Bool
== :: RoomSummary -> RoomSummary -> Bool
$c== :: RoomSummary -> RoomSummary -> Bool
Eq, (forall x. RoomSummary -> Rep RoomSummary x)
-> (forall x. Rep RoomSummary x -> RoomSummary)
-> Generic RoomSummary
forall x. Rep RoomSummary x -> RoomSummary
forall x. RoomSummary -> Rep RoomSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RoomSummary x -> RoomSummary
$cfrom :: forall x. RoomSummary -> Rep RoomSummary x
Generic)

data TimelineSync = TimelineSync
  { TimelineSync -> Maybe [RoomEvent]
tsEvents :: Maybe [RoomEvent],
    TimelineSync -> Maybe Bool
tsLimited :: Maybe Bool,
    TimelineSync -> Maybe Text
tsPrevBatch :: Maybe Text
  }
  deriving (Int -> TimelineSync -> ShowS
[TimelineSync] -> ShowS
TimelineSync -> String
(Int -> TimelineSync -> ShowS)
-> (TimelineSync -> String)
-> ([TimelineSync] -> ShowS)
-> Show TimelineSync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimelineSync] -> ShowS
$cshowList :: [TimelineSync] -> ShowS
show :: TimelineSync -> String
$cshow :: TimelineSync -> String
showsPrec :: Int -> TimelineSync -> ShowS
$cshowsPrec :: Int -> TimelineSync -> ShowS
Show, TimelineSync -> TimelineSync -> Bool
(TimelineSync -> TimelineSync -> Bool)
-> (TimelineSync -> TimelineSync -> Bool) -> Eq TimelineSync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimelineSync -> TimelineSync -> Bool
$c/= :: TimelineSync -> TimelineSync -> Bool
== :: TimelineSync -> TimelineSync -> Bool
$c== :: TimelineSync -> TimelineSync -> Bool
Eq, (forall x. TimelineSync -> Rep TimelineSync x)
-> (forall x. Rep TimelineSync x -> TimelineSync)
-> Generic TimelineSync
forall x. Rep TimelineSync x -> TimelineSync
forall x. TimelineSync -> Rep TimelineSync x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimelineSync x -> TimelineSync
$cfrom :: forall x. TimelineSync -> Rep TimelineSync x
Generic)

data JoinedRoomSync = JoinedRoomSync
  { JoinedRoomSync -> Maybe RoomSummary
jrsSummary :: Maybe RoomSummary,
    JoinedRoomSync -> TimelineSync
jrsTimeline :: TimelineSync
  }
  deriving (Int -> JoinedRoomSync -> ShowS
[JoinedRoomSync] -> ShowS
JoinedRoomSync -> String
(Int -> JoinedRoomSync -> ShowS)
-> (JoinedRoomSync -> String)
-> ([JoinedRoomSync] -> ShowS)
-> Show JoinedRoomSync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinedRoomSync] -> ShowS
$cshowList :: [JoinedRoomSync] -> ShowS
show :: JoinedRoomSync -> String
$cshow :: JoinedRoomSync -> String
showsPrec :: Int -> JoinedRoomSync -> ShowS
$cshowsPrec :: Int -> JoinedRoomSync -> ShowS
Show, JoinedRoomSync -> JoinedRoomSync -> Bool
(JoinedRoomSync -> JoinedRoomSync -> Bool)
-> (JoinedRoomSync -> JoinedRoomSync -> Bool) -> Eq JoinedRoomSync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinedRoomSync -> JoinedRoomSync -> Bool
$c/= :: JoinedRoomSync -> JoinedRoomSync -> Bool
== :: JoinedRoomSync -> JoinedRoomSync -> Bool
$c== :: JoinedRoomSync -> JoinedRoomSync -> Bool
Eq, (forall x. JoinedRoomSync -> Rep JoinedRoomSync x)
-> (forall x. Rep JoinedRoomSync x -> JoinedRoomSync)
-> Generic JoinedRoomSync
forall x. Rep JoinedRoomSync x -> JoinedRoomSync
forall x. JoinedRoomSync -> Rep JoinedRoomSync x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoinedRoomSync x -> JoinedRoomSync
$cfrom :: forall x. JoinedRoomSync -> Rep JoinedRoomSync x
Generic)

data Presence = Offline | Online | Unavailable deriving (Presence -> Presence -> Bool
(Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool) -> Eq Presence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Presence -> Presence -> Bool
$c/= :: Presence -> Presence -> Bool
== :: Presence -> Presence -> Bool
$c== :: Presence -> Presence -> Bool
Eq)

instance Show Presence where
  show :: Presence -> String
show = \case
    Presence
Offline -> String
"offline"
    Presence
Online -> String
"online"
    Presence
Unavailable -> String
"unavailable"

instance ToJSON Presence where
  toJSON :: Presence -> Value
toJSON Presence
ef = Text -> Value
String (Text -> Value) -> (Presence -> Text) -> Presence -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Presence -> String) -> Presence -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Presence -> String
forall a. Show a => a -> String
show (Presence -> Value) -> Presence -> Value
forall a b. (a -> b) -> a -> b
$ Presence
ef

instance FromJSON Presence where
  parseJSON :: Value -> Parser Presence
parseJSON Value
v = case Value
v of
    (String Text
"offline") -> Presence -> Parser Presence
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presence
Offline
    (String Text
"online") -> Presence -> Parser Presence
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presence
Online
    (String Text
"unavailable") -> Presence -> Parser Presence
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presence
Unavailable
    Value
_ -> Parser Presence
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data SyncResult = SyncResult
  { SyncResult -> Text
srNextBatch :: Text,
    SyncResult -> Maybe SyncResultRoom
srRooms :: Maybe SyncResultRoom
  }
  deriving (Int -> SyncResult -> ShowS
[SyncResult] -> ShowS
SyncResult -> String
(Int -> SyncResult -> ShowS)
-> (SyncResult -> String)
-> ([SyncResult] -> ShowS)
-> Show SyncResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SyncResult] -> ShowS
$cshowList :: [SyncResult] -> ShowS
show :: SyncResult -> String
$cshow :: SyncResult -> String
showsPrec :: Int -> SyncResult -> ShowS
$cshowsPrec :: Int -> SyncResult -> ShowS
Show, SyncResult -> SyncResult -> Bool
(SyncResult -> SyncResult -> Bool)
-> (SyncResult -> SyncResult -> Bool) -> Eq SyncResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyncResult -> SyncResult -> Bool
$c/= :: SyncResult -> SyncResult -> Bool
== :: SyncResult -> SyncResult -> Bool
$c== :: SyncResult -> SyncResult -> Bool
Eq, (forall x. SyncResult -> Rep SyncResult x)
-> (forall x. Rep SyncResult x -> SyncResult) -> Generic SyncResult
forall x. Rep SyncResult x -> SyncResult
forall x. SyncResult -> Rep SyncResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SyncResult x -> SyncResult
$cfrom :: forall x. SyncResult -> Rep SyncResult x
Generic)

data SyncResultRoom = SyncResultRoom
  { SyncResultRoom -> Maybe (Map Text JoinedRoomSync)
srrJoin :: Maybe (Map Text JoinedRoomSync)
  , SyncResultRoom -> Maybe (Map Text InvitedRoomSync)
srrInvite :: Maybe (Map Text InvitedRoomSync)
  }
  deriving (Int -> SyncResultRoom -> ShowS
[SyncResultRoom] -> ShowS
SyncResultRoom -> String
(Int -> SyncResultRoom -> ShowS)
-> (SyncResultRoom -> String)
-> ([SyncResultRoom] -> ShowS)
-> Show SyncResultRoom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SyncResultRoom] -> ShowS
$cshowList :: [SyncResultRoom] -> ShowS
show :: SyncResultRoom -> String
$cshow :: SyncResultRoom -> String
showsPrec :: Int -> SyncResultRoom -> ShowS
$cshowsPrec :: Int -> SyncResultRoom -> ShowS
Show, SyncResultRoom -> SyncResultRoom -> Bool
(SyncResultRoom -> SyncResultRoom -> Bool)
-> (SyncResultRoom -> SyncResultRoom -> Bool) -> Eq SyncResultRoom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyncResultRoom -> SyncResultRoom -> Bool
$c/= :: SyncResultRoom -> SyncResultRoom -> Bool
== :: SyncResultRoom -> SyncResultRoom -> Bool
$c== :: SyncResultRoom -> SyncResultRoom -> Bool
Eq, (forall x. SyncResultRoom -> Rep SyncResultRoom x)
-> (forall x. Rep SyncResultRoom x -> SyncResultRoom)
-> Generic SyncResultRoom
forall x. Rep SyncResultRoom x -> SyncResultRoom
forall x. SyncResultRoom -> Rep SyncResultRoom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SyncResultRoom x -> SyncResultRoom
$cfrom :: forall x. SyncResultRoom -> Rep SyncResultRoom x
Generic)

data InvitedRoomSync = InvitedRoomSync
  deriving (Int -> InvitedRoomSync -> ShowS
[InvitedRoomSync] -> ShowS
InvitedRoomSync -> String
(Int -> InvitedRoomSync -> ShowS)
-> (InvitedRoomSync -> String)
-> ([InvitedRoomSync] -> ShowS)
-> Show InvitedRoomSync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvitedRoomSync] -> ShowS
$cshowList :: [InvitedRoomSync] -> ShowS
show :: InvitedRoomSync -> String
$cshow :: InvitedRoomSync -> String
showsPrec :: Int -> InvitedRoomSync -> ShowS
$cshowsPrec :: Int -> InvitedRoomSync -> ShowS
Show, InvitedRoomSync -> InvitedRoomSync -> Bool
(InvitedRoomSync -> InvitedRoomSync -> Bool)
-> (InvitedRoomSync -> InvitedRoomSync -> Bool)
-> Eq InvitedRoomSync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvitedRoomSync -> InvitedRoomSync -> Bool
$c/= :: InvitedRoomSync -> InvitedRoomSync -> Bool
== :: InvitedRoomSync -> InvitedRoomSync -> Bool
$c== :: InvitedRoomSync -> InvitedRoomSync -> Bool
Eq, (forall x. InvitedRoomSync -> Rep InvitedRoomSync x)
-> (forall x. Rep InvitedRoomSync x -> InvitedRoomSync)
-> Generic InvitedRoomSync
forall x. Rep InvitedRoomSync x -> InvitedRoomSync
forall x. InvitedRoomSync -> Rep InvitedRoomSync x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvitedRoomSync x -> InvitedRoomSync
$cfrom :: forall x. InvitedRoomSync -> Rep InvitedRoomSync x
Generic)

unFilterID :: FilterID -> Text
unFilterID :: FilterID -> Text
unFilterID (FilterID Text
x) = Text
x

-------------------------------------------------------------------------------
-- https://matrix.org/docs/spec/client_server/latest#forming-relationships-between-events

headMaybe :: [a] -> Maybe a
headMaybe :: [a] -> Maybe a
headMaybe [a]
xs = case [a]
xs of
  [] -> Maybe a
forall a. Maybe a
Nothing
  (a
x : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x

tail' :: [a] -> [a]
tail' :: [a] -> [a]
tail' [a]
xs = case [a]
xs of
  [] -> []
  (a
_ : [a]
rest) -> [a]
rest

-- | An helper to create a reply body
--
-- >>> let sender = Author "foo@matrix.org"
-- >>> addReplyBody sender "Hello" "hi"
-- "> <foo@matrix.org> Hello\n\nhi"
--
-- >>> addReplyBody sender "" "hey"
-- "> <foo@matrix.org>\n\nhey"
--
-- >>> addReplyBody sender "a multi\nline" "resp"
-- "> <foo@matrix.org> a multi\n> line\n\nresp"
addReplyBody :: Author -> Text -> Text -> Text
addReplyBody :: Author -> Text -> Text -> Text
addReplyBody (Author Text
author) Text
old Text
reply =
  let oldLines :: [Text]
oldLines = Text -> [Text]
Text.lines Text
old
      headLine :: Text
headLine = Text
"> <" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
author Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
" ") ([Text] -> Maybe Text
forall a. [a] -> Maybe a
headMaybe [Text]
oldLines)
      newBody :: [Text]
newBody = [Text
headLine] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"> ") ([Text] -> [Text]
forall a. [a] -> [a]
tail' [Text]
oldLines) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
""] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
reply]
   in Int -> Text -> Text
Text.dropEnd Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines [Text]
newBody

addReplyFormattedBody :: RoomID -> EventID -> Author -> Text -> Text -> Text
addReplyFormattedBody :: RoomID -> EventID -> Author -> Text -> Text -> Text
addReplyFormattedBody (RoomID Text
roomID) (EventID Text
eventID) (Author Text
author) Text
old Text
reply =
  [Text] -> Text
Text.unlines
    [ Text
"<mx-reply>",
      Text
"  <blockquote>",
      Text
"    <a href=\"https://matrix.to/#/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roomID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
eventID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\">In reply to</a>",
      Text
"    <a href=\"https://matrix.to/#/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
author Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
author Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</a>",
      Text
"    <br />",
      Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
old,
      Text
"  </blockquote>",
      Text
"</mx-reply>",
      Text
reply
    ]

-- | Convert body by encoding HTML special char
--
-- >>> toFormattedBody "& <test>"
-- "&amp; &lt;test&gt;"
toFormattedBody :: Text -> Text
toFormattedBody :: Text -> Text
toFormattedBody = (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
char
  where
    char :: Char -> Text
char Char
x = case Char
x of
      Char
'<' -> Text
"&lt;"
      Char
'>' -> Text
"&gt;"
      Char
'&' -> Text
"&amp;"
      Char
_ -> Char -> Text
Text.singleton Char
x

-- | Prepare a reply event
mkReply ::
  -- | The destination room, must match the original event
  RoomID ->
  -- | The original event
  RoomEvent ->
  -- | The reply message
  MessageText ->
  -- | The event to send
  Event
mkReply :: RoomID -> RoomEvent -> MessageText -> Event
mkReply RoomID
room RoomEvent
re MessageText
mt =
  let getFormattedBody :: MessageText -> Text
getFormattedBody MessageText
mt' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
toFormattedBody (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ MessageText -> Text
mtBody MessageText
mt') (MessageText -> Maybe Text
mtFormattedBody MessageText
mt')
      eventID :: EventID
eventID = RoomEvent -> EventID
reEventId RoomEvent
re
      author :: Author
author = RoomEvent -> Author
reSender RoomEvent
re
      updateText :: MessageText -> MessageText
updateText MessageText
oldMT =
        MessageText
oldMT
          { mtFormat :: Maybe Text
mtFormat = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"org.matrix.custom.html",
            mtBody :: Text
mtBody = Author -> Text -> Text -> Text
addReplyBody Author
author (MessageText -> Text
mtBody MessageText
oldMT) (MessageText -> Text
mtBody MessageText
mt),
            mtFormattedBody :: Maybe Text
mtFormattedBody =
              Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
                RoomID -> EventID -> Author -> Text -> Text -> Text
addReplyFormattedBody
                  RoomID
room
                  EventID
eventID
                  Author
author
                  (MessageText -> Text
getFormattedBody MessageText
oldMT)
                  (MessageText -> Text
getFormattedBody MessageText
mt)
          }

      newMessage :: MessageText
newMessage = case RoomEvent -> Event
reContent RoomEvent
re of
        EventRoomMessage (RoomMessageText MessageText
oldMT) -> MessageText -> MessageText
updateText MessageText
oldMT
        EventRoomReply EventID
_ (RoomMessageText MessageText
oldMT) -> MessageText -> MessageText
updateText MessageText
oldMT
        EventRoomEdit (EventID, RoomMessage)
_ (RoomMessageText MessageText
oldMT) -> MessageText -> MessageText
updateText MessageText
oldMT
        EventUnknown Object
x -> String -> MessageText
forall a. HasCallStack => String -> a
error (String -> MessageText) -> String -> MessageText
forall a b. (a -> b) -> a -> b
$ String
"Can't reply to " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. Show a => a -> String
show Object
x
   in EventID -> RoomMessage -> Event
EventRoomReply EventID
eventID (MessageText -> RoomMessage
RoomMessageText MessageText
newMessage)

sync :: ClientSession -> Maybe FilterID -> Maybe Text -> Maybe Presence -> Maybe Int -> MatrixIO SyncResult
sync :: ClientSession
-> Maybe FilterID
-> Maybe Text
-> Maybe Presence
-> Maybe Int
-> MatrixIO SyncResult
sync ClientSession
session Maybe FilterID
filterM Maybe Text
sinceM Maybe Presence
presenceM Maybe Int
timeoutM = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
"/_matrix/client/r0/sync"
  ClientSession -> Request -> MatrixIO SyncResult
forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session ([(Method, Maybe Method)] -> Request -> Request
HTTP.setQueryString [(Method, Maybe Method)]
qs Request
request)
  where
    toQs :: a -> Maybe Text -> [(a, Maybe Method)]
toQs a
name = \case
      Maybe Text
Nothing -> []
      Just Text
v -> [(a
name, Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method)
-> (Text -> Method) -> Text -> Maybe Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
encodeUtf8 (Text -> Maybe Method) -> Text -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Text
v)]
    qs :: [(Method, Maybe Method)]
qs =
      Method -> Maybe Text -> [(Method, Maybe Method)]
forall a. a -> Maybe Text -> [(a, Maybe Method)]
toQs Method
"filter" (FilterID -> Text
unFilterID (FilterID -> Text) -> Maybe FilterID -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilterID
filterM)
        [(Method, Maybe Method)]
-> [(Method, Maybe Method)] -> [(Method, Maybe Method)]
forall a. Semigroup a => a -> a -> a
<> Method -> Maybe Text -> [(Method, Maybe Method)]
forall a. a -> Maybe Text -> [(a, Maybe Method)]
toQs Method
"since" Maybe Text
sinceM
        [(Method, Maybe Method)]
-> [(Method, Maybe Method)] -> [(Method, Maybe Method)]
forall a. Semigroup a => a -> a -> a
<> Method -> Maybe Text -> [(Method, Maybe Method)]
forall a. a -> Maybe Text -> [(a, Maybe Method)]
toQs Method
"set_presence" (String -> Text
pack (String -> Text) -> (Presence -> String) -> Presence -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Presence -> String
forall a. Show a => a -> String
show (Presence -> Text) -> Maybe Presence -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Presence
presenceM)
        [(Method, Maybe Method)]
-> [(Method, Maybe Method)] -> [(Method, Maybe Method)]
forall a. Semigroup a => a -> a -> a
<> Method -> Maybe Text -> [(Method, Maybe Method)]
forall a. a -> Maybe Text -> [(a, Maybe Method)]
toQs Method
"timeout" (String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Maybe Int -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
timeoutM)

syncPoll ::
  (MonadIO m) =>
  -- | The client session, use 'createSession' to get one.
  ClientSession ->
  -- | A sync filter, use 'createFilter' to get one.
  Maybe FilterID ->
  -- | A since value, get it from a previous sync result using the 'srNextBatch' field.
  Maybe Text ->
  -- | Set the session presence.
  Maybe Presence ->
  -- | Your callback to handle sync result.
  (SyncResult -> m ()) ->
  -- | This function does not return unless there is an error.
  MatrixM m ()
syncPoll :: ClientSession
-> Maybe FilterID
-> Maybe Text
-> Maybe Presence
-> (SyncResult -> m ())
-> MatrixM m ()
syncPoll ClientSession
session Maybe FilterID
filterM Maybe Text
sinceM Maybe Presence
presenceM SyncResult -> m ()
cb = Maybe Text -> MatrixM m ()
forall b. Maybe Text -> m (Either MatrixError b)
go Maybe Text
sinceM
  where
    go :: Maybe Text -> m (Either MatrixError b)
go Maybe Text
since = do
      Either MatrixError SyncResult
syncResultE <- MatrixIO SyncResult -> m (Either MatrixError SyncResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MatrixIO SyncResult -> m (Either MatrixError SyncResult))
-> MatrixIO SyncResult -> m (Either MatrixError SyncResult)
forall a b. (a -> b) -> a -> b
$ MatrixIO SyncResult -> MatrixIO SyncResult
forall a. MatrixIO a -> MatrixIO a
retry (MatrixIO SyncResult -> MatrixIO SyncResult)
-> MatrixIO SyncResult -> MatrixIO SyncResult
forall a b. (a -> b) -> a -> b
$ ClientSession
-> Maybe FilterID
-> Maybe Text
-> Maybe Presence
-> Maybe Int
-> MatrixIO SyncResult
sync ClientSession
session Maybe FilterID
filterM Maybe Text
since Maybe Presence
presenceM (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10_000)
      case Either MatrixError SyncResult
syncResultE of
        Left MatrixError
err -> Either MatrixError b -> m (Either MatrixError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MatrixError -> Either MatrixError b
forall a b. a -> Either a b
Left MatrixError
err)
        Right SyncResult
sr -> SyncResult -> m ()
cb SyncResult
sr m () -> m (Either MatrixError b) -> m (Either MatrixError b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> m (Either MatrixError b)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just (SyncResult -> Text
srNextBatch SyncResult
sr))

-- | Extract room events from a sync result
getTimelines :: SyncResult -> [(RoomID, NonEmpty RoomEvent)]
getTimelines :: SyncResult -> [(RoomID, NonEmpty RoomEvent)]
getTimelines SyncResult
sr = (Text
 -> JoinedRoomSync
 -> [(RoomID, NonEmpty RoomEvent)]
 -> [(RoomID, NonEmpty RoomEvent)])
-> [(RoomID, NonEmpty RoomEvent)]
-> Map Text JoinedRoomSync
-> [(RoomID, NonEmpty RoomEvent)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey Text
-> JoinedRoomSync
-> [(RoomID, NonEmpty RoomEvent)]
-> [(RoomID, NonEmpty RoomEvent)]
getEvents [] Map Text JoinedRoomSync
joinedRooms
  where
    getEvents :: Text -> JoinedRoomSync -> [(RoomID, NonEmpty RoomEvent)] -> [(RoomID, NonEmpty RoomEvent)]
    getEvents :: Text
-> JoinedRoomSync
-> [(RoomID, NonEmpty RoomEvent)]
-> [(RoomID, NonEmpty RoomEvent)]
getEvents Text
roomID JoinedRoomSync
jrs [(RoomID, NonEmpty RoomEvent)]
acc = case TimelineSync -> Maybe [RoomEvent]
tsEvents (JoinedRoomSync -> TimelineSync
jrsTimeline JoinedRoomSync
jrs) of
      Just (RoomEvent
x : [RoomEvent]
xs) -> (Text -> RoomID
RoomID Text
roomID, RoomEvent
x RoomEvent -> [RoomEvent] -> NonEmpty RoomEvent
forall a. a -> [a] -> NonEmpty a
:| [RoomEvent]
xs) (RoomID, NonEmpty RoomEvent)
-> [(RoomID, NonEmpty RoomEvent)] -> [(RoomID, NonEmpty RoomEvent)]
forall a. a -> [a] -> [a]
: [(RoomID, NonEmpty RoomEvent)]
acc
      Maybe [RoomEvent]
_ -> [(RoomID, NonEmpty RoomEvent)]
acc
    joinedRooms :: Map Text JoinedRoomSync
joinedRooms = Map Text JoinedRoomSync
-> Maybe (Map Text JoinedRoomSync) -> Map Text JoinedRoomSync
forall a. a -> Maybe a -> a
fromMaybe Map Text JoinedRoomSync
forall a. Monoid a => a
mempty (Maybe (Map Text JoinedRoomSync) -> Map Text JoinedRoomSync)
-> Maybe (Map Text JoinedRoomSync) -> Map Text JoinedRoomSync
forall a b. (a -> b) -> a -> b
$ SyncResult -> Maybe SyncResultRoom
srRooms SyncResult
sr Maybe SyncResultRoom
-> (SyncResultRoom -> Maybe (Map Text JoinedRoomSync))
-> Maybe (Map Text JoinedRoomSync)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SyncResultRoom -> Maybe (Map Text JoinedRoomSync)
srrJoin

-------------------------------------------------------------------------------
-- Derived JSON instances
instance ToJSON RoomEvent where
  toJSON :: RoomEvent -> Value
toJSON RoomEvent {Text
EventID
Event
Author
reSender :: Author
reEventId :: EventID
reType :: Text
reContent :: Event
reSender :: RoomEvent -> Author
reEventId :: RoomEvent -> EventID
reType :: RoomEvent -> Text
reContent :: RoomEvent -> Event
..} =
    [Pair] -> Value
object
      [ Text
"content" Text -> Event -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Event
reContent,
        Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
reType,
        Text
"event_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EventID -> Text
unEventID EventID
reEventId,
        Text
"sender" Text -> Author -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Author
reSender
      ]

instance FromJSON RoomEvent where
  parseJSON :: Value -> Parser RoomEvent
parseJSON (Object Object
o) = do
    Text
eventId <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"event_id"
    Event -> Text -> EventID -> Author -> RoomEvent
RoomEvent (Event -> Text -> EventID -> Author -> RoomEvent)
-> Parser Event -> Parser (Text -> EventID -> Author -> RoomEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Event
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"content" Parser (Text -> EventID -> Author -> RoomEvent)
-> Parser Text -> Parser (EventID -> Author -> RoomEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" Parser (EventID -> Author -> RoomEvent)
-> Parser EventID -> Parser (Author -> RoomEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventID -> Parser EventID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> EventID
EventID Text
eventId) Parser (Author -> RoomEvent) -> Parser Author -> Parser RoomEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Author
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sender"
  parseJSON Value
_ = Parser RoomEvent
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON RoomSummary where
  toJSON :: RoomSummary -> Value
toJSON = Options -> RoomSummary -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON RoomSummary where
  parseJSON :: Value -> Parser RoomSummary
parseJSON = Options -> Value -> Parser RoomSummary
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON TimelineSync where
  toJSON :: TimelineSync -> Value
toJSON = Options -> TimelineSync -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON TimelineSync where
  parseJSON :: Value -> Parser TimelineSync
parseJSON = Options -> Value -> Parser TimelineSync
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON JoinedRoomSync where
  toJSON :: JoinedRoomSync -> Value
toJSON = Options -> JoinedRoomSync -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON JoinedRoomSync where
  parseJSON :: Value -> Parser JoinedRoomSync
parseJSON = Options -> Value -> Parser JoinedRoomSync
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON InvitedRoomSync where
  toJSON :: InvitedRoomSync -> Value
toJSON InvitedRoomSync
_ = [Pair] -> Value
object []

instance FromJSON InvitedRoomSync where
  parseJSON :: Value -> Parser InvitedRoomSync
parseJSON Value
_ = InvitedRoomSync -> Parser InvitedRoomSync
forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitedRoomSync
InvitedRoomSync

instance ToJSON SyncResult where
  toJSON :: SyncResult -> Value
toJSON = Options -> SyncResult -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON SyncResult where
  parseJSON :: Value -> Parser SyncResult
parseJSON = Options -> Value -> Parser SyncResult
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON SyncResultRoom where
  toJSON :: SyncResultRoom -> Value
toJSON = Options -> SyncResultRoom -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON SyncResultRoom where
  parseJSON :: Value -> Parser SyncResultRoom
parseJSON = Options -> Value -> Parser SyncResultRoom
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions