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

-- | This module contains the client-server API
-- https://matrix.org/docs/spec/client_server/r0.6.1
module Network.Matrix.Client
  ( -- * Client
    ClientSession,
    LoginCredentials (..),
    MatrixToken (..),
    Username (..),
    DeviceId (..),
    InitialDeviceDisplayName (..),
    LoginSecret (..),
    LoginResponse (..),
    getTokenFromEnv,
    createSession,
    login,
    loginToken,
    logout,

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

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

    -- * Room Events
    Dir (..),
    EventType (..),
    MRCreate (..),
    MRCanonicalAlias (..),
    MRGuestAccess (..),
    MRHistoryVisibility (..),
    MRName (..),
    MRTopic (..),
    PaginatedRoomMessages (..),
    StateKey (..),
    StateEvent (..),
    StateContent (..),
    getRoomEvent,
    getRoomMembers,
    getRoomState,
    getRoomStateEvent,
    getRoomMessages,
    redact,
    sendRoomStateEvent,

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

    -- * Room participation
    ResolvedRoomAlias (..),
    TxnID (..),
    sendMessage,
    mkReply,
    module Network.Matrix.Events,
    setRoomAlias,
    setRoomVisibility,
    resolveRoomAlias,
    deleteRoomAlias,
    getRoomAliases,

    -- * Room membership
    RoomID (..),
    RoomAlias (..),
    banUser,
    checkRoomVisibility,
    forgetRoom,
    getJoinedRooms,
    getPublicRooms,
    getPublicRooms',
    inviteToRoom,
    joinRoom,
    joinRoomById,
    leaveRoomById,
    kickUser,
    knockOnRoom,
    unbanUser,

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

    -- * Account data

    AccountData(accountDataType),
    getAccountData,
    getAccountData',
    setAccountData,
    setAccountData',

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

import Control.Monad (mzero, void)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object, String), encode, genericParseJSON, genericToJSON, object, withObject, withText, (.:), (.:?), (.=))
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, catMaybes)
import Data.Proxy (Proxy(Proxy))
import qualified Data.Text as T
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
import qualified Network.URI as URI
import Data.Coerce
import Data.Bifunctor (bimap)
import Data.List (intersperse)
import Data.Aeson.Types (Parser)
import Control.Applicative
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL

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

data LoginCredentials = LoginCredentials
  { LoginCredentials -> Username
lUsername :: Username
  , LoginCredentials -> LoginSecret
lLoginSecret :: LoginSecret
  , LoginCredentials -> Text
lBaseUrl :: T.Text
  , LoginCredentials -> Maybe DeviceId
lDeviceId :: Maybe DeviceId
  , LoginCredentials -> Maybe InitialDeviceDisplayName
lInitialDeviceDisplayName :: Maybe InitialDeviceDisplayName
  }

mkLoginRequest :: LoginCredentials -> IO HTTP.Request
mkLoginRequest :: LoginCredentials -> IO Request
mkLoginRequest LoginCredentials {Maybe InitialDeviceDisplayName
Maybe DeviceId
Text
LoginSecret
Username
lInitialDeviceDisplayName :: Maybe InitialDeviceDisplayName
lDeviceId :: Maybe DeviceId
lBaseUrl :: Text
lLoginSecret :: LoginSecret
lUsername :: Username
lInitialDeviceDisplayName :: LoginCredentials -> Maybe InitialDeviceDisplayName
lDeviceId :: LoginCredentials -> Maybe DeviceId
lBaseUrl :: LoginCredentials -> Text
lLoginSecret :: LoginCredentials -> LoginSecret
lUsername :: LoginCredentials -> Username
..} =
  Text
-> Maybe DeviceId
-> Maybe InitialDeviceDisplayName
-> Username
-> LoginSecret
-> IO Request
mkLoginRequest' Text
lBaseUrl Maybe DeviceId
lDeviceId Maybe InitialDeviceDisplayName
lInitialDeviceDisplayName Username
lUsername LoginSecret
lLoginSecret

-- | 'login' allows you to generate a session token.
login :: LoginCredentials -> IO ClientSession
login :: LoginCredentials -> IO ClientSession
login = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoginCredentials -> IO (ClientSession, MatrixToken)
loginToken 

-- | 'loginToken' allows you to generate a session token and recover the Matrix auth token.
loginToken :: LoginCredentials -> IO (ClientSession, MatrixToken)
loginToken :: LoginCredentials -> IO (ClientSession, MatrixToken)
loginToken LoginCredentials
cred = do
  Request
req <- LoginCredentials -> IO Request
mkLoginRequest LoginCredentials
cred
  Manager
manager <- IO Manager
mkManager
  Either MatrixError LoginResponse
resp' <- forall a.
FromJSON a =>
Manager -> Request -> IO (Either MatrixError a)
doRequest' Manager
manager Request
req
  case Either MatrixError LoginResponse
resp' of
    Right LoginResponse {Text
lrDeviceId :: LoginResponse -> Text
lrHomeServer :: LoginResponse -> Text
lrAccessToken :: LoginResponse -> Text
lrUserId :: LoginResponse -> Text
lrDeviceId :: Text
lrHomeServer :: Text
lrAccessToken :: Text
lrUserId :: Text
..} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> MatrixToken -> Manager -> ClientSession
ClientSession (LoginCredentials -> Text
lBaseUrl LoginCredentials
cred) (Text -> MatrixToken
MatrixToken Text
lrAccessToken) Manager
manager, (Text -> MatrixToken
MatrixToken Text
lrAccessToken))
    Left MatrixError
err ->
      -- NOTE: There is nothing to recover after a failed login attempt
      forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show MatrixError
err

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

-- | 'logout' allows you to destroy a session token.
logout :: ClientSession -> MatrixIO ()
logout :: ClientSession -> MatrixIO ()
logout session :: ClientSession
session@ClientSession {Text
Manager
MatrixToken
manager :: Manager
token :: MatrixToken
baseUrl :: Text
manager :: ClientSession -> Manager
token :: ClientSession -> MatrixToken
baseUrl :: ClientSession -> Text
..} = do
  Request
req <- ClientSession -> IO Request
mkLogoutRequest ClientSession
session
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) forall a b. (a -> b) -> a -> b
$ forall a.
FromJSON a =>
Manager -> Request -> IO (Either MatrixError a)
doRequest' @Value Manager
manager Request
req

-- | The session record, use 'createSession' to create it.
data ClientSession = ClientSession
  { ClientSession -> Text
baseUrl :: T.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"
  T.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' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Manager
mkManager

mkRequest :: ClientSession -> Bool -> T.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 :: forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession {Text
Manager
MatrixToken
manager :: Manager
token :: MatrixToken
baseUrl :: Text
manager :: ClientSession -> Manager
token :: ClientSession -> MatrixToken
baseUrl :: ClientSession -> Text
..} = 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 =
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session 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 T.Text,
    CreateRoomResponse -> Maybe Text
crrID :: Maybe T.Text
  }

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

-------------------------------------------------------------------------------
-- Room Event API Calls https://spec.matrix.org/v1.1/client-server-api/#getting-events-for-a-room

getRoomEvent :: ClientSession -> RoomID -> EventID -> MatrixIO RoomEvent
getRoomEvent :: ClientSession -> RoomID -> EventID -> MatrixIO RoomEvent
getRoomEvent ClientSession
session (RoomID Text
rid) (EventID Text
eid) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/event/" forall a. Semigroup a => a -> a -> a
<> Text
eid
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session Request
request

data User = User { User -> Text
userDisplayName :: T.Text, User -> Maybe Text
userAvatarUrl :: Maybe T.Text }
  deriving Int -> User -> ShowS
[User] -> ShowS
User -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> [Char]
$cshow :: User -> [Char]
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show

instance FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"User" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
userDisplayName <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display_name"
    Maybe Text
userAvatarUrl <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar_url"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ User {Maybe Text
Text
userAvatarUrl :: Maybe Text
userDisplayName :: Text
userAvatarUrl :: Maybe Text
userDisplayName :: Text
..}

-- | Unexported newtype to grant us a 'FromJSON' instance.
newtype JoinedUsers = JoinedUsers (Map UserID User)

instance FromJSON JoinedUsers where
  parseJSON :: Value -> Parser JoinedUsers
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"JoinedUsers" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Map UserID User
users <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"joined"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Map UserID User -> JoinedUsers
JoinedUsers Map UserID User
users

-- | This API returns a map of MXIDs to member info objects for
-- members of the room. The current user must be in the room for it to
-- work.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3roomsroomidjoined_members
getRoomMembers :: ClientSession -> RoomID -> MatrixIO (Map UserID User)
getRoomMembers :: ClientSession -> RoomID -> MatrixIO (Map UserID User)
getRoomMembers ClientSession
session (RoomID Text
rid) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/joined_members"
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap coerce :: forall a b. Coercible a b => a -> b
coerce) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest @JoinedUsers ClientSession
session Request
request
    
