Add internal account_data getter and setter

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

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

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

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
+                |> Chain.andThen getWhoAmI
-                --     (toChain
-                --         (\output ->
-                --             Chain.TaskChainPiece
-                --                 { contextChange = identity
-                --                 , messages = [ UpdateRawAccessToken t output ]
-                --                 }
-                --         )
-                --         WhoAmI.whoAmI
-                --         ()
-                --     )
 
         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 = []

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
+getUserId : Context { a | userId : () } -> String
-getLoginParts (Context { loginParts }) =
+getUserId (Context { userId }) =
-    loginParts
+    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

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

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 :

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.

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 }