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 internal account_data getter and setter

pull/1/head
Bram van den Heuvel 2023-03-31 16:23:14 +02:00
parent e2dd69c5d2
commit ff84d70d7f
9 changed files with 309 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Internal/Api/Credentials.elm
View File

@ -52,6 +52,13 @@ addVersions vs (Credentials data) =
Credentials { data | vs = Just vs }
{-| Add whoami to the `Credentials` type to identify the user.
-}
addWhoAmI : { a | userId : String, deviceId : Maybe String } -> Credentials -> Credentials
addWhoAmI whoami (Credentials ({ access } as data)) =
Credentials { data | access = Login.addWhoAmI whoami access }
{-| Retrieves the base url from a given `Credentials` value.
-}
baseUrl : Credentials -> String

56
src/Internal/Api/SetAccountData/Api.elm Normal file
View File

@ -0,0 +1,56 @@
module Internal.Api.SetAccountData.Api exposing (..)
import Internal.Api.Request as R
import Internal.Tools.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Task exposing (Task)
type alias SetAccountDataInputV1 =
{ eventType : String
, roomId : Maybe String
, content : D.Value
}
type alias SetAccountDataOutputV1 =
()
setAccountDataV1 : SetAccountDataInputV1 -> Context { a | accessToken : (), baseUrl : (), userId : () } -> Task X.Error SetAccountDataOutputV1
setAccountDataV1 { content, eventType, roomId } context =
(case roomId of
Just rId ->
R.callApi "PUT" "/_matrix/client/r0/user/{userId}/rooms/{roomId}/account_data/{type}"
>> R.withAttributes [ R.replaceInUrl "roomId" rId ]
Nothing ->
R.callApi "PUT" "/_matrix/client/r0/user/{userId}/account_data/{type}"
)
>> R.withAttributes
[ R.replaceInUrl "type" eventType
, R.replaceInUrl "userId" (Context.getUserId context)
, R.fullBody content
]
>> R.toTask (D.map (always ()) D.value)
|> (|>) context
setAccountDataV2 : SetAccountDataInputV1 -> Context { a | accessToken : (), baseUrl : (), userId : () } -> Task X.Error SetAccountDataOutputV1
setAccountDataV2 { content, eventType, roomId } context =
(case roomId of
Just rId ->
R.callApi "PUT" "/_matrix/client/v3/user/{userId}/rooms/{roomId}/account_data/{type}"
>> R.withAttributes [ R.replaceInUrl "roomId" rId ]
Nothing ->
R.callApi "PUT" "/_matrix/client/v3/user/{userId}/account_data/{type}"
)
>> R.withAttributes
[ R.replaceInUrl "type" eventType
, R.replaceInUrl "userId" (Context.getUserId context)
, R.fullBody content
]
>> R.toTask (D.map (always ()) D.value)
|> (|>) context

46
src/Internal/Api/SetAccountData/Main.elm Normal file
View File

@ -0,0 +1,46 @@
module Internal.Api.SetAccountData.Main exposing (..)
import Internal.Api.SetAccountData.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)
setAccountData : Context (VBA { a | userId : () }) -> SetAccountInput -> Task X.Error SetAccountOutput
setAccountData context input =
VC.withBottomLayer
{ current = Api.setAccountDataV1
, 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 = identity
, current = Api.setAccountDataV2
, upcast = identity
, version = "v1.1"
}
|> VC.sameForVersion "v1.2"
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.sameForVersion "v1.6"
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias SetAccountInput =
Api.SetAccountDataInputV1
type alias SetAccountOutput =
Api.SetAccountDataOutputV1

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

