commit
a336c8b057
|
@ -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
|
|
@ -1,4 +1,4 @@
|
||||||
module Internal.Api.Invite.Api exposing (InviteInput, Phantom, invite)
|
module Internal.Api.InviteUser.Api exposing (InviteInput, Phantom, inviteUser)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
|
@ -14,7 +14,7 @@ room.
|
||||||
If the user was invited to the room, the homeserver will append a m.room.member
|
If the user was invited to the room, the homeserver will append a m.room.member
|
||||||
event to the room.
|
event to the room.
|
||||||
|
|
||||||
@docs InviteInput, Phantom, invite
|
@docs InviteInput, Phantom, inviteUser
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
@ -31,8 +31,8 @@ import Internal.Values.Vault as V
|
||||||
|
|
||||||
{-| Invite a user to a room.
|
{-| Invite a user to a room.
|
||||||
-}
|
-}
|
||||||
invite : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
|
inviteUser : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
|
||||||
invite =
|
inviteUser =
|
||||||
A.startWithVersion "r0.0.0" inviteV1
|
A.startWithVersion "r0.0.0" inviteV1
|
||||||
|> A.sameForVersion "r0.0.1"
|
|> A.sameForVersion "r0.0.1"
|
||||||
|> A.sameForVersion "r0.1.0"
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
@ -107,7 +107,8 @@ inviteV2 : InviteInputV2 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
|
||||||
inviteV2 { reason, roomId, user } =
|
inviteV2 { reason, roomId, user } =
|
||||||
A.request
|
A.request
|
||||||
{ attributes =
|
{ attributes =
|
||||||
[ R.bodyOpString "reason" reason
|
[ R.accessToken
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
, R.bodyString "user_id" (User.toString user)
|
, R.bodyString "user_id" (User.toString user)
|
||||||
, R.onStatusCode 400 "M_UNKNOWN"
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
, R.onStatusCode 403 "M_FORBIDDEN"
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
|
@ -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
|
|
@ -191,7 +191,7 @@ loginWithUsernameAndPasswordV1 { username, password } =
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, out.user
|
, out.user
|
||||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
|> Maybe.map E.SetUser
|
||||||
|> E.Optional
|
|> E.Optional
|
||||||
]
|
]
|
||||||
, Text.logs.loggedInAs username
|
, Text.logs.loggedInAs username
|
||||||
|
@ -233,7 +233,7 @@ loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, p
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, out.user
|
, out.user
|
||||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
|> Maybe.map E.SetUser
|
||||||
|> E.Optional
|
|> E.Optional
|
||||||
, out.deviceId
|
, out.deviceId
|
||||||
|> Maybe.map E.SetDeviceId
|
|> Maybe.map E.SetDeviceId
|
||||||
|
@ -285,7 +285,7 @@ loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, p
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, out.user
|
, out.user
|
||||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
|> Maybe.map E.SetUser
|
||||||
|> E.Optional
|
|> E.Optional
|
||||||
, out.deviceId
|
, out.deviceId
|
||||||
|> Maybe.map E.SetDeviceId
|
|> Maybe.map E.SetDeviceId
|
||||||
|
@ -337,7 +337,7 @@ loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, p
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, out.user
|
, out.user
|
||||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
|> Maybe.map E.SetUser
|
||||||
|> E.Optional
|
|> E.Optional
|
||||||
, out.wellKnown
|
, out.wellKnown
|
||||||
|> Maybe.map (.homeserver >> .baseUrl)
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
@ -393,7 +393,7 @@ loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, p
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, out.user
|
, out.user
|
||||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
|> Maybe.map E.SetUser
|
||||||
|> E.Optional
|
|> E.Optional
|
||||||
, out.wellKnown
|
, out.wellKnown
|
||||||
|> Maybe.map (.homeserver >> .baseUrl)
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
@ -450,7 +450,7 @@ loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisp
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, out.user
|
, out.user
|
||||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
|> Maybe.map E.SetUser
|
||||||
|> E.Optional
|
|> E.Optional
|
||||||
, out.wellKnown
|
, out.wellKnown
|
||||||
|> Maybe.map (.homeserver >> .baseUrl)
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
@ -506,7 +506,7 @@ loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisp
|
||||||
, value = out.accessToken
|
, value = out.accessToken
|
||||||
}
|
}
|
||||||
, E.RemovePasswordIfNecessary
|
, E.RemovePasswordIfNecessary
|
||||||
, E.ContentUpdate (V.SetUser out.user)
|
, E.SetUser out.user
|
||||||
, out.wellKnown
|
, out.wellKnown
|
||||||
|> Maybe.map (.homeserver >> .baseUrl)
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|> Maybe.map E.SetBaseUrl
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Internal.Api.Main exposing
|
module Internal.Api.Main exposing
|
||||||
( Msg
|
( Msg
|
||||||
, sendMessageEvent, sync
|
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -18,7 +18,7 @@ This module is used as reference for getting
|
||||||
|
|
||||||
## Actions
|
## Actions
|
||||||
|
|
||||||
@docs sendMessageEvent, sync
|
@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
@ -26,6 +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 exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
{-| Update message type that is being returned.
|
{-| Update message type that is being returned.
|
||||||
|
@ -34,6 +36,77 @@ 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.
|
||||||
|
-}
|
||||||
|
inviteUser :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
inviteUser env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.inviteUser
|
||||||
|
{ reason = data.reason
|
||||||
|
, roomId = data.roomId
|
||||||
|
, user = data.user
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(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 :
|
||||||
|
@ -59,6 +132,91 @@ sendMessageEvent env data =
|
||||||
(Context.apiFormat env.context)
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a room.
|
||||||
|
-}
|
||||||
|
sendStateEvent :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, stateKey : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
sendStateEvent env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.sendStateEvent
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, stateKey = data.stateKey
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set global account data.
|
||||||
|
-}
|
||||||
|
setAccountData :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
setAccountData env data =
|
||||||
|
case env.context.user of
|
||||||
|
Just u ->
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.setAccountData
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, userId = User.toString u
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Cmd.none
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set the account data for a Matrix room.
|
||||||
|
-}
|
||||||
|
setRoomAccountData :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
setRoomAccountData env data =
|
||||||
|
case env.context.user of
|
||||||
|
Just u ->
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.setRoomAccountData
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, userId = User.toString u
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Cmd.none
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: Return error about lacking user capabilities
|
||||||
|
|
||||||
|
|
||||||
{-| Sync with the Matrix API to stay up-to-date.
|
{-| Sync with the Matrix API to stay up-to-date.
|
||||||
-}
|
-}
|
||||||
sync :
|
sync :
|
||||||
|
|
|
@ -0,0 +1,176 @@
|
||||||
|
module Internal.Api.SendStateEvent.Api exposing (..)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Send state event
|
||||||
|
|
||||||
|
This module sends state events to Matrix rooms.
|
||||||
|
|
||||||
|
@docs Phantom, sendStateEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a Matrix room.
|
||||||
|
-}
|
||||||
|
sendStateEvent : SendStateEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
sendStateEvent =
|
||||||
|
A.startWithVersion "r0.0.0" sendStateEventV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.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.forVersion "r0.6.1" sendStateEventV2
|
||||||
|
|> A.forVersion "v1.1" sendStateEventV3
|
||||||
|
|> 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
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for sending a state event
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventInput =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, stateKey : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventInputV1 a =
|
||||||
|
{ a
|
||||||
|
| content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, stateKey : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventOutputV1 =
|
||||||
|
{ eventId : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventOutputV2 =
|
||||||
|
{ eventId : String }
|
||||||
|
|
||||||
|
|
||||||
|
sendStateEventV1 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendStateEventV1 { content, eventType, roomId, stateKey } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendStateEventV2 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendStateEventV2 { content, eventType, roomId, stateKey } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendStateEventV3 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendStateEventV3 { content, eventType, roomId, stateKey } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "state", eventType, stateKey ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SendStateEventOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This object is returned after a state event has been sent."
|
||||||
|
]
|
||||||
|
, init = SendStateEventOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder SendStateEventOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This object is returned after a state event has been sent."
|
||||||
|
]
|
||||||
|
, init = SendStateEventOutputV2
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,107 @@
|
||||||
|
module Internal.Api.SetAccountData.Api exposing (Phantom, setAccountData)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Set Account Data
|
||||||
|
|
||||||
|
This module allows the developer to set global account data.
|
||||||
|
|
||||||
|
@docs Phantom, setAccountData
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
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.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
setAccountData : SetAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
setAccountData =
|
||||||
|
A.startWithVersion "r0.0.0" setAccountDataV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.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" setAccountDataV2
|
||||||
|
|> 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
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for setting global account data.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetAccountDataInput =
|
||||||
|
{ content : Json.Value, eventType : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetAccountDataInputV1 a =
|
||||||
|
{ a | content : Json.Value, eventType : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetAccountDataOutput =
|
||||||
|
()
|
||||||
|
|
||||||
|
|
||||||
|
setAccountDataV1 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setAccountDataV1 { content, eventType, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "user", userId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( V.SetAccountData eventType content
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
setAccountDataV2 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setAccountDataV2 { content, eventType, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "user", userId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( V.SetAccountData eventType content
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SetAccountDataOutput
|
||||||
|
coderV1 =
|
||||||
|
Json.unit
|
|
@ -0,0 +1,111 @@
|
||||||
|
module Internal.Api.SetRoomAccountData.Api exposing (..)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Set Room Account Data
|
||||||
|
|
||||||
|
This module allows the developer to set account data to a Matrix room.
|
||||||
|
|
||||||
|
@docs Phantom, setRoomAccountData
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
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.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set account data to a Matrix room.
|
||||||
|
-}
|
||||||
|
setRoomAccountData : SetRoomAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
setRoomAccountData =
|
||||||
|
A.startWithVersion "r0.0.0" setRoomAccountDataV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.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" setRoomAccountDataV2
|
||||||
|
|> 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
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for setting account data on a room.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetRoomAccountDataInput =
|
||||||
|
{ content : Json.Value, eventType : String, roomId : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetRoomAccountDataInputV1 a =
|
||||||
|
{ a | content : Json.Value, eventType : String, roomId : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetRoomAccountDataOutputV1 =
|
||||||
|
()
|
||||||
|
|
||||||
|
|
||||||
|
setRoomAccountDataV1 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setRoomAccountDataV1 { content, eventType, roomId, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "user", userId, "rooms", roomId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( R.SetAccountData eventType content
|
||||||
|
|> V.MapRoom roomId
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
setRoomAccountDataV2 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setRoomAccountDataV2 { content, eventType, roomId, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "user", userId, "rooms", roomId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( R.SetAccountData eventType content
|
||||||
|
|> V.MapRoom roomId
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SetRoomAccountDataOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.unit
|
|
@ -106,7 +106,7 @@ syncV1 data =
|
||||||
, method = "GET"
|
, method = "GET"
|
||||||
, path = [ "_matrix", "client", "v3", "sync" ]
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
, toUpdate =
|
, toUpdate =
|
||||||
Debug.log "Handling output v1" >> V1.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received"
|
V1.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -128,7 +128,7 @@ syncV2 data =
|
||||||
, method = "GET"
|
, method = "GET"
|
||||||
, path = [ "_matrix", "client", "v3", "sync" ]
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
, toUpdate =
|
, toUpdate =
|
||||||
Debug.log "Handling output v2" >> V2.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received"
|
V2.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -150,7 +150,7 @@ syncV3 data =
|
||||||
, method = "GET"
|
, method = "GET"
|
||||||
, path = [ "_matrix", "client", "v3", "sync" ]
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
, toUpdate =
|
, toUpdate =
|
||||||
Debug.log "Handling output v3" >> V3.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received"
|
V3.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -172,5 +172,5 @@ syncV4 data =
|
||||||
, method = "GET"
|
, method = "GET"
|
||||||
, path = [ "_matrix", "client", "v3", "sync" ]
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
, toUpdate =
|
, toUpdate =
|
||||||
Debug.log "Handling output v4" >> V4.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received"
|
V4.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Internal.Api.Task exposing
|
module Internal.Api.Task exposing
|
||||||
( Task, run, Backpack
|
( Task, run, Backpack
|
||||||
, sendMessageEvent, sync
|
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -23,16 +23,22 @@ up-to-date.
|
||||||
|
|
||||||
## Tasks
|
## Tasks
|
||||||
|
|
||||||
@docs sendMessageEvent, 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.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
|
||||||
import Internal.Api.SendMessageEvent.Api
|
import Internal.Api.SendMessageEvent.Api
|
||||||
|
import Internal.Api.SendStateEvent.Api
|
||||||
|
import Internal.Api.SetAccountData.Api
|
||||||
|
import Internal.Api.SetRoomAccountData.Api
|
||||||
import Internal.Api.Sync.Api
|
import Internal.Api.Sync.Api
|
||||||
import Internal.Api.Versions.Api
|
import Internal.Api.Versions.Api
|
||||||
import Internal.Config.Log exposing (Log, log)
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
@ -41,6 +47,7 @@ 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
|
||||||
|
|
||||||
|
@ -65,6 +72,15 @@ 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
|
||||||
-}
|
-}
|
||||||
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
|
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
|
||||||
|
@ -204,6 +220,31 @@ finishTask uftask =
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invite a user to a room.
|
||||||
|
-}
|
||||||
|
inviteUser : { reason : Maybe String, roomId : String, user : User } -> Task
|
||||||
|
inviteUser input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.InviteUser.Api.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
|
{-| Establish a Task Chain context where the base URL and supported list of
|
||||||
versions are known.
|
versions are known.
|
||||||
-}
|
-}
|
||||||
|
@ -232,6 +273,33 @@ sendMessageEvent input =
|
||||||
|> finishTask
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a room.
|
||||||
|
-}
|
||||||
|
sendStateEvent : { content : Json.Value, eventType : String, roomId : String, stateKey : String } -> Task
|
||||||
|
sendStateEvent input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SendStateEvent.Api.sendStateEvent input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set global account data.
|
||||||
|
-}
|
||||||
|
setAccountData : { content : Json.Value, eventType : String, userId : String } -> Task
|
||||||
|
setAccountData input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SetAccountData.Api.setAccountData input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set account data for a Matrix room.
|
||||||
|
-}
|
||||||
|
setRoomAccountData : { content : Json.Value, eventType : String, roomId : String, userId : String } -> Task
|
||||||
|
setRoomAccountData input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SetRoomAccountData.Api.setRoomAccountData input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
{-| Sync with the Matrix API to stay up-to-date.
|
{-| Sync with the Matrix API to stay up-to-date.
|
||||||
-}
|
-}
|
||||||
sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task
|
sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task
|
||||||
|
|
|
@ -278,6 +278,7 @@ fields :
|
||||||
, serverName : Desc
|
, serverName : Desc
|
||||||
, suggestedAccessToken : Desc
|
, suggestedAccessToken : Desc
|
||||||
, transaction : Desc
|
, transaction : Desc
|
||||||
|
, user : Desc
|
||||||
, versions : Desc
|
, versions : Desc
|
||||||
}
|
}
|
||||||
, envelope :
|
, envelope :
|
||||||
|
@ -409,6 +410,9 @@ fields =
|
||||||
, transaction =
|
, transaction =
|
||||||
[ "A unique identifier for a transaction initiated by the user."
|
[ "A unique identifier for a transaction initiated by the user."
|
||||||
]
|
]
|
||||||
|
, user =
|
||||||
|
[ "The Matrix user the Vault is representing."
|
||||||
|
]
|
||||||
, versions =
|
, versions =
|
||||||
[ "The versions of the Matrix protocol that are supported by the server."
|
[ "The versions of the Matrix protocol that are supported by the server."
|
||||||
]
|
]
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Internal.Tools.DecodeExtra exposing
|
module Internal.Tools.DecodeExtra exposing
|
||||||
( opField, opFieldWithDefault
|
( opField, opFieldWithDefault
|
||||||
, map9, map10, map11, map12
|
, map9, map10, map11, map12, map13
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -18,7 +18,7 @@ This module contains helper functions that help decode JSON.
|
||||||
|
|
||||||
## Extended map functions
|
## Extended map functions
|
||||||
|
|
||||||
@docs map9, map10, map11, map12
|
@docs map9, map10, map11, map12, map13
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
@ -185,3 +185,36 @@ map12 func da db dc dd de df dg dh di dj dk dl =
|
||||||
(D.map2 Tuple.pair dg dh)
|
(D.map2 Tuple.pair dg dh)
|
||||||
(D.map2 Tuple.pair di dj)
|
(D.map2 Tuple.pair di dj)
|
||||||
(D.map2 Tuple.pair dk dl)
|
(D.map2 Tuple.pair dk dl)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Try 12 decoders and combine the result.
|
||||||
|
-}
|
||||||
|
map13 :
|
||||||
|
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> value)
|
||||||
|
-> D.Decoder a
|
||||||
|
-> D.Decoder b
|
||||||
|
-> D.Decoder c
|
||||||
|
-> D.Decoder d
|
||||||
|
-> D.Decoder e
|
||||||
|
-> D.Decoder f
|
||||||
|
-> D.Decoder g
|
||||||
|
-> D.Decoder h
|
||||||
|
-> D.Decoder i
|
||||||
|
-> D.Decoder j
|
||||||
|
-> D.Decoder k
|
||||||
|
-> D.Decoder l
|
||||||
|
-> D.Decoder m
|
||||||
|
-> D.Decoder value
|
||||||
|
map13 func da db dc dd de df dg dh di dj dk dl dm =
|
||||||
|
D.map8
|
||||||
|
(\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) ->
|
||||||
|
func a b c d e f g h i j k l m
|
||||||
|
)
|
||||||
|
da
|
||||||
|
db
|
||||||
|
dc
|
||||||
|
(D.map2 Tuple.pair dd de)
|
||||||
|
(D.map2 Tuple.pair df dg)
|
||||||
|
(D.map2 Tuple.pair dh di)
|
||||||
|
(D.map2 Tuple.pair dj dk)
|
||||||
|
(D.map2 Tuple.pair dl dm)
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
module Internal.Tools.Json exposing
|
module Internal.Tools.Json exposing
|
||||||
( Coder, string, bool, int, float, value
|
( Coder, string, bool, int, float, value, unit
|
||||||
, Encoder, encode, Decoder, decode, Value
|
, Encoder, encode, Decoder, decode, Value
|
||||||
, succeed, fail, andThen, lazy, map
|
, succeed, fail, andThen, lazy, map
|
||||||
, Docs(..), RequiredField(..), toDocs
|
, Docs(..), RequiredField(..), toDocs
|
||||||
, list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
|
, list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
|
||||||
, Field, field, parser
|
, Field, field, parser
|
||||||
, object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12
|
, object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -29,7 +29,7 @@ data types. Because this module uses dynamic builder types, this also means it
|
||||||
is relatively easy to write documentation for any data type that uses this
|
is relatively easy to write documentation for any data type that uses this
|
||||||
module to build its encoders and decoders.
|
module to build its encoders and decoders.
|
||||||
|
|
||||||
@docs Coder, string, bool, int, float, value
|
@docs Coder, string, bool, int, float, value, unit
|
||||||
|
|
||||||
|
|
||||||
## JSON Coding
|
## JSON Coding
|
||||||
|
@ -62,7 +62,7 @@ first.
|
||||||
|
|
||||||
Once all fields are constructed, the user can create JSON objects.
|
Once all fields are constructed, the user can create JSON objects.
|
||||||
|
|
||||||
@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12
|
@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
@ -165,6 +165,7 @@ type Docs
|
||||||
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
|
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
|
||||||
| DocsSet Docs
|
| DocsSet Docs
|
||||||
| DocsString
|
| DocsString
|
||||||
|
| DocsUnit
|
||||||
| DocsValue
|
| DocsValue
|
||||||
|
|
||||||
|
|
||||||
|
@ -1272,6 +1273,85 @@ object12 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define an object with 13 keys
|
||||||
|
-}
|
||||||
|
object13 :
|
||||||
|
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> object }
|
||||||
|
-> Field a object
|
||||||
|
-> Field b object
|
||||||
|
-> Field c object
|
||||||
|
-> Field d object
|
||||||
|
-> Field e object
|
||||||
|
-> Field f object
|
||||||
|
-> Field g object
|
||||||
|
-> Field h object
|
||||||
|
-> Field i object
|
||||||
|
-> Field j object
|
||||||
|
-> Field k object
|
||||||
|
-> Field l object
|
||||||
|
-> Field m object
|
||||||
|
-> Coder object
|
||||||
|
object13 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl fm =
|
||||||
|
Coder
|
||||||
|
{ encoder =
|
||||||
|
objectEncoder
|
||||||
|
[ toEncodeField fa
|
||||||
|
, toEncodeField fb
|
||||||
|
, toEncodeField fc
|
||||||
|
, toEncodeField fd
|
||||||
|
, toEncodeField fe
|
||||||
|
, toEncodeField ff
|
||||||
|
, toEncodeField fg
|
||||||
|
, toEncodeField fh
|
||||||
|
, toEncodeField fi
|
||||||
|
, toEncodeField fj
|
||||||
|
, toEncodeField fk
|
||||||
|
, toEncodeField fl
|
||||||
|
, toEncodeField fm
|
||||||
|
]
|
||||||
|
, decoder =
|
||||||
|
D.map13
|
||||||
|
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ( m, lm ) ->
|
||||||
|
( init a b c d e f g h i j k l m
|
||||||
|
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll, lm ]
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(toDecoderField fa)
|
||||||
|
(toDecoderField fb)
|
||||||
|
(toDecoderField fc)
|
||||||
|
(toDecoderField fd)
|
||||||
|
(toDecoderField fe)
|
||||||
|
(toDecoderField ff)
|
||||||
|
(toDecoderField fg)
|
||||||
|
(toDecoderField fh)
|
||||||
|
(toDecoderField fi)
|
||||||
|
(toDecoderField fj)
|
||||||
|
(toDecoderField fk)
|
||||||
|
(toDecoderField fl)
|
||||||
|
(toDecoderField fm)
|
||||||
|
, docs =
|
||||||
|
DocsObject
|
||||||
|
{ name = name
|
||||||
|
, description = description
|
||||||
|
, keys =
|
||||||
|
[ toDocsField fa
|
||||||
|
, toDocsField fb
|
||||||
|
, toDocsField fc
|
||||||
|
, toDocsField fd
|
||||||
|
, toDocsField fe
|
||||||
|
, toDocsField ff
|
||||||
|
, toDocsField fg
|
||||||
|
, toDocsField fh
|
||||||
|
, toDocsField fi
|
||||||
|
, toDocsField fj
|
||||||
|
, toDocsField fk
|
||||||
|
, toDocsField fl
|
||||||
|
, toDocsField fm
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Define a parser that converts a string into a custom Elm type.
|
{-| Define a parser that converts a string into a custom Elm type.
|
||||||
-}
|
-}
|
||||||
parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a
|
parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a
|
||||||
|
@ -1383,6 +1463,18 @@ toEncodeField (Field data) =
|
||||||
( data.fieldName, data.toField >> data.encoder )
|
( data.fieldName, data.toField >> data.encoder )
|
||||||
|
|
||||||
|
|
||||||
|
{-| Completely ignore whatever needs to be encoded, and simply return a unit
|
||||||
|
value.
|
||||||
|
-}
|
||||||
|
unit : Coder ()
|
||||||
|
unit =
|
||||||
|
Coder
|
||||||
|
{ encoder = \() -> E.object []
|
||||||
|
, decoder = D.succeed ( (), [] )
|
||||||
|
, docs = DocsUnit
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Do not do anything useful with a JSON value, just bring it to Elm as a
|
{-| Do not do anything useful with a JSON value, just bring it to Elm as a
|
||||||
JavaScript value.
|
JavaScript value.
|
||||||
-}
|
-}
|
||||||
|
|
|
@ -71,6 +71,7 @@ import Internal.Config.Text as Text
|
||||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
import Set exposing (Set)
|
import Set exposing (Set)
|
||||||
import Time
|
import Time
|
||||||
|
|
||||||
|
@ -101,6 +102,7 @@ type alias Context =
|
||||||
, serverName : String
|
, serverName : String
|
||||||
, suggestedAccessToken : Maybe String
|
, suggestedAccessToken : Maybe String
|
||||||
, transaction : Maybe String
|
, transaction : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
, username : Maybe String
|
, username : Maybe String
|
||||||
, versions : Maybe Versions
|
, versions : Maybe Versions
|
||||||
}
|
}
|
||||||
|
@ -152,7 +154,7 @@ fromApiFormat (APIContext c) =
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Context
|
coder : Json.Coder Context
|
||||||
coder =
|
coder =
|
||||||
Json.object12
|
Json.object13
|
||||||
{ name = Text.docs.context.name
|
{ name = Text.docs.context.name
|
||||||
, description = Text.docs.context.description
|
, description = Text.docs.context.description
|
||||||
, init = Context
|
, init = Context
|
||||||
|
@ -227,6 +229,13 @@ coder =
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user"
|
||||||
|
, toField = .user
|
||||||
|
, description = Text.fields.context.user
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
{ fieldName = "username"
|
{ fieldName = "username"
|
||||||
, toField = .username
|
, toField = .username
|
||||||
|
@ -305,8 +314,8 @@ encode =
|
||||||
|
|
||||||
{-| A basic, untouched version of the Context, containing no information.
|
{-| A basic, untouched version of the Context, containing no information.
|
||||||
-}
|
-}
|
||||||
init : String -> Context
|
init : String -> Maybe User -> Context
|
||||||
init sn =
|
init sn mu =
|
||||||
{ accessTokens = Hashdict.empty .value
|
{ accessTokens = Hashdict.empty .value
|
||||||
, baseUrl = Nothing
|
, baseUrl = Nothing
|
||||||
, deviceId = Nothing
|
, deviceId = Nothing
|
||||||
|
@ -317,6 +326,7 @@ init sn =
|
||||||
, serverName = sn
|
, serverName = sn
|
||||||
, suggestedAccessToken = Nothing
|
, suggestedAccessToken = Nothing
|
||||||
, transaction = Nothing
|
, transaction = Nothing
|
||||||
|
, user = mu
|
||||||
, username = Nothing
|
, username = Nothing
|
||||||
, versions = Nothing
|
, versions = Nothing
|
||||||
}
|
}
|
||||||
|
|
|
@ -56,6 +56,7 @@ import Internal.Tools.Json as Json
|
||||||
import Internal.Tools.Timestamp exposing (Timestamp)
|
import Internal.Tools.Timestamp exposing (Timestamp)
|
||||||
import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
|
import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
|
||||||
import Internal.Values.Settings as Settings
|
import Internal.Values.Settings as Settings
|
||||||
|
import Internal.Values.User exposing (User)
|
||||||
import Recursion
|
import Recursion
|
||||||
import Recursion.Fold
|
import Recursion.Fold
|
||||||
|
|
||||||
|
@ -87,6 +88,7 @@ type EnvelopeUpdate a
|
||||||
| SetNextBatch String
|
| SetNextBatch String
|
||||||
| SetNow Timestamp
|
| SetNow Timestamp
|
||||||
| SetRefreshToken String
|
| SetRefreshToken String
|
||||||
|
| SetUser User
|
||||||
| SetVersions Versions
|
| SetVersions Versions
|
||||||
|
|
||||||
|
|
||||||
|
@ -188,10 +190,10 @@ getContent =
|
||||||
{-| Create a new enveloped data type. All settings are set to default values
|
{-| Create a new enveloped data type. All settings are set to default values
|
||||||
from the [Internal.Config.Default](Internal-Config-Default) module.
|
from the [Internal.Config.Default](Internal-Config-Default) module.
|
||||||
-}
|
-}
|
||||||
init : { serverName : String, content : a } -> Envelope a
|
init : { content : a, serverName : String, user : Maybe User } -> Envelope a
|
||||||
init data =
|
init data =
|
||||||
{ content = data.content
|
{ content = data.content
|
||||||
, context = Context.init data.serverName
|
, context = Context.init data.serverName data.user
|
||||||
, settings = Settings.init
|
, settings = Settings.init
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -374,6 +376,12 @@ update updateContent eu startData =
|
||||||
{ data | context = { context | refreshToken = Just r } }
|
{ data | context = { context | refreshToken = Just r } }
|
||||||
)
|
)
|
||||||
|
|
||||||
|
SetUser u ->
|
||||||
|
Recursion.base
|
||||||
|
(\({ context } as data) ->
|
||||||
|
{ data | context = { context | user = Just u } }
|
||||||
|
)
|
||||||
|
|
||||||
SetVersions vs ->
|
SetVersions vs ->
|
||||||
Recursion.base
|
Recursion.base
|
||||||
(\({ context } as data) ->
|
(\({ context } as data) ->
|
||||||
|
|
|
@ -54,7 +54,6 @@ type alias Vault =
|
||||||
{ accountData : Dict String Json.Value
|
{ accountData : Dict String Json.Value
|
||||||
, nextBatch : Maybe String
|
, nextBatch : Maybe String
|
||||||
, rooms : Hashdict Room
|
, rooms : Hashdict Room
|
||||||
, user : Maybe User
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -68,14 +67,13 @@ type VaultUpdate
|
||||||
| Optional (Maybe VaultUpdate)
|
| Optional (Maybe VaultUpdate)
|
||||||
| SetAccountData String Json.Value
|
| SetAccountData String Json.Value
|
||||||
| SetNextBatch String
|
| SetNextBatch String
|
||||||
| SetUser User
|
|
||||||
|
|
||||||
|
|
||||||
{-| Convert a Vault to and from a JSON object.
|
{-| Convert a Vault to and from a JSON object.
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Vault
|
coder : Json.Coder Vault
|
||||||
coder =
|
coder =
|
||||||
Json.object4
|
Json.object3
|
||||||
{ name = Text.docs.vault.name
|
{ name = Text.docs.vault.name
|
||||||
, description = Text.docs.vault.description
|
, description = Text.docs.vault.description
|
||||||
, init = Vault
|
, init = Vault
|
||||||
|
@ -101,13 +99,6 @@ coder =
|
||||||
, coder = Hashdict.coder .roomId Room.coder
|
, coder = Hashdict.coder .roomId Room.coder
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.value
|
|
||||||
{ fieldName = "user"
|
|
||||||
, toField = .user
|
|
||||||
, description = Text.fields.vault.user
|
|
||||||
, coder = User.coder
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
{-| Get a given room by its room id.
|
{-| Get a given room by its room id.
|
||||||
|
@ -126,12 +117,11 @@ getAccountData key vault =
|
||||||
|
|
||||||
{-| Initiate a new Vault type.
|
{-| Initiate a new Vault type.
|
||||||
-}
|
-}
|
||||||
init : Maybe User -> Vault
|
init : Vault
|
||||||
init mUser =
|
init =
|
||||||
{ accountData = Dict.empty
|
{ accountData = Dict.empty
|
||||||
, nextBatch = Nothing
|
, nextBatch = Nothing
|
||||||
, rooms = Hashdict.empty .roomId
|
, rooms = Hashdict.empty .roomId
|
||||||
, user = mUser
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -196,12 +186,6 @@ update vaultUpdate startVault =
|
||||||
(\vault ->
|
(\vault ->
|
||||||
{ vault | nextBatch = Just nb }
|
{ vault | nextBatch = Just nb }
|
||||||
)
|
)
|
||||||
|
|
||||||
SetUser user ->
|
|
||||||
Recursion.base
|
|
||||||
(\vault ->
|
|
||||||
{ vault | user = Just user }
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
vaultUpdate
|
vaultUpdate
|
||||||
startVault
|
startVault
|
||||||
|
|
|
@ -2,6 +2,7 @@ module Matrix exposing
|
||||||
( Vault, fromUserId, fromUsername
|
( Vault, fromUserId, fromUsername
|
||||||
, VaultUpdate, update, sync, logs
|
, VaultUpdate, update, sync, logs
|
||||||
, rooms, fromRoomId
|
, rooms, fromRoomId
|
||||||
|
, getAccountData, setAccountData
|
||||||
, addAccessToken, sendMessageEvent
|
, addAccessToken, sendMessageEvent
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -33,6 +34,11 @@ support a monolithic public registry. (:
|
||||||
@docs rooms, fromRoomId
|
@docs rooms, fromRoomId
|
||||||
|
|
||||||
|
|
||||||
|
## Account data
|
||||||
|
|
||||||
|
@docs getAccountData, setAccountData
|
||||||
|
|
||||||
|
|
||||||
## Debugging
|
## Debugging
|
||||||
|
|
||||||
@docs addAccessToken, sendMessageEvent
|
@docs addAccessToken, sendMessageEvent
|
||||||
|
@ -80,6 +86,13 @@ fromRoomId roomId (Vault vault) =
|
||||||
|> Maybe.map Types.Room
|
|> Maybe.map Types.Room
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get global account data.
|
||||||
|
-}
|
||||||
|
getAccountData : String -> Vault -> Maybe E.Value
|
||||||
|
getAccountData key (Vault vault) =
|
||||||
|
Envelope.extract (Internal.getAccountData key) vault
|
||||||
|
|
||||||
|
|
||||||
{-| Use a fully-fledged Matrix ID to connect.
|
{-| Use a fully-fledged Matrix ID to connect.
|
||||||
|
|
||||||
case Matrix.fromUserId "@alice:example.org" of
|
case Matrix.fromUserId "@alice:example.org" of
|
||||||
|
@ -97,8 +110,9 @@ fromUserId uid =
|
||||||
|> Maybe.map
|
|> Maybe.map
|
||||||
(\u ->
|
(\u ->
|
||||||
Envelope.init
|
Envelope.init
|
||||||
{ serverName = "https://" ++ User.domain u
|
{ content = Internal.init
|
||||||
, content = Internal.init (Just u)
|
, serverName = "https://" ++ User.domain u
|
||||||
|
, user = Just u
|
||||||
}
|
}
|
||||||
|> Envelope.mapContext (\c -> { c | username = Just uid })
|
|> Envelope.mapContext (\c -> { c | username = Just uid })
|
||||||
)
|
)
|
||||||
|
@ -113,13 +127,14 @@ you can either insert `alice` or `@alice:example.org`.
|
||||||
-}
|
-}
|
||||||
fromUsername : { username : String, host : String, port_ : Maybe Int } -> Vault
|
fromUsername : { username : String, host : String, port_ : Maybe Int } -> Vault
|
||||||
fromUsername { username, host, port_ } =
|
fromUsername { username, host, port_ } =
|
||||||
{ serverName =
|
{ content = Internal.init
|
||||||
|
, serverName =
|
||||||
port_
|
port_
|
||||||
|> Maybe.map String.fromInt
|
|> Maybe.map String.fromInt
|
||||||
|> Maybe.map ((++) ":")
|
|> Maybe.map ((++) ":")
|
||||||
|> Maybe.withDefault ""
|
|> Maybe.withDefault ""
|
||||||
|> (++) host
|
|> (++) host
|
||||||
, content = Internal.init (User.fromString username)
|
, user = User.fromString username
|
||||||
}
|
}
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.mapContext (\c -> { c | username = Just username })
|
|> Envelope.mapContext (\c -> { c | username = Just username })
|
||||||
|
@ -197,6 +212,25 @@ sendMessageEvent data =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set global account data.
|
||||||
|
-}
|
||||||
|
setAccountData :
|
||||||
|
{ content : E.Value
|
||||||
|
, eventType : String
|
||||||
|
, room : Vault
|
||||||
|
, toMsg : Types.VaultUpdate -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
setAccountData data =
|
||||||
|
case data.room of
|
||||||
|
Vault vault ->
|
||||||
|
Api.setAccountData vault
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Synchronize the Vault with the Matrix API.
|
{-| Synchronize the Vault with the Matrix API.
|
||||||
|
|
||||||
Effectively, this task asks the Matrix API to provide the latest information,
|
Effectively, this task asks the Matrix API to provide the latest information,
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
module Matrix.Room exposing
|
module Matrix.Room exposing
|
||||||
( Room, mostRecentEvents, roomId
|
( Room, mostRecentEvents, roomId
|
||||||
, getAccountData
|
, getAccountData, setAccountData
|
||||||
|
, sendMessageEvent, sendStateEvent
|
||||||
|
, invite, kick, ban
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -33,10 +35,26 @@ data is linked to the user account: other logged in devices can see the account
|
||||||
data too, as the server synchronizes it, but the server shouldn´t show it to
|
data too, as the server synchronizes it, but the server shouldn´t show it to
|
||||||
other users.
|
other users.
|
||||||
|
|
||||||
@docs getAccountData
|
@docs getAccountData, setAccountData
|
||||||
|
|
||||||
|
|
||||||
|
## Sending events
|
||||||
|
|
||||||
|
Besides reading the latest events, one can also send new events to the Matrix
|
||||||
|
room. These events are JSON objects that can be shaped in any way or form that
|
||||||
|
you like. To help other users with decoding your JSON objects, you pass an
|
||||||
|
`eventType` string which helps them figure out the nature of your JSON object.
|
||||||
|
|
||||||
|
@docs inviteUser, sendMessageEvent, sendStateEvent
|
||||||
|
|
||||||
|
|
||||||
|
## Moderating users
|
||||||
|
|
||||||
|
@docs invite, kick, ban
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Main as Api
|
||||||
import Internal.Values.Envelope as Envelope
|
import Internal.Values.Envelope as Envelope
|
||||||
import Internal.Values.Room as Internal
|
import Internal.Values.Room as Internal
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
|
@ -49,6 +67,26 @@ 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.banUser 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.
|
||||||
-}
|
-}
|
||||||
getAccountData : String -> Room -> Maybe E.Value
|
getAccountData : String -> Room -> Maybe E.Value
|
||||||
|
@ -56,6 +94,46 @@ getAccountData key (Room room) =
|
||||||
Envelope.extract (Internal.getAccountData key) room
|
Envelope.extract (Internal.getAccountData key) room
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invite a user to a room.
|
||||||
|
-}
|
||||||
|
invite :
|
||||||
|
{ reason : Maybe String
|
||||||
|
, room : Room
|
||||||
|
, toMsg : Types.VaultUpdate -> msg
|
||||||
|
, user : Types.User
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
invite data =
|
||||||
|
case ( data.room, data.user ) of
|
||||||
|
( Room room, Types.User user ) ->
|
||||||
|
Api.inviteUser room
|
||||||
|
{ reason = data.reason
|
||||||
|
, roomId = roomId data.room
|
||||||
|
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||||
|
, 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.
|
||||||
-}
|
-}
|
||||||
|
@ -70,3 +148,67 @@ mostRecentEvents : Room -> List Types.Event
|
||||||
mostRecentEvents (Room room) =
|
mostRecentEvents (Room room) =
|
||||||
Envelope.mapList Internal.mostRecentEvents room
|
Envelope.mapList Internal.mostRecentEvents room
|
||||||
|> List.map Types.Event
|
|> List.map Types.Event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event to a given room.
|
||||||
|
-}
|
||||||
|
sendMessageEvent :
|
||||||
|
{ content : E.Value
|
||||||
|
, eventType : String
|
||||||
|
, room : Room
|
||||||
|
, toMsg : Types.VaultUpdate -> msg
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
sendMessageEvent data =
|
||||||
|
case data.room of
|
||||||
|
Room room ->
|
||||||
|
Api.sendMessageEvent room
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = roomId data.room
|
||||||
|
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||||
|
, transactionId = data.transactionId
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a given room.
|
||||||
|
-}
|
||||||
|
sendStateEvent :
|
||||||
|
{ content : E.Value
|
||||||
|
, eventType : String
|
||||||
|
, room : Room
|
||||||
|
, stateKey : String
|
||||||
|
, toMsg : Types.VaultUpdate -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
sendStateEvent data =
|
||||||
|
case data.room of
|
||||||
|
Room room ->
|
||||||
|
Api.sendStateEvent room
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = roomId data.room
|
||||||
|
, stateKey = data.stateKey
|
||||||
|
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set account data to a Matrix room.
|
||||||
|
-}
|
||||||
|
setAccountData :
|
||||||
|
{ content : E.Value
|
||||||
|
, eventType : String
|
||||||
|
, room : Room
|
||||||
|
, toMsg : Types.VaultUpdate -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
setAccountData data =
|
||||||
|
case data.room of
|
||||||
|
Room room ->
|
||||||
|
Api.setRoomAccountData room
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = roomId data.room
|
||||||
|
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||||
|
}
|
||||||
|
|
|
@ -8,6 +8,7 @@ import Internal.Values.Context as Context exposing (Context, Versions)
|
||||||
import Set
|
import Set
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Tools.Timestamp as TestTimestamp
|
import Test.Tools.Timestamp as TestTimestamp
|
||||||
|
import Test.Values.User as TestUser
|
||||||
|
|
||||||
|
|
||||||
fuzzer : Fuzzer Context
|
fuzzer : Fuzzer Context
|
||||||
|
@ -17,22 +18,25 @@ fuzzer =
|
||||||
maybeString =
|
maybeString =
|
||||||
Fuzz.maybe Fuzz.string
|
Fuzz.maybe Fuzz.string
|
||||||
in
|
in
|
||||||
Fuzz.map8 (\a b c d ( e, f ) ( g, h ) ( i, j ) ( k, l ) -> Context a b c d e f g h i j k l)
|
Fuzz.map8 (\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) -> Context a b c d e f g h i j k l m)
|
||||||
(Fuzz.constant <| Hashdict.empty .value)
|
(Fuzz.constant <| Hashdict.empty .value)
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
|
||||||
(Fuzz.pair
|
(Fuzz.pair
|
||||||
|
maybeString
|
||||||
(Fuzz.maybe TestTimestamp.fuzzer)
|
(Fuzz.maybe TestTimestamp.fuzzer)
|
||||||
maybeString
|
|
||||||
)
|
)
|
||||||
(Fuzz.pair
|
(Fuzz.pair
|
||||||
maybeString
|
maybeString
|
||||||
|
maybeString
|
||||||
|
)
|
||||||
|
(Fuzz.pair
|
||||||
Fuzz.string
|
Fuzz.string
|
||||||
|
maybeString
|
||||||
)
|
)
|
||||||
(Fuzz.pair
|
(Fuzz.pair
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
(Fuzz.maybe TestUser.fuzzer)
|
||||||
)
|
)
|
||||||
(Fuzz.pair
|
(Fuzz.pair
|
||||||
maybeString
|
maybeString
|
||||||
|
|
|
@ -25,7 +25,7 @@ suite =
|
||||||
[ fuzz Fuzz.string
|
[ fuzz Fuzz.string
|
||||||
"currentVersion"
|
"currentVersion"
|
||||||
(\s ->
|
(\s ->
|
||||||
{ content = s, serverName = "" }
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .currentVersion
|
|> Envelope.extractSettings .currentVersion
|
||||||
|> Expect.equal Default.currentVersion
|
|> Expect.equal Default.currentVersion
|
||||||
|
@ -33,7 +33,7 @@ suite =
|
||||||
, fuzz Fuzz.string
|
, fuzz Fuzz.string
|
||||||
"deviceName"
|
"deviceName"
|
||||||
(\s ->
|
(\s ->
|
||||||
{ content = s, serverName = "" }
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .deviceName
|
|> Envelope.extractSettings .deviceName
|
||||||
|> Expect.equal Default.deviceName
|
|> Expect.equal Default.deviceName
|
||||||
|
@ -41,7 +41,7 @@ suite =
|
||||||
, fuzz Fuzz.string
|
, fuzz Fuzz.string
|
||||||
"syncTime"
|
"syncTime"
|
||||||
(\s ->
|
(\s ->
|
||||||
{ content = s, serverName = "" }
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .syncTime
|
|> Envelope.extractSettings .syncTime
|
||||||
|> Expect.equal Default.syncTime
|
|> Expect.equal Default.syncTime
|
||||||
|
|
|
@ -7,12 +7,11 @@ import Internal.Values.Vault exposing (Vault)
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Tools.Hashdict as TestHashdict
|
import Test.Tools.Hashdict as TestHashdict
|
||||||
import Test.Values.Room as TestRoom
|
import Test.Values.Room as TestRoom
|
||||||
import Test.Values.User as TestUser
|
|
||||||
|
|
||||||
|
|
||||||
vault : Fuzzer Vault
|
vault : Fuzzer Vault
|
||||||
vault =
|
vault =
|
||||||
Fuzz.map4 Vault
|
Fuzz.map3 Vault
|
||||||
(Fuzz.string
|
(Fuzz.string
|
||||||
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|
||||||
|> Fuzz.list
|
|> Fuzz.list
|
||||||
|
@ -20,4 +19,3 @@ vault =
|
||||||
)
|
)
|
||||||
(Fuzz.maybe Fuzz.string)
|
(Fuzz.maybe Fuzz.string)
|
||||||
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
|
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
|
||||||
(Fuzz.maybe TestUser.fuzzer)
|
|
||||||
|
|
Loading…
Reference in New Issue