Merge pull request #37 from noordstar/4-transfer-api

Add lots of API features
develop
BramvdnHeuvel 2024-07-26 09:21:40 +02:00 committed by GitHub
commit a336c8b057
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
21 changed files with 1290 additions and 66 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

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

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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."
] ]

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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