newtype StateKey = StateKey T.Text
  deriving stock Int -> StateKey -> ShowS
[StateKey] -> ShowS
StateKey -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StateKey] -> ShowS
$cshowList :: [StateKey] -> ShowS
show :: StateKey -> [Char]
$cshow :: StateKey -> [Char]
showsPrec :: Int -> StateKey -> ShowS
$cshowsPrec :: Int -> StateKey -> ShowS
Show
  deriving newtype Value -> Parser [StateKey]
Value -> Parser StateKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StateKey]
$cparseJSONList :: Value -> Parser [StateKey]
parseJSON :: Value -> Parser StateKey
$cparseJSON :: Value -> Parser StateKey
FromJSON

newtype EventType = EventType T.Text
  deriving stock Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EventType] -> ShowS
$cshowList :: [EventType] -> ShowS
show :: EventType -> [Char]
$cshow :: EventType -> [Char]
showsPrec :: Int -> EventType -> ShowS
$cshowsPrec :: Int -> EventType -> ShowS
Show
  deriving newtype Value -> Parser [EventType]
Value -> Parser EventType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EventType]
$cparseJSONList :: Value -> Parser [EventType]
parseJSON :: Value -> Parser EventType
$cparseJSON :: Value -> Parser EventType
FromJSON

data MRCreate = MRCreate { MRCreate -> UserID
mrcCreator :: UserID, MRCreate -> Integer
mrcRoomVersion :: Integer }
  deriving Int -> MRCreate -> ShowS
[MRCreate] -> ShowS
MRCreate -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MRCreate] -> ShowS
$cshowList :: [MRCreate] -> ShowS
show :: MRCreate -> [Char]
$cshow :: MRCreate -> [Char]
showsPrec :: Int -> MRCreate -> ShowS
$cshowsPrec :: Int -> MRCreate -> ShowS
Show

instance FromJSON MRCreate where
  parseJSON :: Value -> Parser MRCreate
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RoomCreate" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    UserID
mrcCreator <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
    Integer
mrcRoomVersion <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"room_version"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MRCreate {Integer
UserID
mrcRoomVersion :: Integer
mrcCreator :: UserID
mrcRoomVersion :: Integer
mrcCreator :: UserID
..}

newtype MRName = MRName { MRName -> Text
mrnName :: T.Text }
  deriving Int -> MRName -> ShowS
[MRName] -> ShowS
MRName -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MRName] -> ShowS
$cshowList :: [MRName] -> ShowS
show :: MRName -> [Char]
$cshow :: MRName -> [Char]
showsPrec :: Int -> MRName -> ShowS
$cshowsPrec :: Int -> MRName -> ShowS
Show

instance FromJSON MRName where
  parseJSON :: Value -> Parser MRName
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RoomName" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> MRName
MRName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")

newtype MRCanonicalAlias = MRCanonicalAlias { MRCanonicalAlias -> Text
mrcAlias :: T.Text }
  deriving Int -> MRCanonicalAlias -> ShowS
[MRCanonicalAlias] -> ShowS
MRCanonicalAlias -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MRCanonicalAlias] -> ShowS
$cshowList :: [MRCanonicalAlias] -> ShowS
show :: MRCanonicalAlias -> [Char]
$cshow :: MRCanonicalAlias -> [Char]
showsPrec :: Int -> MRCanonicalAlias -> ShowS
$cshowsPrec :: Int -> MRCanonicalAlias -> ShowS
Show

instance FromJSON MRCanonicalAlias where
  parseJSON :: Value -> Parser MRCanonicalAlias
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RoomCanonicalAlias" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> MRCanonicalAlias
MRCanonicalAlias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"alias")

newtype MRGuestAccess = MRGuestAccess { MRGuestAccess -> Text
mrGuestAccess :: T.Text }
  deriving Int -> MRGuestAccess -> ShowS
[MRGuestAccess] -> ShowS
MRGuestAccess -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MRGuestAccess] -> ShowS
$cshowList :: [MRGuestAccess] -> ShowS
show :: MRGuestAccess -> [Char]
$cshow :: MRGuestAccess -> [Char]
showsPrec :: Int -> MRGuestAccess -> ShowS
$cshowsPrec :: Int -> MRGuestAccess -> ShowS
Show

instance FromJSON MRGuestAccess where
  parseJSON :: Value -> Parser MRGuestAccess
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"GuestAccess" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> MRGuestAccess
MRGuestAccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guest_access")

newtype MRHistoryVisibility = MRHistoryVisibility { MRHistoryVisibility -> Text
mrHistoryVisibility :: T.Text }
  deriving Int -> MRHistoryVisibility -> ShowS
[MRHistoryVisibility] -> ShowS
MRHistoryVisibility -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MRHistoryVisibility] -> ShowS
$cshowList :: [MRHistoryVisibility] -> ShowS
show :: MRHistoryVisibility -> [Char]
$cshow :: MRHistoryVisibility -> [Char]
showsPrec :: Int -> MRHistoryVisibility -> ShowS
$cshowsPrec :: Int -> MRHistoryVisibility -> ShowS
Show

instance FromJSON MRHistoryVisibility where
  parseJSON :: Value -> Parser MRHistoryVisibility
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HistoryVisibility" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> MRHistoryVisibility
MRHistoryVisibility forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"history_visibility")

newtype MRTopic = MRTopic { MRTopic -> Text
mrTopic :: T.Text }
  deriving Int -> MRTopic -> ShowS
[MRTopic] -> ShowS
MRTopic -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MRTopic] -> ShowS
$cshowList :: [MRTopic] -> ShowS
show :: MRTopic -> [Char]
$cshow :: MRTopic -> [Char]
showsPrec :: Int -> MRTopic -> ShowS
$cshowsPrec :: Int -> MRTopic -> ShowS
Show

instance FromJSON MRTopic where
  parseJSON :: Value -> Parser MRTopic
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RoomTopic" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> MRTopic
MRTopic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"topic")
    
data StateContent =
    StRoomCreate MRCreate
 -- | StRoomMember MRMember
 -- | StRoomPowerLevels MRPowerLevels
 -- | StRoomJoinRules MRJoinRules
  | StRoomCanonicalAlias MRCanonicalAlias
  | StRoomGuestAccess MRGuestAccess
  | StRoomHistoryVisibility MRHistoryVisibility
  | StRoomName MRName
  | StRoomTopic MRTopic
  | StOther Value
 --- | StSpaceParent MRSpaceParent
  deriving Int -> StateContent -> ShowS
[StateContent] -> ShowS
StateContent -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StateContent] -> ShowS
$cshowList :: [StateContent] -> ShowS
show :: StateContent -> [Char]
$cshow :: StateContent -> [Char]
showsPrec :: Int -> StateContent -> ShowS
$cshowsPrec :: Int -> StateContent -> ShowS
Show

pStRoomCreate :: Value -> Parser StateContent
pStRoomCreate :: Value -> Parser StateContent
pStRoomCreate Value
v = MRCreate -> StateContent
StRoomCreate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

pStRoomCanonicAlias :: Value -> Parser StateContent
pStRoomCanonicAlias :: Value -> Parser StateContent
pStRoomCanonicAlias Value
v = MRCanonicalAlias -> StateContent
StRoomCanonicalAlias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

pStRoomGuestAccess :: Value -> Parser StateContent
pStRoomGuestAccess :: Value -> Parser StateContent
pStRoomGuestAccess Value
v = MRGuestAccess -> StateContent
StRoomGuestAccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

pStRoomHistoryVisibility :: Value -> Parser StateContent
pStRoomHistoryVisibility :: Value -> Parser StateContent
pStRoomHistoryVisibility Value
v = MRHistoryVisibility -> StateContent
StRoomHistoryVisibility forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

pStRoomName :: Value -> Parser StateContent
pStRoomName :: Value -> Parser StateContent
pStRoomName Value
v = MRName -> StateContent
StRoomName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

pStRoomTopic :: Value -> Parser StateContent
pStRoomTopic :: Value -> Parser StateContent
pStRoomTopic Value
v = MRTopic -> StateContent
StRoomTopic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

pStRoomOther :: Value -> Parser StateContent
pStRoomOther :: Value -> Parser StateContent
pStRoomOther Value
v = Value -> StateContent
StOther forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    
instance FromJSON StateContent where
  parseJSON :: Value -> Parser StateContent
parseJSON Value
v = 
        Value -> Parser StateContent
pStRoomCreate Value
v 
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser StateContent
pStRoomCanonicAlias Value
v
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser StateContent
pStRoomGuestAccess Value
v
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser StateContent
pStRoomHistoryVisibility Value
v
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser StateContent
pStRoomName Value
v
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser StateContent
pStRoomTopic Value
v
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser StateContent
pStRoomOther Value
v

