Bram
/
elm-matrix-sdk-alpha
mirror of https://github.com/noordstar/elm-matrix-sdk-alpha
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Add RoomInvite type

pull/1/head
Bram van den Heuvel 2023-03-15 15:31:29 +01:00
parent 45142509d3
commit 1d90d300da
7 changed files with 314 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/Internal/Api/Leave/Api.elm Normal file
View File

@ -0,0 +1,40 @@
module Internal.Api.Leave.Api exposing (..)
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Task exposing (Task)
type alias LeaveInputV1 =
{ roomId : String }
type alias LeaveInputV2 =
{ roomId : String, reason : Maybe String }
type alias LeaveOutputV1 =
()
leaveV1 : LeaveInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error LeaveOutputV1
leaveV1 { roomId } =
R.callApi "POST" "/_matrix/client/r0/rooms/{roomId}/leave"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "roomId" roomId
]
>> R.toTask (D.map (always ()) D.value)
leaveV2 : LeaveInputV2 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error LeaveOutputV1
leaveV2 { roomId, reason } =
R.callApi "POST" "/_matrix/client/r0/rooms/{roomId}/leave"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "roomId" roomId
, R.bodyOpString "reason" reason
]
>> R.toTask (D.map (always ()) D.value)

48
src/Internal/Api/Leave/Main.elm Normal file
View File

@ -0,0 +1,48 @@
module Internal.Api.Leave.Main exposing (..)
import Internal.Api.Leave.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBA)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
leave : Context (VBA a) -> LeaveInput -> Task X.Error LeaveOutput
leave context input =
VC.withBottomLayer
{ current = Api.leaveV1
, version = "r0.0.0"
}
|> VC.sameForVersion "r0.0.1"
|> VC.sameForVersion "r0.1.0"
|> VC.sameForVersion "r0.2.0"
|> VC.sameForVersion "r0.3.0"
|> VC.sameForVersion "r0.4.0"
|> VC.sameForVersion "r0.5.0"
|> VC.sameForVersion "r0.6.0"
|> VC.sameForVersion "r0.6.1"
|> VC.addMiddleLayer
{ downcast =
\data ->
{ roomId = data.roomId
}
, current = Api.leaveV2
, upcast = identity
, version = "v1.1"
}
|> VC.sameForVersion "v1.2"
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias LeaveInput =
Api.LeaveInputV2
type alias LeaveOutput =
Api.LeaveOutputV1

8
src/Internal/Api/Task.elm
View File

@ -10,6 +10,7 @@ import Internal.Api.GetEvent.Main exposing (EventInput)
import Internal.Api.Invite.Main exposing (InviteInput)
import Internal.Api.JoinRoomById.Main exposing (JoinRoomByIdInput)
import Internal.Api.JoinedMembers.Main exposing (JoinedMembersInput)
import Internal.Api.Leave.Main exposing (LeaveInput)
import Internal.Api.SendStateKey.Main exposing (SendStateKeyInput)
import Internal.Api.Sync.Main exposing (SyncInput)
import Internal.Api.VaultUpdate as C
@ -55,6 +56,13 @@ joinRoomById data cred =
|> C.toTask
leave : LeaveInput -> Credentials -> FutureTask
leave data cred =
C.makeVBA cred
|> Chain.andThen (C.leave data)
|> C.toTask
type alias RedactInput =
{ eventId : String
, extraTransactionNoise : String

15
src/Internal/Api/VaultUpdate.elm
View File

@ -6,6 +6,7 @@ import Internal.Api.GetEvent.Main as GetEvent
import Internal.Api.Invite.Main as Invite
import Internal.Api.JoinRoomById.Main as JoinRoomById
import Internal.Api.JoinedMembers.Main as JoinedMembers
import Internal.Api.Leave.Main as Leave
import Internal.Api.LoginWithUsernameAndPassword.Main as LoginWithUsernameAndPassword
import Internal.Api.Redact.Main as Redact
import Internal.Api.SendMessageEvent.Main as SendMessageEvent
@ -27,6 +28,7 @@ type VaultUpdate
| InviteSent Invite.InviteInput Invite.InviteOutput
| JoinedMembersToRoom JoinedMembers.JoinedMembersInput JoinedMembers.JoinedMembersOutput
| JoinedRoom JoinRoomById.JoinRoomByIdInput JoinRoomById.JoinRoomByIdOutput
| LeftRoom Leave.LeaveInput Leave.LeaveOutput
| LoggedInWithUsernameAndPassword LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordOutput
| MessageEventSent SendMessageEvent.SendMessageEventInput SendMessageEvent.SendMessageEventOutput
| RedactedEvent Redact.RedactInput Redact.RedactOutput
@ -165,6 +167,19 @@ joinRoomById input =
input
leave : Leave.LeaveInput -> IdemChain VaultUpdate (VBA a)
leave input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ LeftRoom input output ]
}
)
Leave.leave
input
loginWithUsernameAndPassword : LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput -> TaskChain VaultUpdate (VB a) (VBA a)
loginWithUsernameAndPassword input =
toChain

