Add kick + invite + ban user to Matrix.Room

src/Internal/Api/BanUser/Api.elm

@@ -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

src/Internal/Api/KickUser/Api.elm

@@ -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

src/Internal/Api/Main.elm

@@ -1,6 +1,6 @@
 module Internal.Api.Main exposing
     ( 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
 
-@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.Values.Context as Context
 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.User exposing (User)
 
 
 {-| Update message type that is being returned.
@@ -36,6 +35,30 @@ import Internal.Values.User exposing (User)
 type alias Msg =
     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.
 -}
 inviteUser :
@@ -59,6 +82,31 @@ inviteUser env data =
         (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.
 -}
 sendMessageEvent :

src/Internal/Api/Task.elm

@@ -1,6 +1,6 @@
 module Internal.Api.Task exposing
     ( 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
 
-@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.Chain as C
 import Internal.Api.InviteUser.Api
+import Internal.Api.KickUser.Api
 import Internal.Api.LoginWithUsernameAndPassword.Api
 import Internal.Api.Now.Api
 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.Envelope as E exposing (EnvelopeUpdate(..))
 import Internal.Values.Room exposing (RoomUpdate(..))
+import Internal.Values.User exposing (User)
 import Internal.Values.Vault exposing (VaultUpdate(..))
 import Task
-import Internal.Values.User exposing (User)
 
 
 {-| 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 =
     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
 -}
@@ -218,6 +227,22 @@ inviteUser input =
         |> 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
 versions are known.
 -}

src/Matrix/Room.elm

@@ -2,6 +2,7 @@ module Matrix.Room exposing
     ( Room, mostRecentEvents, roomId
     , getAccountData, setAccountData
     , 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
 
+## Moderating users
+
+@docs invite, kick, ban
+
 -}
 
 import Internal.Api.Main as Api
@@ -60,6 +65,24 @@ import Types exposing (Room(..))
 type alias 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.
 -}
@@ -84,9 +107,29 @@ invite data =
                 { reason = data.reason
                 , roomId = roomId data.room
                 , 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
 each other.
 -}