-- TODO(SOLOMON): Should This constructor be in 'Event'?
data StateEvent = StateEvent
  { StateEvent -> StateContent
seContent :: StateContent
  , StateEvent -> EventID
seEventId :: EventID
  , StateEvent -> Integer
seOriginServerTimestamp :: Integer
  , StateEvent -> Maybe Value
sePreviousContent :: Maybe Value
  , StateEvent -> RoomID
seRoomId :: RoomID
  , StateEvent -> UserID
seSender :: UserID
  , StateEvent -> StateKey
seStateKey :: StateKey
  , StateEvent -> EventType
seEventType :: EventType
  , StateEvent -> Maybe Value
seUnsigned :: Maybe Value
  } deriving Int -> StateEvent -> ShowS
[StateEvent] -> ShowS
StateEvent -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StateEvent] -> ShowS
$cshowList :: [StateEvent] -> ShowS
show :: StateEvent -> [Char]
$cshow :: StateEvent -> [Char]
showsPrec :: Int -> StateEvent -> ShowS
$cshowsPrec :: Int -> StateEvent -> ShowS
Show

instance FromJSON StateEvent where
  parseJSON :: Value -> Parser StateEvent
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"StateEvent" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    StateContent
seContent <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"
    EventID
seEventId <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> EventID
EventID forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_id"
    Integer
seOriginServerTimestamp <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"origin_server_ts"
    Maybe Value
sePreviousContent <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previous_content"
    RoomID
seRoomId <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RoomID
RoomID forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"room_id"
    UserID
seSender <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> UserID
UserID forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sender"
    StateKey
seStateKey <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state_key"
    EventType
seEventType <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Value
seUnsigned <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unsigned"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ StateEvent {Integer
Maybe Value
EventID
UserID
RoomID
StateContent
EventType
StateKey
seUnsigned :: Maybe Value
seEventType :: EventType
seStateKey :: StateKey
seSender :: UserID
seRoomId :: RoomID
sePreviousContent :: Maybe Value
seOriginServerTimestamp :: Integer
seEventId :: EventID
seContent :: StateContent
seUnsigned :: Maybe Value
seEventType :: EventType
seStateKey :: StateKey
seSender :: UserID
seRoomId :: RoomID
sePreviousContent :: Maybe Value
seOriginServerTimestamp :: Integer
seEventId :: EventID
seContent :: StateContent
..}
      
-- | Get the state events for the current state of a room.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3roomsroomidstate
getRoomState :: ClientSession -> RoomID -> MatrixIO [StateEvent]
getRoomState :: ClientSession -> RoomID -> MatrixIO [StateEvent]
getRoomState ClientSession
session (RoomID Text
rid) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/state"
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session Request
request

-- | Looks up the contents of a state event in a room. If the user is
-- joined to the room then the state is taken from the current state
-- of the room. If the user has left the room then the state is taken
-- from the state of the room when they left.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3roomsroomidstateeventtypestatekey
getRoomStateEvent :: ClientSession -> RoomID -> EventType -> StateKey -> MatrixIO StateEvent
getRoomStateEvent :: ClientSession
-> RoomID -> EventType -> StateKey -> MatrixIO StateEvent
getRoomStateEvent ClientSession
session (RoomID Text
rid) (EventType Text
et) (StateKey Text
key) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/state" forall a. Semigroup a => a -> a -> a
<> Text
et forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
key
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session Request
request

data Dir
  = -- | Forward
    F
  | -- | Backward
    B

renderDir :: Dir -> B.ByteString
renderDir :: Dir -> ByteString
renderDir Dir
F = ByteString
"f"
renderDir Dir
B = ByteString
"b"

data PaginatedRoomMessages = PaginatedRoomMessages
  { PaginatedRoomMessages -> [RoomEvent]
chunk :: [RoomEvent]
  , PaginatedRoomMessages -> Maybe Text
end :: Maybe T.Text
  -- ^ A token corresponding to the end of chunk. 
  , PaginatedRoomMessages -> Text
start :: T.Text
  -- ^ A token corresponding to the start of chunk.
  , PaginatedRoomMessages -> [StateEvent]
state :: [StateEvent]
  -- ^ A list of state events relevant to showing the chunk.
  } deriving Int -> PaginatedRoomMessages -> ShowS
[PaginatedRoomMessages] -> ShowS
PaginatedRoomMessages -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PaginatedRoomMessages] -> ShowS
$cshowList :: [PaginatedRoomMessages] -> ShowS
show :: PaginatedRoomMessages -> [Char]
$cshow :: PaginatedRoomMessages -> [Char]
showsPrec :: Int -> PaginatedRoomMessages -> ShowS
$cshowsPrec :: Int -> PaginatedRoomMessages -> ShowS
Show

instance FromJSON PaginatedRoomMessages where
  parseJSON :: Value -> Parser PaginatedRoomMessages
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PaginatedRoomMessages" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [RoomEvent]
chunk <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chunk"
    Maybe Text
end <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"end"
    Text
start <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start"
    [StateEvent]
state <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PaginatedRoomMessages {[RoomEvent]
[StateEvent]
Maybe Text
Text
state :: [StateEvent]
start :: Text
end :: Maybe Text
chunk :: [RoomEvent]
state :: [StateEvent]
start :: Text
end :: Maybe Text
chunk :: [RoomEvent]
..}

getRoomMessages ::
  ClientSession ->
  -- | The room to get events from.
  RoomID ->
  -- | The direction to return events from.
  Dir ->
  -- | A 'RoomEventFilter' to filter returned events with.
  Maybe RoomEventFilter -> 
  -- | The Since value to start returning events from. 
  T.Text ->
  -- | The maximum number of events to return. Default: 10.
  Maybe Int ->
  -- | The token to stop returning events at. 
  Maybe Int ->
  MatrixIO PaginatedRoomMessages
getRoomMessages :: ClientSession
-> RoomID
-> Dir
-> Maybe RoomEventFilter
-> Text
-> Maybe Int
-> Maybe Int
-> MatrixIO PaginatedRoomMessages
getRoomMessages ClientSession
session (RoomID Text
rid) Dir
dir Maybe RoomEventFilter
roomFilter Text
fromToken Maybe Int
limit Maybe Int
toToken = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/messages"
  let dir' :: ByteString
dir' = ByteString
"dir=" forall a. Semigroup a => a -> a -> a
<> Dir -> ByteString
renderDir Dir
dir
      filter' :: Maybe ByteString
filter' = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend ByteString
"filter=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RoomEventFilter
roomFilter
      from' :: ByteString
from' = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
"from=" forall a. Semigroup a => a -> a -> a
<> Text
fromToken
      limit' :: Maybe ByteString
limit' = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend ByteString
"limit=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
limit
      to' :: Maybe ByteString
to' = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend ByteString
"from=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
toToken
      queryString :: ByteString
queryString = forall a. Monoid a => a -> a -> a
mappend ByteString
"?" forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse ByteString
"&" forall a b. (a -> b) -> a -> b
$ [ByteString
dir', ByteString
from' ] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [Maybe ByteString
to', Maybe ByteString
limit', Maybe ByteString
filter']
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$ Request
request { queryString :: ByteString
HTTP.queryString = ByteString
queryString }

-- | Send arbitrary state events to a room. These events will be overwritten if
-- <room id>, <event type> and <state key> all match.
-- https://spec.matrix.org/v1.1/client-server-api/#put_matrixclientv3roomsroomidstateeventtypestatekey
sendRoomStateEvent :: ClientSession -> RoomID -> EventType -> StateKey -> Value -> MatrixIO EventID 
sendRoomStateEvent :: ClientSession
-> RoomID -> EventType -> StateKey -> Value -> MatrixIO EventID
sendRoomStateEvent ClientSession
session (RoomID Text
rid) (EventType Text
et) (StateKey Text
key) Value
event = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUriComponent Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/state/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUriComponent Text
et forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUriComponent Text
key
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
    Request
request { method :: ByteString
HTTP.method = ByteString
"PUT"
            , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
event
            }

newtype TxnID = TxnID T.Text deriving (Int -> TxnID -> ShowS
[TxnID] -> ShowS
TxnID -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TxnID] -> ShowS
$cshowList :: [TxnID] -> ShowS
show :: TxnID -> [Char]
$cshow :: TxnID -> [Char]
showsPrec :: Int -> TxnID -> ShowS
$cshowsPrec :: Int -> TxnID -> ShowS
Show, TxnID -> TxnID -> Bool
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)

-- | This endpoint is used to send a message event to a room.
-- https://spec.matrix.org/v1.1/client-server-api/#put_matrixclientv3roomsroomidsendeventtypetxnid
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
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
    ClientSession