75
src/Internal/Invite.elm Normal file
View File

@ -0,0 +1,75 @@
module Internal.Invite exposing (..)
{-| An invite is an Elm type that informs the user they've been invited to a room.
-}
import Internal.Api.Credentials exposing (Credentials)
import Internal.Api.Sync.V2.SpecObjects exposing (StrippedStateEvent)
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Tools.Exceptions as X
import Internal.Values.RoomInvite as Internal
import Task exposing (Task)
type RoomInvite
= RoomInvite
{ invite : Internal.IRoomInvite
, context : Credentials
}
getRoomId : RoomInvite -> String
getRoomId =
withoutCredentials >> Internal.roomId
initFromStrippedStateEvent : { roomId : String, events : List StrippedStateEvent } -> Internal.IRoomInvite
initFromStrippedStateEvent =
Internal.init
withCredentials : Credentials -> Internal.IRoomInvite -> RoomInvite
withCredentials context invite =
RoomInvite { context = context, invite = invite }
withoutCredentials : RoomInvite -> Internal.IRoomInvite
withoutCredentials (RoomInvite { invite }) =
invite
getEvent : { contentType : String, stateKey : String } -> RoomInvite -> Maybe Internal.RoomInviteEvent
getEvent data =
withoutCredentials >> Internal.getEvent data
getAllEvents : RoomInvite -> List Internal.RoomInviteEvent
getAllEvents =
withoutCredentials >> Internal.getAllEvents
{-| Accept an invite and join the room.
-}
accept : { invite : RoomInvite, reason : Maybe String } -> Task X.Error VaultUpdate
accept { invite, reason } =
case invite of
RoomInvite data ->
Api.joinRoomById
{ roomId = Internal.roomId data.invite
, reason = reason
}
data.context
{-| Reject the invite and do not join the room.
-}
reject : { invite : RoomInvite, reason : Maybe String } -> Task X.Error VaultUpdate
reject { invite, reason } =
case invite of
RoomInvite data ->
Api.leave
{ roomId = Internal.roomId data.invite
, reason = reason
}
data.context

70
src/Internal/Values/RoomInvite.elm Normal file
View File

@ -0,0 +1,70 @@
module Internal.Values.RoomInvite exposing (..)
{-| This module contains the internal version of the `RoomInvite` type.
-}
import Dict exposing (Dict)
import Internal.Values.Room exposing (IRoom)
import Json.Encode as E
type IRoomInvite
= IRoomInvite
{ roomId : String
, events : Dict ( String, String ) RoomInviteEvent
}
type RoomInviteEvent
= RoomInviteEvent
{ content : E.Value
, sender : String
, stateKey : String
, contentType : String
}
init : { roomId : String, events : List { content : E.Value, sender : String, stateKey : String, contentType : String } } -> IRoomInvite
init data =
data.events
|> List.map
(\event ->
( ( event.contentType, event.stateKey ), RoomInviteEvent event )
)
|> Dict.fromList
|> (\e -> IRoomInvite { roomId = data.roomId, events = e })
getEvent : { contentType : String, stateKey : String } -> IRoomInvite -> Maybe RoomInviteEvent
getEvent data (IRoomInvite { events }) =
Dict.get ( data.contentType, data.stateKey ) events
getAllEvents : IRoomInvite -> List RoomInviteEvent
getAllEvents (IRoomInvite { events }) =
Dict.values events
roomId : IRoomInvite -> String
roomId (IRoomInvite data) =
data.roomId
content : RoomInviteEvent -> E.Value
content (RoomInviteEvent data) =
data.content
sender : RoomInviteEvent -> String
sender (RoomInviteEvent data) =
data.sender
stateKey : RoomInviteEvent -> String
stateKey (RoomInviteEvent data) =
data.stateKey
contentType : RoomInviteEvent -> String
contentType (RoomInviteEvent data) =
data.contentType

