Add kick + invite + ban user to Matrix.Room

4-transfer-api
Bram 2024-07-24 14:03:12 +02:00
parent a2582f36f9
commit 61a8e18714
5 changed files with 420 additions and 10 deletions

View File

@ -0,0 +1,116 @@
module Internal.Api.BanUser.Api exposing (Phantom, banUser)
{-|
# Ban user
This module helps to ban users from a room.
@docs Phantom, banUser
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as R
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
banUser : BanUserInput -> A.TaskChain (Phantom a) (Phantom a)
banUser =
A.startWithVersion "r0.0.0" banUserV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" banUserV2
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias BanUserInput =
{ reason : Maybe String
, roomId : String
, user : User
}
type alias BanUserInputV1 a =
{ a | reason : Maybe String, roomId : String, user : User }
type alias BanUserOutputV1 =
()
banUserV1 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
banUserV1 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV1
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "ban" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
banUserV2 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
banUserV2 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV1
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "ban" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
coderV1 : Json.Coder BanUserOutputV1
coderV1 =
Json.unit

View File

@ -0,0 +1,178 @@
module Internal.Api.KickUser.Api exposing (Phantom, kickUser)
{-|
# Kick user
This module helps to kick users from a room.
@docs Phantom, kickUser
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as R
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
kickUser : KickUserInput -> A.TaskChain (Phantom a) (Phantom a)
kickUser =
A.startWithVersion "r0.0.0" kickUserV1
|> A.sameForVersion "r0.0.1"
-- NOTE: Kicking a user was first added in r0.1.0
|> A.forVersion "r0.1.0" kickUserV2
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" kickUserV3
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias KickUserInput =
{ avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
type alias KickUserInputV1 a =
{ a
| avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
type alias KickUserInputV2 a =
{ a | reason : Maybe String, roomId : String, user : User }
type alias KickUserOutputV1 =
{ eventId : Maybe String }
type alias KickUserOutputV2 =
()
kickUserV1 : KickUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
kickUserV1 { avatarUrl, displayname, reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyString "membership" "kick"
, R.bodyOpString "avatar_url" avatarUrl
, R.bodyOpString "displayname" displayname
, R.bodyOpString "reason" reason
]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", "m.room.member", User.toString user ]
, toUpdate =
\out ->
( E.More []
, [ "The kick API endpoint does not exist before spec version r0.1.0 - falling back to sending state event directly."
|> log.debug
, out.eventId
|> Text.logs.sendEvent
|> log.debug
]
)
}
kickUserV2 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
kickUserV2 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV2
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "kick" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
kickUserV3 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
kickUserV3 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV2
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "kick" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
coderV1 : Json.Coder KickUserOutputV1
coderV1 =
Json.object1
{ name = "EventResponse"
, description =
[ "This object is returned after a state event has been sent."
]
, init = KickUserOutputV1
}
(Json.field.optional.value
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)
coderV2 : Json.Coder KickUserOutputV2
coderV2 =
Json.unit

View File

@ -1,6 +1,6 @@
module Internal.Api.Main exposing module Internal.Api.Main exposing
( Msg ( Msg
, inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync , banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
) )
{-| {-|
@ -18,7 +18,7 @@ This module is used as reference for getting
## Actions ## Actions
@docs inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync @docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
-} -}
@ -26,9 +26,8 @@ import Internal.Api.Task as ITask exposing (Backpack)
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Internal.Values.Context as Context import Internal.Values.Context as Context
import Internal.Values.Envelope as E import Internal.Values.Envelope as E
import Internal.Values.User as User import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V import Internal.Values.Vault as V
import Internal.Values.User exposing (User)
{-| Update message type that is being returned. {-| Update message type that is being returned.
@ -36,6 +35,30 @@ import Internal.Values.User exposing (User)
type alias Msg = type alias Msg =
Backpack Backpack
{-| Ban a user from a room.
-}
banUser :
E.Envelope a
->
{ reason : Maybe String
, roomId : String
, toMsg : Msg -> msg
, user : User
}
-> Cmd msg
banUser env data =
ITask.run
data.toMsg
(ITask.banUser
{ reason = data.reason
, roomId = data.roomId
, user = data.user
}
)
(Context.apiFormat env.context)
{-| Invite a user to a room. {-| Invite a user to a room.
-} -}
inviteUser : inviteUser :
@ -59,6 +82,31 @@ inviteUser env data =
(Context.apiFormat env.context) (Context.apiFormat env.context)
{-| Kick a user from a room.
-}
kickUser :
E.Envelope a
->
{ reason : Maybe String
, roomId : String
, toMsg : Msg -> msg
, user : User
}
-> Cmd msg
kickUser env data =
ITask.run
data.toMsg
(ITask.kickUser
{ avatarUrl = Nothing
, displayname = Nothing
, reason = data.reason
, roomId = data.roomId
, user = data.user
}
)
(Context.apiFormat env.context)
{-| Send a message event. {-| Send a message event.
-} -}
sendMessageEvent : sendMessageEvent :

View File

@ -1,6 +1,6 @@
module Internal.Api.Task exposing module Internal.Api.Task exposing
( Task, run, Backpack ( Task, run, Backpack
, inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync , banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
) )
{-| {-|
@ -23,13 +23,15 @@ up-to-date.
## Tasks ## Tasks
@docs inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync @docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
-} -}
import Internal.Api.BanUser.Api
import Internal.Api.BaseUrl.Api import Internal.Api.BaseUrl.Api
import Internal.Api.Chain as C import Internal.Api.Chain as C
import Internal.Api.InviteUser.Api import Internal.Api.InviteUser.Api
import Internal.Api.KickUser.Api
import Internal.Api.LoginWithUsernameAndPassword.Api import Internal.Api.LoginWithUsernameAndPassword.Api
import Internal.Api.Now.Api import Internal.Api.Now.Api
import Internal.Api.Request as Request import Internal.Api.Request as Request
@ -45,9 +47,9 @@ import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (APIContext) import Internal.Values.Context as Context exposing (APIContext)
import Internal.Values.Envelope as E exposing (EnvelopeUpdate(..)) import Internal.Values.Envelope as E exposing (EnvelopeUpdate(..))
import Internal.Values.Room exposing (RoomUpdate(..)) import Internal.Values.Room exposing (RoomUpdate(..))
import Internal.Values.User exposing (User)
import Internal.Values.Vault exposing (VaultUpdate(..)) import Internal.Values.Vault exposing (VaultUpdate(..))
import Task import Task
import Internal.Values.User exposing (User)
{-| A Backpack is the ultimate message type that gets sent back by the Elm {-| A Backpack is the ultimate message type that gets sent back by the Elm
@ -69,6 +71,13 @@ complete Task type.
type alias UFTask a b = type alias UFTask a b =
C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b
{-| Ban a user from a room.
-}
banUser : { reason : Maybe String, roomId : String, user : User } -> Task
banUser input =
makeVBA
|> C.andThen (Internal.Api.BanUser.Api.banUser input)
|> finishTask
{-| Get an access token to talk to the Matrix API {-| Get an access token to talk to the Matrix API
-} -}
@ -218,6 +227,22 @@ inviteUser input =
|> finishTask |> finishTask
{-| Kick a user from a room.
-}
kickUser :
{ avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
-> Task
kickUser input =
makeVBA
|> C.andThen (Internal.Api.KickUser.Api.kickUser input)
|> finishTask
{-| Establish a Task Chain context where the base URL and supported list of {-| Establish a Task Chain context where the base URL and supported list of
versions are known. versions are known.
-} -}

View File

@ -2,6 +2,7 @@ module Matrix.Room exposing
( Room, mostRecentEvents, roomId ( Room, mostRecentEvents, roomId
, getAccountData, setAccountData , getAccountData, setAccountData
, sendMessageEvent, sendStateEvent , sendMessageEvent, sendStateEvent
, invite, kick, ban
) )
{-| {-|
@ -46,6 +47,10 @@ you like. To help other users with decoding your JSON objects, you pass an
@docs inviteUser, sendMessageEvent, sendStateEvent @docs inviteUser, sendMessageEvent, sendStateEvent
## Moderating users
@docs invite, kick, ban
-} -}
import Internal.Api.Main as Api import Internal.Api.Main as Api
@ -60,6 +65,24 @@ import Types exposing (Room(..))
type alias Room = type alias Room =
Types.Room Types.Room
{-| Ban a user from a room.
-}
ban :
{ reason : Maybe String
, room : Room
, toMsg : Types.VaultUpdate -> msg
, user : Types.User
}
-> Cmd msg
ban data =
case ( data.room, data.user ) of
( Room room, Types.User user ) ->
Api.kickUser room
{ reason = data.reason
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
, user = Envelope.getContent user
}
{-| Get a piece of account data linked to a certain string key. {-| Get a piece of account data linked to a certain string key.
-} -}
@ -78,15 +101,35 @@ invite :
} }
-> Cmd msg -> Cmd msg
invite data = invite data =
case (data.room, data.user) of case ( data.room, data.user ) of
(Room room, Types.User user) -> ( Room room, Types.User user ) ->
Api.inviteUser room Api.inviteUser room
{ reason = data.reason { reason = data.reason
, roomId = roomId data.room , roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg , toMsg = Types.VaultUpdate >> data.toMsg
, user = user.content , user = Envelope.getContent user
} }
{-| Kick a user from a room.
-}
kick :
{ reason : Maybe String
, room : Room
, toMsg : Types.VaultUpdate -> msg
, user : Types.User
}
-> Cmd msg
kick data =
case ( data.room, data.user ) of
( Room room, Types.User user ) ->
Api.kickUser room
{ reason = data.reason
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
, user = Envelope.getContent user
}
{-| Get a room's room id. This is an opaque string that distinguishes rooms from {-| Get a room's room id. This is an opaque string that distinguishes rooms from
each other. each other.
-} -}