session
    ( Request
request
        { method :: ByteString
HTTP.method = ByteString
"PUT",
          requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Event
event
        }
    )
  where
    path :: Text
path = Text
"/_matrix/client/r0/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/send/" forall a. Semigroup a => a -> a -> a
<> Text
eventId forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
txnId
    eventId :: Text
eventId = Event -> Text
eventType Event
event

redact :: ClientSession -> RoomID -> EventID -> TxnID -> T.Text -> MatrixIO EventID
redact :: ClientSession
-> RoomID -> EventID -> TxnID -> Text -> MatrixIO EventID
redact ClientSession
session (RoomID Text
rid) (EventID Text
eid) (TxnID Text
txnid) Text
reason = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/redact/" forall a. Semigroup a => a -> a -> a
<> Text
eid forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
txnid
  let body :: Value
body = [Pair] -> Value
object [Key
"reason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
reason]
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
    Request
request { method :: ByteString
HTTP.method = ByteString
"PUT"
            , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
            }

-------------------------------------------------------------------------------
-- Room API Calls https://spec.matrix.org/v1.1/client-server-api/#rooms-1

-- | Create a new room with various configuration options.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3createroom
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/v3/createRoom"
  Either MatrixError CreateRoomResponse -> Either MatrixError RoomID
toRoomID
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
      ClientSession
session
      ( Request
request
          { method :: ByteString
HTTP.method = ByteString
"POST",
            requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ 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 -> 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
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> RoomID
RoomID Text
roomID
        (Maybe Text
_, Just Text
message) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Int -> MatrixError
MatrixError Text
"UNKNOWN" Text
message forall a. Maybe a
Nothing
        (Maybe Text, Maybe Text)
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Int -> MatrixError
MatrixError Text
"UNKOWN" Text
"" forall a. Maybe a
Nothing

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

data ResolvedRoomAlias = ResolvedRoomAlias
  { ResolvedRoomAlias -> RoomAlias
roomAlias :: RoomAlias
  , ResolvedRoomAlias -> RoomID
roomID :: RoomID
  -- ^ The room ID for this room alias.
  , ResolvedRoomAlias -> [Text]
servers :: [T.Text]
  -- ^ A list of servers that are aware of this room alias.
  } deriving Int -> ResolvedRoomAlias -> ShowS
[ResolvedRoomAlias] -> ShowS
ResolvedRoomAlias -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedRoomAlias] -> ShowS
$cshowList :: [ResolvedRoomAlias] -> ShowS
show :: ResolvedRoomAlias -> [Char]
$cshow :: ResolvedRoomAlias -> [Char]
showsPrec :: Int -> ResolvedRoomAlias -> ShowS
$cshowsPrec :: Int -> ResolvedRoomAlias -> ShowS
Show

-- | Boilerplate data type for an aeson instance
data RoomAliasMetadata = RoomAliasMetadata
  { RoomAliasMetadata -> RoomID
ramRoomID :: RoomID
  , RoomAliasMetadata -> [Text]
ramServers :: [T.Text]
  }

instance FromJSON RoomAliasMetadata where
  parseJSON :: Value -> Parser RoomAliasMetadata
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"ResolvedRoomAlias" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    RoomID
ramRoomID <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RoomID
RoomID forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"room_id"
    [Text]
ramServers <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"servers"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RoomAliasMetadata {[Text]
RoomID
ramServers :: [Text]
ramRoomID :: RoomID
ramServers :: [Text]
ramRoomID :: RoomID
..}

-- | Requests that the server resolve a room alias to a room ID.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3directoryroomroomalias
resolveRoomAlias :: ClientSession -> RoomAlias -> MatrixIO ResolvedRoomAlias
resolveRoomAlias :: ClientSession -> RoomAlias -> MatrixIO ResolvedRoomAlias
resolveRoomAlias ClientSession
session r :: RoomAlias
r@(RoomAlias Text
alias) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/directory/room/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUriComponent Text
alias
  Either MatrixError RoomAliasMetadata
resp <- forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$ Request
request { method :: ByteString
HTTP.method = ByteString
"GET" }
  case Either MatrixError RoomAliasMetadata
resp of
    Left MatrixError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left MatrixError
err
    Right RoomAliasMetadata {[Text]
RoomID
ramServers :: [Text]
ramRoomID :: RoomID
ramServers :: RoomAliasMetadata -> [Text]
ramRoomID :: RoomAliasMetadata -> RoomID
..} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ RoomAlias -> RoomID -> [Text] -> ResolvedRoomAlias
ResolvedRoomAlias RoomAlias
r RoomID
ramRoomID [Text]
ramServers

-- | Create a mapping of room alias to room ID.
-- https://spec.matrix.org/v1.1/client-server-api/#put_matrixclientv3directoryroomroomalias
setRoomAlias :: ClientSession -> RoomAlias -> RoomID -> MatrixIO ()
setRoomAlias :: ClientSession -> RoomAlias -> RoomID -> MatrixIO ()
setRoomAlias ClientSession
session (RoomAlias Text
alias) (RoomID Text
roomId)= do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/directory/room/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUriComponent Text
alias
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
    ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"PUT"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [(Key
"room_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
roomId)]
              }
-- | Delete a mapping of room alias to room ID.
-- https://spec.matrix.org/v1.1/client-server-api/#delete_matrixclientv3directoryroomroomalias
deleteRoomAlias :: ClientSession -> RoomAlias -> MatrixIO ()
deleteRoomAlias :: ClientSession -> RoomAlias -> MatrixIO ()
deleteRoomAlias ClientSession
session (RoomAlias Text
alias) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/directory/room/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeUriComponent Text
alias
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$ Request
request { method :: ByteString
HTTP.method = ByteString
"DELETE" }

data ResolvedAliases = ResolvedAliases [RoomAlias]

instance FromJSON ResolvedAliases where
  parseJSON :: Value -> Parser ResolvedAliases
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"ResolvedAliases" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Text]
aliases <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"aliases"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [RoomAlias] -> ResolvedAliases
ResolvedAliases (Text -> RoomAlias
RoomAlias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
aliases)
    
-- | Get a list of aliases maintained by the local server for the given room.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3roomsroomidaliases
getRoomAliases :: ClientSession -> RoomID -> MatrixIO [RoomAlias]
getRoomAliases :: ClientSession -> RoomID -> MatrixIO [RoomAlias]
getRoomAliases ClientSession
session (RoomID Text
rid) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/aliases"
  Either MatrixError ResolvedAliases
resp <- forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
    ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"GET" }
  case Either MatrixError ResolvedAliases
resp of
    Left MatrixError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left MatrixError
err
    Right (ResolvedAliases [RoomAlias]
aliases) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [RoomAlias]
aliases
-- | 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JoinedRooms] -> ShowS
$cshowList :: [JoinedRooms] -> ShowS
show :: JoinedRooms -> [Char]
$cshow :: JoinedRooms -> [Char]
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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"joined_rooms"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RoomID] -> JoinedRooms
JoinedRooms forall a b. (a -> b) -> a -> b
$ Text -> RoomID
RoomID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rooms
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Returns a list of the user’s current rooms.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3joined_rooms
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 <- forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session Request
request
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ JoinedRooms -> [RoomID]
unRooms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either MatrixError JoinedRooms
response

newtype RoomID = RoomID T.Text deriving (Int -> RoomID -> ShowS
[RoomID] -> ShowS
RoomID -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RoomID] -> ShowS
$cshowList :: [RoomID] -> ShowS
show :: RoomID -> [Char]
$cshow :: RoomID -> [Char]
showsPrec :: Int -> RoomID -> ShowS
$cshowsPrec :: Int -> RoomID -> ShowS
Show, RoomID -> RoomID -> Bool
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
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
Ord, Eq RoomID
Int -> RoomID -> Int
RoomID -> Int
forall a. Eq 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"room_id"
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Invites a user to participate in a particular room. They do not
-- start participating in the room until they actually join the room.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidinvite
inviteToRoom :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
inviteToRoom :: ClientSession -> RoomID -> UserID -> Maybe Text -> MatrixIO ()
inviteToRoom ClientSession
session (RoomID Text
rid) (UserID Text
uid) Maybe Text
reason = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
rid forall a. Semigroup a => a -> a -> a
<> Text
"/invite"
  let body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [(Key
"user_id", forall a. ToJSON a => a -> Value
toJSON Text
uid)] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"reason",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Text
reason]
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"POST"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
              }

-- | Note that this API takes either a room ID or alias, unlike 'joinRoomById'
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3joinroomidoralias
joinRoom :: ClientSession -> T.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 forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/r0/join/" forall a. Semigroup a => a -> a -> a
<> Text
roomNameUrl
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: ByteString
HTTP.method = ByteString
"POST"})
  where
    roomNameUrl :: Text