@ -13,6 +13,7 @@ import Internal.Api.LoginWithUsernameAndPassword.Main as LoginWithUsernameAndPas
import Internal.Api.Redact.Main as Redact
import Internal.Api.SendMessageEvent.Main as SendMessageEvent
import Internal.Api.SendStateKey.Main as SendStateKey
import Internal.Api.SetAccountData.Main as SetAccountData
import Internal.Api.Sync.Main as Sync
import Internal.Api.Versions.Main as Versions
import Internal.Api.Versions.V1.Versions as V
@ -27,6 +28,7 @@ import Time
type VaultUpdate
= MultipleUpdates (List VaultUpdate)
-- Updates as a result of API calls
| AccountDataSet SetAccountData.SetAccountInput SetAccountData.SetAccountOutput
| BanUser Ban.BanInput Ban.BanOutput
| GetEvent GetEvent.EventInput GetEvent.EventOutput
| GetMessages GetMessages.GetMessagesInput GetMessages.GetMessagesOutput
@ -42,7 +44,7 @@ type VaultUpdate
-- Updates as a result of getting data early
| UpdateAccessToken String
| UpdateVersions V.Versions
| UpdateRawAccessToken String WhoAmI.WhoAmIOutput
| UpdateWhoAmI WhoAmI.WhoAmIOutput
type alias FutureTask =
@ -75,7 +77,7 @@ toTask =
{-| Get a functional access token.
-}
accessToken : AccessToken -> TaskChain VaultUpdate (VB a) (VBA a)
accessToken : AccessToken -> TaskChain VaultUpdate (VB a) (VBA { a | userId : () })
accessToken ctoken =
case ctoken of
NoAccess ->
@ -91,27 +93,19 @@ accessToken ctoken =
|> Chain.TaskChainPiece
|> Task.succeed
|> always
-- |> Chain.andThen
-- (toChain
-- (\output ->
-- Chain.TaskChainPiece
-- { contextChange = identity
-- , messages = [ UpdateRawAccessToken t output ]
-- }
-- )
-- WhoAmI.whoAmI
-- ()
-- )
|> Chain.andThen getWhoAmI
DetailedAccessToken data ->
{ contextChange = Context.setAccessToken { accessToken = data.accessToken, loginParts = Nothing }
{ contextChange =
Context.setAccessToken { accessToken = data.accessToken, loginParts = Nothing }
>> Context.setUserId data.userId
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
UsernameAndPassword { username, password, token, deviceId, initialDeviceDisplayName } ->
UsernameAndPassword { username, password, token, deviceId, initialDeviceDisplayName, userId } ->
case token of
Just t ->
{ contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing }
@ -120,6 +114,7 @@ accessToken ctoken =
|> Chain.TaskChainPiece
|> Task.succeed
|> always
|> Chain.andThen (whoAmI userId)
Nothing ->
loginWithUsernameAndPassword
@ -128,6 +123,14 @@ accessToken ctoken =
, deviceId = deviceId
, initialDeviceDisplayName = initialDeviceDisplayName
}
|> Chain.andThen
(case userId of
Just user ->
getWhoAmI |> Chain.otherwise (withUserId user)
Nothing ->
getWhoAmI
)
{-| Ban a user from a room.
@ -190,6 +193,21 @@ getVersions =
()
{-| Get a whoami to gain someone's identity.
-}
getWhoAmI : TaskChain VaultUpdate (VBA a) (VBA { a | userId : () })
getWhoAmI =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setUserId output.userId
, messages = [ UpdateWhoAmI output ]
}
)
WhoAmI.whoAmI
()
{-| Invite a user to a room.
-}
invite : Invite.InviteInput -> IdemChain VaultUpdate (VBA a)
@ -273,7 +291,7 @@ makeVB cred =
{-| Make a VBA-context based chain.
-}
makeVBA : Credentials -> TaskChain VaultUpdate {} (VBA {})
makeVBA : Credentials -> TaskChain VaultUpdate {} (VBA { userId : () })
makeVBA cred =
cred
|> makeVB
@ -282,7 +300,7 @@ makeVBA cred =
{-| Make a VBAT-context based chain.
-}
makeVBAT : (Int -> String) -> Credentials -> TaskChain VaultUpdate {} (VBAT {})
makeVBAT : (Int -> String) -> Credentials -> TaskChain VaultUpdate {} (VBAT { userId : () })
makeVBAT toString cred =
cred
|> makeVBA
@ -337,6 +355,19 @@ sendStateEvent input =
|> Chain.tryNTimes 5
setAccountData : SetAccountData.SetAccountInput -> IdemChain VaultUpdate (VBA { a | userId : () })
setAccountData input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ AccountDataSet input output ]
}
)
SetAccountData.setAccountData
input
{-| Sync the latest updates.
-}
sync : Sync.SyncInput -> IdemChain VaultUpdate (VBA a)
@ -366,6 +397,18 @@ versions mVersions =
|> Chain.tryNTimes 5
{-| Create a task to get a user's identity, if it is unknown.
-}
whoAmI : Maybe String -> TaskChain VaultUpdate (VBA a) (VBA { a | userId : () })
whoAmI muserId =
case muserId of
Just userId ->
withUserId userId
Nothing ->
getWhoAmI
{-| Create a task that insert the base URL into the context.
-}
withBaseUrl : String -> TaskChain VaultUpdate a { a | baseUrl : () }
@ -409,9 +452,19 @@ withTransactionId toString =
|> always
withUserId : String -> TaskChain VaultUpdate a { a | userId : () }
withUserId userId =
{ contextChange = Context.setUserId userId
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
{-| Create a task that inserts versions into the context.
-}
withVersions : V.Versions -> TaskChain VaultUpdate { a | baseUrl : () } (VB a)
withVersions : V.Versions -> TaskChain VaultUpdate a { a | versions : () }
withVersions vs =
{ contextChange = Context.setVersions vs.versions
, messages = []

37
src/Internal/Tools/Context.elm
View File

@ -22,9 +22,10 @@ type Context a
= Context
{ accessToken : String
, baseUrl : String
, loginParts : Maybe LoginParts
, sentEvent : String
, transactionId : String
, loginParts : Maybe LoginParts
, userId : String
, versions : List String
}
@ -56,9 +57,10 @@ init =
Context
{ accessToken = L.accessToken
, baseUrl = L.baseUrl
, loginParts = Nothing
, sentEvent = L.eventId
, transactionId = L.transactionId
, loginParts = Nothing
, userId = L.sender
, versions = L.versions
}
@ -77,6 +79,13 @@ getBaseUrl (Context { baseUrl }) =
baseUrl
{-| Get the username and password of the user, if present.
-}
getLoginParts : Context { a | accessToken : () } -> Maybe LoginParts
getLoginParts (Context { loginParts }) =
loginParts
{-| Get the event that has been sent to the API recently.
-}
getSentEvent : Context { a | sentEvent : () } -> String
@ -91,11 +100,11 @@ getTransactionId (Context { transactionId }) =
transactionId
{-| Get the username and password of the user, if present.
{-| Get the user id from the Context.
-}
getLoginParts : Context { a | accessToken : () } -> Maybe LoginParts
getLoginParts (Context { loginParts }) =
loginParts
getUserId : Context { a | userId : () } -> String
getUserId (Context { userId }) =
userId
{-| Get the supported spec versions from the Context.
@ -133,7 +142,14 @@ setTransactionId transactionId (Context data) =
Context { data | transactionId = transactionId }
{-| Insert a transaction id into the context.
{-| Insert a user id into the context.
-}
setUserId : String -> Context a -> Context { a | userId : () }
setUserId userId (Context data) =
Context { data | userId = userId }
{-| Insert versions into the context.
-}
setVersions : List String -> Context a -> Context { a | versions : () }
setVersions versions (Context data) =
@ -168,6 +184,13 @@ removeTransactionId (Context data) =
Context data
{-| Remove the user id from the Context
-}
removeUserId : Context { a | userId : () } -> Context a
removeUserId (Context data) =
Context data
{-| Remove the versions from the Context
-}
removeVersions : Context { a | versions : () } -> Context a

30
src/Internal/Tools/LoginValues.elm
View File

@ -7,7 +7,7 @@ type AccessToken
| DetailedAccessToken
{ accessToken : String
, userId : String
, deviceId : String
, deviceId : Maybe String
}
| UsernameAndPassword
{ deviceId : Maybe String
@ -15,6 +15,7 @@ type AccessToken
, password : String
, token : Maybe String
, username : String
, userId : Maybe String
}
@ -36,6 +37,7 @@ fromUsernameAndPassword username password =
, token = Nothing
, deviceId = Nothing
, initialDeviceDisplayName = Nothing
, userId = Nothing
}
@ -85,15 +87,17 @@ addUsernameAndPassword { username, password } t =
, token = Just a
, deviceId = Nothing
, initialDeviceDisplayName = Nothing
, userId = Nothing
}
DetailedAccessToken { accessToken, deviceId } ->
DetailedAccessToken { accessToken, deviceId, userId } ->
UsernameAndPassword
{ username = username
, password = password
, token = Just accessToken
, deviceId = Just deviceId
, deviceId = deviceId
, initialDeviceDisplayName = Nothing
, userId = Just userId
}
UsernameAndPassword data ->
@ -101,6 +105,26 @@ addUsernameAndPassword { username, password } t =
{ data | username = username, password = password }
addWhoAmI : { a | deviceId : Maybe String, userId : String } -> AccessToken -> AccessToken
addWhoAmI { deviceId, userId } t =
case t of
NoAccess ->
NoAccess
RawAccessToken a ->
DetailedAccessToken
{ accessToken = a
, deviceId = deviceId
, userId = userId
}
DetailedAccessToken data ->
DetailedAccessToken { data | deviceId = deviceId, userId = userId }
UsernameAndPassword data ->
UsernameAndPassword { data | deviceId = deviceId, userId = Just userId }
removeToken : AccessToken -> AccessToken
removeToken t =
case t of

7
src/Internal/Values/Room.elm
View File

@ -66,6 +66,13 @@ getStateEvent data (IRoom room) =
|> StateManager.getStateEvent data
{-| Insert account data into the room.
-}
insertAccountData : Dict String E.Value -> IRoom -> IRoom
insertAccountData newdata (IRoom room) =
IRoom { room | accountData = Dict.union newdata room.accountData }
{-| Insert a chunk of events into a room.
-}
insertEvents :

32
src/Internal/Values/Vault.elm
View File

@ -4,19 +4,29 @@ module Internal.Values.Vault exposing (..)
It handles all communication with the homeserver.
-}
import Dict exposing (Dict)
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Values.Room as Room exposing (IRoom)
import Internal.Values.RoomInvite as Invite exposing (IRoomInvite)
import Json.Encode as E
type IVault
= IVault
{ invites : List IRoomInvite
{ accountData : Dict String E.Value
, invites : List IRoomInvite
, rooms : Hashdict IRoom
, since : Maybe String
}
{-| Get an account data value.
-}
accountData : String -> IVault -> Maybe E.Value
accountData key (IVault data) =
Dict.get key data.accountData
{-| Add a new `since` token to sync from.
-}
addSince : String -> IVault -> IVault
@ -64,12 +74,30 @@ getSince (IVault { since }) =
init : IVault
init =
IVault
{ invites = []
{ accountData = Dict.empty
, invites = []
, rooms = Hashdict.empty Room.roomId
, since = Nothing
}
insertAccountData : { content : E.Value, eventType : String, roomId : Maybe String } -> IVault -> IVault
insertAccountData { content, eventType, roomId } (IVault data) =
case roomId of
Just rId ->
getRoomById rId (IVault data)
|> Maybe.map
(Room.insertAccountData (Dict.singleton eventType content)
>> Hashdict.insert
>> (|>) data.rooms
>> (\rooms -> IVault { data | rooms = rooms })
)
|> Maybe.withDefault (IVault data)
Nothing ->
IVault { data | accountData = Dict.insert eventType content data.accountData }
{-| Add a new room to the Credentials type. If a room with this id already exists, it is overwritten.
This function can hence also be used as an update function for rooms.

41
src/Internal/Vault.elm
View File

@ -21,6 +21,7 @@ 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 Json.Encode as E
import Task exposing (Task)
@ -67,6 +68,13 @@ fromLoginVault { username, password, baseUrl } =
|> Vault
{-| Get personal account data linked to an account.
-}
accountData : String -> Vault -> Maybe E.Value
accountData key (Vault { cred }) =
Internal.accountData key cred
{-| Get a user's invited rooms.
-}
getInvites : Vault -> List Invite.RoomInvite
@ -113,7 +121,11 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
List.foldl updateWith vault updates
-- TODO
BanUser input output ->
AccountDataSet input () ->
vault
-- TODO
BanUser input () ->
vault
GetEvent input output ->
@ -223,6 +235,13 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
SyncUpdate input output ->
let
accData : List { content : E.Value, eventType : String, roomId : Maybe String }
accData =
output.accountData
|> Maybe.map .events
|> Maybe.withDefault []
|> List.map (\{ content, eventType } -> { content = content, eventType = eventType, roomId = Nothing })
jRooms : List IRoom.IRoom
jRooms =
output.rooms
@ -234,7 +253,7 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
case getRoomById roomId vault of
-- Update existing room
Just room ->
case jroom.timeline of
(case jroom.timeline of
Just timeline ->
room
|> Room.withoutCredentials
@ -260,6 +279,15 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
Nothing ->
Room.withoutCredentials room
)
|> (\r ->
jroom.accountData
|> Maybe.map .events
|> Maybe.withDefault []
|> List.map (\{ content, eventType } -> ( eventType, content ))
|> Dict.fromList
|> (\a -> IRoom.insertAccountData a r)
)
-- Add new room
Nothing ->
@ -280,6 +308,8 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
|> List.map Invite.initFromStrippedStateEvent
in
cred
-- Add global account data
|> (\c -> List.foldl Internal.insertAccountData c accData)
-- Add new since token
|> Internal.addSince output.nextBatch
-- Add joined rooms
@ -294,13 +324,12 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) =
UpdateAccessToken token ->
Vault { data | context = Credentials.addToken token context }
-- TODO
UpdateRawAccessToken token output ->
vault
UpdateVersions versions ->
Vault { data | context = Credentials.addVersions versions context }
UpdateWhoAmI whoami ->
Vault { data | context = Credentials.addWhoAmI whoami context }
-- TODO: Save ALL info
LoggedInWithUsernameAndPassword _ output ->
Vault { data | context = Credentials.addToken output.accessToken context }