diff --git a/src/Internal/Api/Credentials.elm b/src/Internal/Api/Credentials.elm index 7bd89c2..808533b 100644 --- a/src/Internal/Api/Credentials.elm +++ b/src/Internal/Api/Credentials.elm @@ -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 diff --git a/src/Internal/Api/SetAccountData/Api.elm b/src/Internal/Api/SetAccountData/Api.elm new file mode 100644 index 0000000..5225c65 --- /dev/null +++ b/src/Internal/Api/SetAccountData/Api.elm @@ -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 diff --git a/src/Internal/Api/SetAccountData/Main.elm b/src/Internal/Api/SetAccountData/Main.elm new file mode 100644 index 0000000..02b8e0b --- /dev/null +++ b/src/Internal/Api/SetAccountData/Main.elm @@ -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 diff --git a/src/Internal/Api/VaultUpdate.elm b/src/Internal/Api/VaultUpdate.elm index 740976b..3af9502 100644 --- a/src/Internal/Api/VaultUpdate.elm +++ b/src/Internal/Api/VaultUpdate.elm @@ -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 = [] diff --git a/src/Internal/Tools/Context.elm b/src/Internal/Tools/Context.elm index 7bfa931..d880f20 100644 --- a/src/Internal/Tools/Context.elm +++ b/src/Internal/Tools/Context.elm @@ -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 diff --git a/src/Internal/Tools/LoginValues.elm b/src/Internal/Tools/LoginValues.elm index 92db395..1dcd988 100644 --- a/src/Internal/Tools/LoginValues.elm +++ b/src/Internal/Tools/LoginValues.elm @@ -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 diff --git a/src/Internal/Values/Room.elm b/src/Internal/Values/Room.elm index 5db6821..fb8f760 100644 --- a/src/Internal/Values/Room.elm +++ b/src/Internal/Values/Room.elm @@ -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 : diff --git a/src/Internal/Values/Vault.elm b/src/Internal/Values/Vault.elm index aaed701..20985c4 100644 --- a/src/Internal/Values/Vault.elm +++ b/src/Internal/Values/Vault.elm @@ -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. diff --git a/src/Internal/Vault.elm b/src/Internal/Vault.elm index 4c648ea..4d09d02 100644 --- a/src/Internal/Vault.elm +++ b/src/Internal/Vault.elm @@ -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 }