roomNameUrl = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlEncode Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
roomName

-- | Starts a user participating in a particular room, if that user is
-- allowed to participate in that room.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidjoin
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 forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/r0/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/join"
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: ByteString
HTTP.method = ByteString
"POST"})

-- | This API “knocks” on the room to ask for permission to join, if
-- the user is allowed to knock on the room.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3knockroomidoralias
knockOnRoom :: ClientSession -> Either RoomID RoomAlias -> [T.Text] -> Maybe T.Text -> MatrixIO RoomID
knockOnRoom :: ClientSession
-> Either RoomID RoomAlias
-> [Text]
-> Maybe Text
-> MatrixIO RoomID
knockOnRoom ClientSession
session Either RoomID RoomAlias
room [Text]
servers Maybe Text
reason = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
" /_matrix/client/v3/knock/" forall a. Semigroup a => a -> a -> a
<> forall x. Either x x -> x
indistinct (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce Either RoomID RoomAlias
room)
  let body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"reason",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Text
reason]
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"POST"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
              , queryString :: ByteString
HTTP.queryString = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
"?server_name=" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Text
"," [Text]
servers)
              }

-- | Stops remembering a particular room.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidforget
forgetRoom :: ClientSession -> RoomID -> MatrixIO ()
forgetRoom :: ClientSession -> RoomID -> MatrixIO ()
forgetRoom ClientSession
session (RoomID Text
roomId) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/forget"
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: ByteString
HTTP.method = ByteString
"POST"})
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown forget response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
value
     

-- | Stop participating in a particular room.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidleave
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 forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/r0/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/leave"
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session (Request
request {method :: ByteString
HTTP.method = ByteString
"POST"})
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown leave response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
value

-- | Kick a user from the room.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidkick
kickUser :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
kickUser :: ClientSession -> RoomID -> UserID -> Maybe Text -> MatrixIO ()
kickUser ClientSession
session (RoomID Text
roomId) (UserID Text
uid) Maybe Text
reason = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/kick"
  let body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [(Key
"user_id", forall a. ToJSON a => a -> Value
toJSON Text
uid)] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"reason",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Text
reason]
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"POST"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
              }
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown leave response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
value

-- | Ban a user in the room. If the user is currently in the room, also kick them.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidban
banUser :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
banUser :: ClientSession -> RoomID -> UserID -> Maybe Text -> MatrixIO ()
banUser ClientSession
session (RoomID Text
roomId) (UserID Text
uid) Maybe Text
reason = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/ban"
  let body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [(Key
"user_id", forall a. ToJSON a => a -> Value
toJSON Text
uid)] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"reason",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Text
reason]
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"POST"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
              }
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown leave response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
value

-- | Unban a user from the room. This allows them to be invited to the
-- room, and join if they would otherwise be allowed to join according
-- to its join rules.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidunban
unbanUser :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
unbanUser :: ClientSession -> RoomID -> UserID -> Maybe Text -> MatrixIO ()
unbanUser ClientSession
session (RoomID Text
roomId) (UserID Text
uid) Maybe Text
reason = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/rooms/" forall a. Semigroup a => a -> a -> a
<> Text
roomId forall a. Semigroup a => a -> a -> a
<> Text
"/unban"
  let body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [(Key
"user_id", forall a. ToJSON a => a -> Value
toJSON Text
uid)] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"reason",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Text
reason]
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"POST"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
              }
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown leave response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
value

data Visibility = Public | Private
  deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> [Char]
$cshow :: Visibility -> [Char]
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show)

instance ToJSON Visibility where
  toJSON :: Visibility -> Value
toJSON = \case
    Visibility
Public -> Text -> Value
String Text
"public"
    Visibility
Private -> Text -> Value
String Text
"private"

instance FromJSON Visibility where
  parseJSON :: Value -> Parser Visibility
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Visibility" forall a b. (a -> b) -> a -> b
$ \case
    Text
"public" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Visibility
Public
    Text
"private" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Visibility
Private
    Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

newtype GetVisibility = GetVisibility { GetVisibility -> Visibility
getVisibility :: Visibility }

instance FromJSON GetVisibility where
  parseJSON :: Value -> Parser GetVisibility
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"GetVisibility" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Visibility
getVisibility <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"visibility"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ GetVisibility {Visibility
getVisibility :: Visibility
getVisibility :: Visibility
..}
    
-- | Gets the visibility of a given room on the server’s public room directory.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3directorylistroomroomid
checkRoomVisibility :: ClientSession -> RoomID -> MatrixIO Visibility
checkRoomVisibility :: ClientSession -> RoomID -> MatrixIO Visibility
checkRoomVisibility ClientSession
session (RoomID Text
rid) = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/directory/list/room/" forall a. Semigroup a => a -> a -> a
<> Text
rid
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetVisibility -> Visibility
getVisibility) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session Request
request
    
-- | Sets the visibility of a given room in the server’s public room directory.
-- https://spec.matrix.org/v1.1/client-server-api/#put_matrixclientv3directorylistroomroomid
setRoomVisibility :: ClientSession -> RoomID -> Visibility -> MatrixIO ()
setRoomVisibility :: ClientSession -> RoomID -> Visibility -> MatrixIO ()
setRoomVisibility ClientSession
session (RoomID Text
rid) Visibility
visibility = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ Text
"/_matrix/client/v3/directory/list/room/" forall a. Semigroup a => a -> a -> a
<> Text
rid
  let body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [(Key
"visibility", forall a. ToJSON a => a -> Value
toJSON Visibility
visibility)]
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
ensureEmptyObject) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
      Request
request { method :: ByteString
HTTP.method = ByteString
"PUT"
              , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
              }
  where
    ensureEmptyObject :: Value -> ()
    ensureEmptyObject :: Value -> ()
ensureEmptyObject Value
value = case Value
value of
      Object Object
xs | Object
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty -> ()
      Value
_anyOther -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown setRoomVisibility response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
value

-- | A pagination token from a previous request, allowing clients to
-- get the next (or previous) batch of rooms. The direction of
-- pagination is specified solely by which token is supplied, rather
-- than via an explicit flag.
newtype PaginationChunk = PaginationChunk { PaginationChunk -> Text
getChunk :: T.Text }
  deriving stock (Int -> PaginationChunk -> ShowS
[PaginationChunk] -> ShowS
PaginationChunk -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PaginationChunk] -> ShowS
$cshowList :: [PaginationChunk] -> ShowS
show :: PaginationChunk -> [Char]
$cshow :: PaginationChunk -> [Char]
showsPrec :: Int -> PaginationChunk -> ShowS
$cshowsPrec :: Int -> PaginationChunk -> ShowS
Show)
  deriving newtype ([PaginationChunk] -> Encoding
[PaginationChunk] -> Value
PaginationChunk -> Encoding
PaginationChunk -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PaginationChunk] -> Encoding
$ctoEncodingList :: [PaginationChunk] -> Encoding
toJSONList :: [PaginationChunk] -> Value
$ctoJSONList :: [PaginationChunk] -> Value
toEncoding :: PaginationChunk -> Encoding
$ctoEncoding :: PaginationChunk -> Encoding
toJSON :: PaginationChunk -> Value
$ctoJSON :: PaginationChunk -> Value
ToJSON, Value -> Parser [PaginationChunk]
Value -> Parser PaginationChunk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PaginationChunk]
$cparseJSONList :: Value -> Parser [PaginationChunk]
parseJSON :: Value -> Parser PaginationChunk
$cparseJSON :: Value -> Parser PaginationChunk
FromJSON)

data Room = Room
  { Room -> Maybe [Text]
aliases :: Maybe [T.Text]
  , Room -> Maybe Text
avatarUrl :: Maybe T.Text
  , Room -> Maybe Text
canonicalAlias :: Maybe T.Text
  , Room -> Bool
guestCanJoin :: Bool
  , Room -> Maybe Text
joinRule :: Maybe T.Text
  , Room -> Maybe Text
name :: Maybe T.Text
  , Room -> Int
numJoinedMembers :: Int
  , Room -> RoomID
roomId :: RoomID
  , Room -> Maybe Text
topic :: Maybe T.Text
  , Room -> Bool
worldReadable :: Bool
  } deriving Int -> Room -> ShowS
[Room] -> ShowS
Room -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Room] -> ShowS
$cshowList :: [Room] -> ShowS
show :: Room -> [Char]
$cshow :: Room -> [Char]
showsPrec :: Int -> Room -> ShowS
$cshowsPrec :: Int -> Room -> ShowS
Show

instance FromJSON Room where
  parseJSON :: Value -> Parser Room
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Room" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe [Text]
aliases <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" 
    Maybe Text
avatarUrl <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar_url"
    Maybe Text
