{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

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

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

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

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

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

import Control.Monad (mzero)
import Data.Aeson (FromJSON (..), Value (Object), encode, (.:))
import Data.Hashable (Hashable)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types.URI (urlEncode)
import Network.Matrix.Events
import Network.Matrix.Internal

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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