72
src/Internal/Vault.elm
View File

@ -13,9 +13,11 @@ import Internal.Api.Sync.Main exposing (SyncInput)
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Event as Event
import Internal.Invite as Invite
import Internal.Room as Room
import Internal.Tools.Exceptions as X
import Internal.Values.Room as IRoom
import Internal.Values.RoomInvite exposing (IRoomInvite)
import Internal.Values.StateManager as StateManager
import Internal.Values.Vault as Internal
import Task exposing (Task)
@ -64,6 +66,14 @@ fromLoginVault { username, password, baseUrl } =
|> Vault
{-| Get a user's invited rooms.
-}
getInvites : Vault -> List Invite.RoomInvite
getInvites (Vault { cred, context }) =
Internal.getInvites cred
|> List.map (Invite.withCredentials context)
{-| Get a room based on its id.
-}
getRoomById : String -> Vault -> Maybe Room.Room
@ -86,50 +96,67 @@ insertRoom =
Room.withoutCredentials >> insertInternalRoom
{-| Join a Matrix room by its id.
-}
joinRoomById : String -> Vault -> Task X.Error VaultUpdate
joinRoomById roomId (Vault { context }) =
Api.joinRoomById { roomId = roomId, reason = Nothing } context
{-| Update the Vault type with new values
-}
updateWith : VaultUpdate -> Vault -> Vault
updateWith vaultUpdate ((Vault ({ cred, context } as data)) as credentials) =
updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
case vaultUpdate of
MultipleUpdates updates ->
List.foldl updateWith credentials updates
List.foldl updateWith vault updates
GetEvent input output ->
case getRoomById input.roomId credentials of
case getRoomById input.roomId vault of
Just room ->
output
|> Event.initFromGetEvent
|> Room.addInternalEvent
|> (|>) room
|> insertRoom
|> (|>) credentials
|> (|>) vault
Nothing ->
credentials
vault
-- TODO
InviteSent _ _ ->
credentials
vault
-- TODO
JoinedMembersToRoom _ _ ->
credentials
vault
-- TODO
JoinedRoom _ _ ->
credentials
JoinedRoom input _ ->
cred
|> Internal.removeInvite input.roomId
|> (\x -> { cred = x, context = context })
|> Vault
-- TODO
LeftRoom input _ ->
cred
|> Internal.removeInvite input.roomId
|> (\x -> { cred = x, context = context })
|> Vault
-- TODO
MessageEventSent _ _ ->
credentials
vault
-- TODO
RedactedEvent _ _ ->
credentials
vault
-- TODO
StateEventSent _ _ ->
credentials
vault
SyncUpdate input output ->
let
@ -141,7 +168,7 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as credentials) =
|> Dict.toList
|> List.map
(\( roomId, jroom ) ->
case getRoomById roomId credentials of
case getRoomById roomId vault of
-- Update existing room
Just room ->
case jroom.timeline of
@ -176,11 +203,28 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as credentials) =
jroom
|> Room.initFromJoinedRoom { nextBatch = output.nextBatch, roomId = roomId }
)
invites : List IRoomInvite
invites =
output.rooms
|> Maybe.map .invite
|> Maybe.withDefault Dict.empty
|> Dict.toList
|> List.map (Tuple.mapSecond .inviteState)
|> List.map (Tuple.mapSecond (Maybe.map .events))
|> List.map (Tuple.mapSecond (Maybe.withDefault []))
|> List.map (\( roomId, events ) -> { roomId = roomId, events = events })
|> List.map Invite.initFromStrippedStateEvent
in
cred
-- Add new since token
|> Internal.addSince output.nextBatch
-- Add joined rooms
|> List.foldl Internal.insertRoom
|> (|>) jRooms
-- Add invites
|> List.foldl Internal.addInvite
|> (|>) invites
|> (\x -> { cred = x, context = context })
|> Vault
@ -195,7 +239,7 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as credentials) =
Vault { data | context = Credentials.addToken output.accessToken context }
{-| Synchronize credentials
{-| Synchronize vault
-}
sync : Vault -> Task X.Error VaultUpdate
sync (Vault { cred, context }) =