canonicalAlias <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"canonical_alias"
    Bool
guestCanJoin <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guest_can_join"
    Maybe Text
joinRule <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"join_rule"
    Maybe Text
name <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
    Int
numJoinedMembers <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"num_joined_members"
    RoomID
roomId <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RoomID
RoomID forall a b. (a -> b) -> a -> b
$ Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"room_id"
    Maybe Text
topic <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"topic"
    Bool
worldReadable <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"world_readable"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Room {Bool
Int
Maybe [Text]
Maybe Text
RoomID
worldReadable :: Bool
topic :: Maybe Text
roomId :: RoomID
numJoinedMembers :: Int
name :: Maybe Text
joinRule :: Maybe Text
guestCanJoin :: Bool
canonicalAlias :: Maybe Text
avatarUrl :: Maybe Text
aliases :: Maybe [Text]
worldReadable :: Bool
topic :: Maybe Text
roomId :: RoomID
numJoinedMembers :: Int
name :: Maybe Text
joinRule :: Maybe Text
guestCanJoin :: Bool
canonicalAlias :: Maybe Text
avatarUrl :: Maybe Text
aliases :: Maybe [Text]
..}

data PublicRooms = PublicRooms
  { PublicRooms -> [Room]
prChunk :: [Room]
  , PublicRooms -> Maybe PaginationChunk
prNextBatch :: Maybe PaginationChunk
  , PublicRooms -> Maybe PaginationChunk
prPrevBatch :: Maybe PaginationChunk
  , PublicRooms -> Maybe Int
prTotalRoomCountEstimate :: Maybe Int
  } deriving Int -> PublicRooms -> ShowS
[PublicRooms] -> ShowS
PublicRooms -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PublicRooms] -> ShowS
$cshowList :: [PublicRooms] -> ShowS
show :: PublicRooms -> [Char]
$cshow :: PublicRooms -> [Char]
showsPrec :: Int -> PublicRooms -> ShowS
$cshowsPrec :: Int -> PublicRooms -> ShowS
Show

instance FromJSON PublicRooms where
  parseJSON :: Value -> Parser PublicRooms
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PublicRooms" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Room]
prChunk <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"chunk"
    Maybe PaginationChunk
prNextBatch <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next_batch"
    Maybe PaginationChunk
prPrevBatch <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prev_batch"
    Maybe Int
prTotalRoomCountEstimate <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_room_count_estimate"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PublicRooms {[Room]
Maybe Int
Maybe PaginationChunk
prTotalRoomCountEstimate :: Maybe Int
prPrevBatch :: Maybe PaginationChunk
prNextBatch :: Maybe PaginationChunk
prChunk :: [Room]
prTotalRoomCountEstimate :: Maybe Int
prPrevBatch :: Maybe PaginationChunk
prNextBatch :: Maybe PaginationChunk
prChunk :: [Room]
..}

-- | Lists the public rooms on the server.
-- https://spec.matrix.org/v1.1/client-server-api/#get_matrixclientv3publicrooms
getPublicRooms :: ClientSession -> Maybe Int -> Maybe PaginationChunk -> MatrixIO PublicRooms
getPublicRooms :: ClientSession
-> Maybe Int -> Maybe PaginationChunk -> MatrixIO PublicRooms
getPublicRooms ClientSession
session Maybe Int
limit Maybe PaginationChunk
chunk = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
"/_matrix/client/v3/publicRooms"
  let since :: Maybe Text
since = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Text
"since=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaginationChunk -> Text
getChunk) Maybe PaginationChunk
chunk
      limit' :: Maybe Text
limit' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Text
"limit=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tshow) Maybe Int
limit
      queryString :: ByteString
queryString = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Text
"&" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
since, Maybe Text
limit']
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
    Request
request { queryString :: ByteString
HTTP.queryString = ByteString
queryString }

newtype ThirdPartyInstanceId = ThirdPartyInstanceId T.Text
  deriving (Value -> Parser [ThirdPartyInstanceId]
Value -> Parser ThirdPartyInstanceId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ThirdPartyInstanceId]
$cparseJSONList :: Value -> Parser [ThirdPartyInstanceId]
parseJSON :: Value -> Parser ThirdPartyInstanceId
$cparseJSON :: Value -> Parser ThirdPartyInstanceId
FromJSON, [ThirdPartyInstanceId] -> Encoding
[ThirdPartyInstanceId] -> Value
ThirdPartyInstanceId -> Encoding
ThirdPartyInstanceId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ThirdPartyInstanceId] -> Encoding
$ctoEncodingList :: [ThirdPartyInstanceId] -> Encoding
toJSONList :: [ThirdPartyInstanceId] -> Value
$ctoJSONList :: [ThirdPartyInstanceId] -> Value
toEncoding :: ThirdPartyInstanceId -> Encoding
$ctoEncoding :: ThirdPartyInstanceId -> Encoding
toJSON :: ThirdPartyInstanceId -> Value
$ctoJSON :: ThirdPartyInstanceId -> Value
ToJSON)

-- | Lists the public rooms on the server, with optional filter.
-- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3publicrooms
getPublicRooms' :: ClientSession -> Maybe Int -> Maybe PaginationChunk -> Maybe T.Text -> Maybe Bool -> Maybe ThirdPartyInstanceId-> MatrixIO PublicRooms
getPublicRooms' :: ClientSession
-> Maybe Int
-> Maybe PaginationChunk
-> Maybe Text
-> Maybe Bool
-> Maybe ThirdPartyInstanceId
-> MatrixIO PublicRooms
getPublicRooms' ClientSession
session Maybe Int
limit Maybe PaginationChunk
chunk Maybe Text
searchTerm Maybe Bool
includeAllNetworks Maybe ThirdPartyInstanceId
thirdPartyId = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True Text
"/_matrix/client/v3/publicRooms"
  let filter' :: Value
filter' = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"generic_search_term",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Text
searchTerm]
      since :: Maybe Pair
since = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"since",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe PaginationChunk
chunk
      limit' :: Maybe Pair
limit' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"limit",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Int
limit
      includeAllNetworks' :: Maybe Pair
includeAllNetworks' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"include_all_networks",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe Bool
includeAllNetworks
      thirdPartyId' :: Maybe Pair
thirdPartyId' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"third_party_instance_id",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON) Maybe ThirdPartyInstanceId
thirdPartyId
      body :: Value
body = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [(Key
"filter", Value
filter')] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [ Maybe Pair
since, Maybe Pair
limit', Maybe Pair
includeAllNetworks', Maybe Pair
thirdPartyId' ]
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$
    Request
request { method :: ByteString
HTTP.method = ByteString
"POST"
            , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
body
            }
  
-------------------------------------------------------------------------------
-- https://matrix.org/docs/spec/client_server/latest#post-matrix-client-r0-user-userid-filter
newtype FilterID = FilterID T.Text deriving (Int -> FilterID -> ShowS
[FilterID] -> ShowS
FilterID -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FilterID] -> ShowS
$cshowList :: [FilterID] -> ShowS
show :: FilterID -> [Char]
$cshow :: FilterID -> [Char]
showsPrec :: Int -> FilterID -> ShowS
$cshowsPrec :: Int -> FilterID -> ShowS
Show, FilterID -> FilterID -> Bool
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, Eq FilterID
Int -> FilterID -> Int
FilterID -> Int
forall a. Eq 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filter_id"
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

data EventFormat = Client | Federation deriving (Int -> EventFormat -> ShowS
[EventFormat] -> ShowS
EventFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EventFormat] -> ShowS
$cshowList :: [EventFormat] -> ShowS
show :: EventFormat -> [Char]
$cshow :: EventFormat -> [Char]
showsPrec :: Int -> EventFormat -> ShowS
$cshowsPrec :: Int -> EventFormat -> ShowS
Show, EventFormat -> EventFormat -> Bool
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") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventFormat
Client
    (String Text
"federation") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventFormat
Federation
    Value
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

data EventFilter = EventFilter
  { EventFilter -> Maybe Int
efLimit :: Maybe Int,
    EventFilter -> Maybe [Text]
efNotSenders :: Maybe [T.Text],
    EventFilter -> Maybe [Text]
efNotTypes :: Maybe [T.Text],
    EventFilter -> Maybe [Text]
efSenders :: Maybe [T.Text],
    EventFilter -> Maybe [Text]
efTypes :: Maybe [T.Text]
  }
  deriving (Int -> EventFilter -> ShowS
[EventFilter] -> ShowS
EventFilter -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EventFilter] -> ShowS
$cshowList :: [EventFilter] -> ShowS
show :: EventFilter -> [Char]
$cshow :: EventFilter -> [Char]
showsPrec :: Int -> EventFilter -> ShowS
$cshowsPrec :: Int -> EventFilter -> ShowS
Show, EventFilter -> EventFilter -> Bool
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. 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | A filter that should match nothing
eventFilterAll :: EventFilter
eventFilterAll :: EventFilter
eventFilterAll = EventFilter
defaultEventFilter {efLimit :: Maybe Int
efLimit = forall a. a -> Maybe a
Just Int
0, efNotTypes :: Maybe [Text]
efNotTypes = 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 = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

instance FromJSON EventFilter where
  parseJSON :: Value -> Parser EventFilter
parseJSON = 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 [T.Text],
    RoomEventFilter -> Maybe [Text]
refNotTypes :: Maybe [T.Text],
    RoomEventFilter -> Maybe [Text]
refSenders :: Maybe [T.Text],
    RoomEventFilter -> Maybe [Text]
refTypes :: Maybe [T.Text],
    RoomEventFilter -> Maybe Bool
refLazyLoadMembers :: Maybe Bool,
    RoomEventFilter -> Maybe Bool
refIncludeRedundantMembers :: Maybe Bool,
    RoomEventFilter -> Maybe [Text]
refNotRooms :: Maybe [T.Text],
    RoomEventFilter -> Maybe [Text]
refRooms :: Maybe [T.Text],
    RoomEventFilter -> Maybe Bool
refContainsUrl :: Maybe Bool
  }
  deriving (Int -> RoomEventFilter -> ShowS
[RoomEventFilter] -> ShowS
RoomEventFilter -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RoomEventFilter] -> ShowS
$cshowList :: [RoomEventFilter] -> ShowS
show :: RoomEventFilter -> [Char]
$cshow :: RoomEventFilter -> [Char]
showsPrec :: Int -> RoomEventFilter -> ShowS
$cshowsPrec :: Int -> RoomEventFilter -> ShowS
Show, RoomEventFilter -> RoomEventFilter -> Bool
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. 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

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

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

instance FromJSON RoomEventFilter where
  parseJSON :: Value -> Parser RoomEventFilter
parseJSON = 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 [T.Text],
    StateFilter -> Maybe [Text]
sfNotTypes :: Maybe [T.Text],
    StateFilter -> Maybe [Text]
sfSenders :: Maybe [T.Text],
    StateFilter -> Maybe [Text]
sfTypes :: Maybe [T.Text],
    StateFilter -> Maybe Bool
sfLazyLoadMembers :: Maybe Bool,
    StateFilter -> Maybe Bool
sfIncludeRedundantMembers :: Maybe Bool,
    StateFilter -> Maybe [Text]
sfNotRooms :: Maybe [T.Text],
    StateFilter -> Maybe [Text]
sfRooms :: Maybe [T.Text],
    StateFilter -> Maybe Bool
sfContains_url :: Maybe Bool
  }
  deriving (Int -> StateFilter -> ShowS
[StateFilter] -> ShowS
StateFilter -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StateFilter] -> ShowS
$cshowList :: [StateFilter] -> ShowS
show :: StateFilter -> [Char]
$cshow :: StateFilter -> [Char]
showsPrec :: Int -> StateFilter -> ShowS
$cshowsPrec :: Int -> StateFilter -> ShowS
Show, StateFilter -> StateFilter -> Bool
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. 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

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

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

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

data RoomFilter = RoomFilter
  { RoomFilter -> Maybe [Text]
rfNotRooms :: Maybe [T.Text],
    RoomFilter -> Maybe [Text]
rfRooms :: Maybe [T.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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RoomFilter] -> ShowS
$cshowList :: [RoomFilter] -> ShowS
show :: RoomFilter -> [Char]
$cshow :: RoomFilter -> [Char]
showsPrec :: Int -> RoomFilter -> ShowS
$cshowsPrec :: Int -> RoomFilter -> ShowS
Show, RoomFilter -> RoomFilter -> Bool
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. 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

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

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

data Filter = Filter
  { Filter -> Maybe [Text]
filterEventFields :: Maybe [T.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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> [Char]
$cshow :: Filter -> [Char]
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show, Filter -> Filter -> Bool
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. 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

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

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

instance FromJSON Filter where
  parseJSON :: Value -> Parser Filter
parseJSON = 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
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest
    ClientSession
session
    ( Request
request
        { method :: ByteString
HTTP.method = ByteString
"POST",
          requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Filter
body
        }
    )
  where
    path :: Text
path = Text
"/_matrix/client/r0/user/" forall a. Semigroup a => a -> a -> a
<> Text
userID 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) =
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session 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/" forall a. Semigroup a => a -> a -> a
<> Text
userID forall a. Semigroup a => a -> a -> a
<> Text
"/filter/" 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 :: T.Text}
  deriving (Int -> Author -> ShowS
[Author] -> ShowS
Author -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> [Char]
$cshow :: Author -> [Char]
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show, Author -> Author -> Bool
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
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
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 :: T.Text,
    RoomEvent -> EventID
reEventId :: EventID,
    RoomEvent -> Author
reSender :: Author
  }
  deriving (Int -> RoomEvent -> ShowS
[RoomEvent] -> ShowS
RoomEvent -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RoomEvent] -> ShowS
$cshowList :: [RoomEvent] -> ShowS
show :: RoomEvent -> [Char]
$cshow :: RoomEvent -> [Char]
showsPrec :: Int -> RoomEvent -> ShowS
$cshowsPrec :: Int -> RoomEvent -> ShowS
Show, RoomEvent -> RoomEvent -> Bool
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. 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RoomSummary] -> ShowS
$cshowList :: [RoomSummary] -> ShowS
show :: RoomSummary -> [Char]
$cshow :: RoomSummary -> [Char]
showsPrec :: Int -> RoomSummary -> ShowS
$cshowsPrec :: Int -> RoomSummary -> ShowS
Show, RoomSummary -> RoomSummary -> Bool
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. 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 T.Text
  }
  deriving (Int -> TimelineSync -> ShowS
[TimelineSync] -> ShowS
TimelineSync -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TimelineSync] -> ShowS
$cshowList :: [TimelineSync] -> ShowS
show :: TimelineSync -> [Char]
$cshow :: TimelineSync -> [Char]
showsPrec :: Int -> TimelineSync -> ShowS
$cshowsPrec :: Int -> TimelineSync -> ShowS
Show, TimelineSync -> TimelineSync -> Bool
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. 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JoinedRoomSync] -> ShowS
$cshowList :: [JoinedRoomSync] -> ShowS
show :: JoinedRoomSync -> [Char]
$cshow :: JoinedRoomSync -> [Char]
showsPrec :: Int -> JoinedRoomSync -> ShowS
$cshowsPrec :: Int -> JoinedRoomSync -> ShowS
Show, JoinedRoomSync -> JoinedRoomSync -> Bool
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. 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
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 -> [Char]
show = \case
    Presence
Offline -> [Char]
"offline"
    Presence
Online -> [Char]
"online"
    Presence
Unavailable -> [Char]
"unavailable"

instance ToJSON Presence where
  toJSON :: Presence -> Value
toJSON Presence
ef = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tshow 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") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Presence
Offline
    (String Text
"online") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Presence
Online
    (String Text
"unavailable") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Presence
Unavailable
    Value
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

data SyncResult = SyncResult
  { SyncResult -> Text
srNextBatch :: T.Text,
    SyncResult -> Maybe SyncResultRoom
srRooms :: Maybe SyncResultRoom
  }
  deriving (Int -> SyncResult -> ShowS
[SyncResult] -> ShowS
SyncResult -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SyncResult] -> ShowS
$cshowList :: [SyncResult] -> ShowS
show :: SyncResult -> [Char]
$cshow :: SyncResult -> [Char]
showsPrec :: Int -> SyncResult -> ShowS
$cshowsPrec :: Int -> SyncResult -> ShowS
Show, SyncResult -> SyncResult -> Bool
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. 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 T.Text JoinedRoomSync)
  , SyncResultRoom -> Maybe (Map Text InvitedRoomSync)
srrInvite :: Maybe (Map T.Text InvitedRoomSync)
  }
  deriving (Int -> SyncResultRoom -> ShowS
[SyncResultRoom] -> ShowS
SyncResultRoom -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SyncResultRoom] -> ShowS
$cshowList :: [SyncResultRoom] -> ShowS
show :: SyncResultRoom -> [Char]
$cshow :: SyncResultRoom -> [Char]
showsPrec :: Int -> SyncResultRoom -> ShowS
$cshowsPrec :: Int -> SyncResultRoom -> ShowS
Show, SyncResultRoom -> SyncResultRoom -> Bool
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. 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InvitedRoomSync] -> ShowS
$cshowList :: [InvitedRoomSync] -> ShowS
show :: InvitedRoomSync -> [Char]
$cshow :: InvitedRoomSync -> [Char]
showsPrec :: Int -> InvitedRoomSync -> ShowS
$cshowsPrec :: Int -> InvitedRoomSync -> ShowS
Show, InvitedRoomSync -> InvitedRoomSync -> Bool
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. 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 -> T.Text
unFilterID :: FilterID -> Text
unFilterID (FilterID Text
x) = Text
x

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

-- | 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 -> T.Text -> T.Text -> T.Text
addReplyBody :: Author -> Text -> Text -> Text
addReplyBody (Author Text
author) Text
old Text
reply =
  let oldLines :: [Text]
oldLines = Text -> [Text]
T.lines Text
old
      headLine :: Text
headLine = Text
"> <" forall a. Semigroup a => a -> a -> a
<> Text
author forall a. Semigroup a => a -> a -> a
<> Text
">" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a. Monoid a => a -> a -> a
mappend Text
" ") (forall a. [a] -> Maybe a
headMaybe [Text]
oldLines)
      newBody :: [Text]
newBody = [Text
headLine] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => a -> a -> a
mappend Text
"> ") (forall a. [a] -> [a]
tail' [Text]
oldLines) forall a. Semigroup a => a -> a -> a
<> [Text
""] forall a. Semigroup a => a -> a -> a
<> [Text
reply]
   in Int -> Text -> Text
T.dropEnd Int
1 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
newBody

addReplyFormattedBody :: RoomID -> EventID -> Author -> T.Text -> T.Text -> T.Text
addReplyFormattedBody :: RoomID -> EventID -> Author -> Text -> Text -> Text
addReplyFormattedBody (RoomID Text
roomID) (EventID Text
eventID) (Author Text
author) Text
old Text
reply =
  [Text] -> Text
T.unlines
    [ Text
"<mx-reply>",
      Text
"  <blockquote>",
      Text
"    <a href=\"https://matrix.to/#/" forall a. Semigroup a => a -> a -> a
<> Text
roomID forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
eventID forall a. Semigroup a => a -> a -> a
<> Text
"\">In reply to</a>",
      Text
"    <a href=\"https://matrix.to/#/" forall a. Semigroup a => a -> a -> a
<> Text
author forall a. Semigroup a => a -> a -> a
<> Text
"\">" forall a. Semigroup a => a -> a -> a
<> Text
author forall a. Semigroup a => a -> a -> a
<> Text
"</a>",
      Text
"    <br />",
      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 :: T.Text -> T.Text
toFormattedBody :: Text -> Text
toFormattedBody = (Char -> Text) -> Text -> Text
T.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
T.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' = forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
toFormattedBody 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 = 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 =
              forall a. a -> Maybe a
Just 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 -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Can't reply to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Object
x
   in EventID -> RoomMessage -> Event
EventRoomReply EventID
eventID (MessageText -> RoomMessage
RoomMessageText MessageText
newMessage)

sync :: ClientSession -> Maybe FilterID -> Maybe T.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"
  forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session ([(ByteString, Maybe ByteString)] -> Request -> Request
HTTP.setQueryString [(ByteString, Maybe ByteString)]
qs Request
request)
  where
    toQs :: a -> Maybe Text -> [(a, Maybe ByteString)]
toQs a
name = \case
      Maybe Text
Nothing -> []
      Just Text
v -> [(a
name, forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
v)]
    qs :: [(ByteString, Maybe ByteString)]
qs =
      forall {a}. a -> Maybe Text -> [(a, Maybe ByteString)]
toQs ByteString
"filter" (FilterID -> Text
unFilterID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilterID
filterM)
        forall a. Semigroup a => a -> a -> a
<> forall {a}. a -> Maybe Text -> [(a, Maybe ByteString)]
toQs ByteString
"since" Maybe Text
sinceM
        forall a. Semigroup a => a -> a -> a
<> forall {a}. a -> Maybe Text -> [(a, Maybe ByteString)]
toQs ByteString
"set_presence" (forall a. Show a => a -> Text
tshow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Presence
presenceM)
        forall a. Semigroup a => a -> a -> a
<> forall {a}. a -> Maybe Text -> [(a, Maybe ByteString)]
toQs ByteString
"timeout" (forall a. Show a => a -> Text
tshow 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 T.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 :: forall (m :: * -> *).
MonadIO m =>
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 = 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
MatrixM m a -> MatrixM m a
retry 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 (forall a. a -> Maybe a
Just Int
10_000)
      case Either MatrixError SyncResult
syncResultE of
        Left MatrixError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left MatrixError
err)
        Right SyncResult
sr -> SyncResult -> m ()
cb SyncResult
sr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> m (Either MatrixError b)
go (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 = 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 :: T.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 forall a. a -> [a] -> NonEmpty a
:| [RoomEvent]
xs) forall a. a -> [a] -> [a]
: [(RoomID, NonEmpty RoomEvent)]
acc
      Maybe [RoomEvent]
_ -> [(RoomID, NonEmpty RoomEvent)]
acc
    joinedRooms :: Map Text JoinedRoomSync
joinedRooms = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ SyncResult -> Maybe SyncResultRoom
srRooms SyncResult
sr 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
      [ Key
"content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Event
reContent,
        Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reType,
        Key
"event_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EventID -> Text
unEventID EventID
reEventId,
        Key
"sender" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Author
reSender
      ]

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

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

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

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

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

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

instance FromJSON JoinedRoomSync where
  parseJSON :: Value -> Parser JoinedRoomSync
parseJSON = 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
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitedRoomSync
InvitedRoomSync

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

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

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

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

getAccountData' :: (FromJSON a) => ClientSession -> UserID -> T.Text -> MatrixIO a
getAccountData' :: forall a.
FromJSON a =>
ClientSession -> UserID -> Text -> MatrixIO a
getAccountData' ClientSession
session UserID
userID Text
t =
  ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True (UserID -> Text -> Text
accountDataPath UserID
userID Text
t) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session

setAccountData' :: (ToJSON a) => ClientSession -> UserID -> T.Text -> a -> MatrixIO ()
setAccountData' :: forall a.
ToJSON a =>
ClientSession -> UserID -> Text -> a -> MatrixIO ()
setAccountData' ClientSession
session UserID
userID Text
t a
value = do
  Request
request <- ClientSession -> Bool -> Text -> IO Request
mkRequest ClientSession
session Bool
True forall a b. (a -> b) -> a -> b
$ UserID -> Text -> Text
accountDataPath UserID
userID Text
t
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => ClientSession -> Request -> MatrixIO a
doRequest ClientSession
session forall a b. (a -> b) -> a -> b
$ Request
request
             { method :: ByteString
HTTP.method = ByteString
"PUT"
             , requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode a
value
             } :: MatrixIO Aeson.Object
           )

accountDataPath :: UserID -> T.Text -> T.Text
accountDataPath :: UserID -> Text -> Text
accountDataPath (UserID Text
userID) Text
t =
  Text
"/_matrix/client/r0/user/" forall a. Semigroup a => a -> a -> a
<> Text
userID forall a. Semigroup a => a -> a -> a
<> Text
"/account_data/" forall a. Semigroup a => a -> a -> a
<> Text
t

class (FromJSON a, ToJSON a) => AccountData a where
  accountDataType :: proxy a -> T.Text

getAccountData :: forall a. (AccountData a) => ClientSession -> UserID -> MatrixIO a
getAccountData :: forall a. AccountData a => ClientSession -> UserID -> MatrixIO a
getAccountData ClientSession
session UserID
userID = forall a.
FromJSON a =>
ClientSession -> UserID -> Text -> MatrixIO a
getAccountData' ClientSession
session UserID
userID forall a b. (a -> b) -> a -> b
$
                                forall a (proxy :: * -> *). AccountData a => proxy a -> Text
accountDataType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

setAccountData :: forall a. (AccountData a) => ClientSession -> UserID -> a -> MatrixIO ()
setAccountData :: forall a.
AccountData a =>
ClientSession -> UserID -> a -> MatrixIO ()
setAccountData ClientSession
session UserID
userID = forall a.
ToJSON a =>
ClientSession -> UserID -> Text -> a -> MatrixIO ()
setAccountData' ClientSession
session UserID
userID forall a b. (a -> b) -> a -> b
$
                                forall a (proxy :: * -> *). AccountData a => proxy a -> Text
accountDataType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

-------------------------------------------------------------------------------
-- Utils

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

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

indistinct :: Either x x -> x
indistinct :: forall x. Either x x -> x
indistinct = forall a. a -> a
id forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` forall a. a -> a
id

tshow :: Show a => a -> T.Text
tshow :: forall a. Show a => a -> Text
tshow = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

escapeUriComponent :: T.Text -> T.Text
escapeUriComponent :: Text -> Text
escapeUriComponent = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
URI.escapeURIString Char -> Bool
URI.isUnreserved forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack