Extract access token value on r0.0.0 login endpoint

src/Internal/Api/BaseUrl/Api.elm

@@ -9,7 +9,6 @@ This module looks for the right homeserver address.
 
 -}
 
-import Internal.Api.Api as A
 import Internal.Api.Chain as C
 import Internal.Api.Request as R
 import Internal.Config.Leaks as L
@@ -20,7 +19,7 @@ import Internal.Values.Envelope as E
 import Internal.Values.Vault as V
 
 
-baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) (Phantom ph) (Phantom { ph | baseUrl : () })
+baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () }
 baseUrl data =
     R.toChain
         { logHttp =
@@ -65,10 +64,6 @@ type alias BaseUrlInput =
     { url : String }
 
 
-type alias Phantom a =
-    a
-
-
 type alias DiscoveryInformation =
     { homeserver : HomeserverInformation
     , identityServer : Maybe IdentityServerInformation

src/Internal/Api/LoginWithUsernameAndPassword/Api.elm

@@ -56,11 +56,11 @@ type alias LoginWithUsernameAndPasswordOutputV1 =
 
 
 type alias PhantomV1 a =
-    { a | baseUrl : () }
+    { a | baseUrl : (), now : () }
 
 
 loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 a -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
-loginWithUsernameAndPasswordV1 { username, password } =
+loginWithUsernameAndPasswordV1 { username, password } context =
     A.request
         { attributes =
             [ R.bodyString "password" password
@@ -77,12 +77,18 @@ loginWithUsernameAndPasswordV1 { username, password } =
         , toUpdate =
             \out ->
                 ( E.More
-                    [ E.SetAccessToken out.accessToken
+                    [ E.SetAccessToken
-                    -- , E.SetRefreshToken out.refreshToken
+                        { created = Context.getNow context
+                        , expiryMs = Nothing
+                        , lastUsed = Context.getNow context
+                        , refresh = out.refreshToken
+                        , value = out.accessToken
+                        }
                     ]
                 , []
                 )
         }
+        context
 
 
 coderV1 : Json.Coder LoginWithUsernameAndPasswordOutputV1

src/Internal/Api/Task.elm

@@ -90,7 +90,7 @@ getVersions c =
 {-| Establish a Task Chain context where the base URL and supported list of
 versions are known.
 -}
-makeVB : UFTask {} { a | baseUrl : (), versions : () }
+makeVB : UFTask a { a | baseUrl : (), versions : () }
 makeVB =
     C.andThen getVersions getBaseUrl
 

src/Internal/Tools/Timestamp.elm

@@ -1,5 +1,6 @@
 module Internal.Tools.Timestamp exposing
     ( Timestamp
+    , add, toMs
     , coder, encode, decoder
     )
 
@@ -12,6 +13,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways.
 @docs Timestamp
 
 
+## Calculate
+
+@docs add, toMs
+
+
 ## JSON coders
 
 @docs coder, encode, decoder
@@ -28,6 +34,15 @@ type alias Timestamp =
     Time.Posix
 
 
+{-| Add a given number of miliseconds to a given Timestamp.
+-}
+add : Int -> Timestamp -> Timestamp
+add m =
+    Time.posixToMillis
+        >> (+) m
+        >> Time.millisToPosix
+
+
 {-| Create a Json coder
 -}
 coder : Json.Coder Timestamp
@@ -55,3 +70,10 @@ encode =
 decoder : Json.Decoder Timestamp
 decoder =
     Json.decode coder
+
+
+{-| Turn a Timestamp into a number of miliseconds
+-}
+toMs : Timestamp -> Int
+toMs =
+    Time.posixToMillis

src/Internal/Values/Context.elm

@@ -1,8 +1,9 @@
 module Internal.Values.Context exposing
-    ( Context, init, coder, encode, decoder
+    ( Context, AccessToken, init, coder, encode, decoder
     , APIContext, apiFormat, fromApiFormat
     , setAccessToken, getAccessToken
     , setBaseUrl, getBaseUrl
+    , setNow, getNow
     , setTransaction, getTransaction
     , Versions, setVersions, getVersions
     )
@@ -14,7 +15,7 @@ the Matrix API.
 
 ## Context
 
-@docs Context, init, coder, encode, decoder
+@docs Context, AccessToken, init, coder, encode, decoder
 
 
 ## APIContext
@@ -38,6 +39,11 @@ information that can be inserted.
 @docs setBaseUrl, getBaseUrl
 
 
+### Timestamp
+
+@docs setNow, getNow
+
+
 ### Transaction id
 
 @docs setTransaction, getTransaction
@@ -51,17 +57,33 @@ information that can be inserted.
 
 import Internal.Config.Leaks as L
 import Internal.Config.Text as Text
+import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
 import Internal.Tools.Json as Json
+import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
 import Json.Encode as E
 import Set exposing (Set)
+import Time
+
+
+{-| The Access Token is a combination of access tokens, values and refresh
+tokens that contain and summarizes all properties of a known access token.
+-}
+type alias AccessToken =
+    { created : Timestamp
+    , expiryMs : Maybe Int
+    , lastUsed : Timestamp
+    , refresh : Maybe String
+    , value : String
+    }
 
 
 {-| The Context type stores all the information in the Vault. This data type is
 static and hence can be passed on easily.
 -}
 type alias Context =
-    { accessToken : Maybe String
+    { accessTokens : Hashdict AccessToken
     , baseUrl : Maybe String
+    , now : Maybe Timestamp
     , password : Maybe String
     , refreshToken : Maybe String
     , serverName : String
@@ -80,6 +102,7 @@ type APIContext ph
         { accessToken : String
         , baseUrl : String
         , context : Context
+        , now : Timestamp
         , transaction : String
         , versions : Versions
         }
@@ -94,9 +117,11 @@ type alias Versions =
 apiFormat : Context -> APIContext {}
 apiFormat context =
     APIContext
-        { accessToken = context.accessToken |> Maybe.withDefault L.accessToken
+        { accessToken =
+            mostPopularToken context |> Maybe.withDefault L.accessToken
         , baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
         , context = context
+        , now = context.now |> Maybe.withDefault (Time.millisToPosix 0)
         , transaction = context.transaction |> Maybe.withDefault L.transaction
         , versions = context.versions |> Maybe.withDefault L.versions
         }
@@ -114,16 +139,16 @@ fromApiFormat (APIContext c) =
 -}
 coder : Json.Coder Context
 coder =
-    Json.object8
+    Json.object9
         { name = Text.docs.context.name
         , description = Text.docs.context.description
         , init = Context
         }
-        (Json.field.optional.value
+        (Json.field.required
-            { fieldName = "accessToken"
+            { fieldName = "accessTokens"
-            , toField = .accessToken
+            , toField = .accessTokens
             , description = Text.fields.context.accessToken
-            , coder = Json.string
+            , coder = Hashdict.coder .value coderAccessToken
             }
         )
         (Json.field.optional.value
@@ -133,6 +158,13 @@ coder =
             , coder = Json.string
             }
         )
+        (Json.field.optional.value
+            { fieldName = "now"
+            , toField = .now
+            , description = Debug.todo "Needs docs"
+            , coder = Timestamp.coder
+            }
+        )
         (Json.field.optional.value
             { fieldName = "password"
             , toField = .password
@@ -177,6 +209,52 @@ coder =
         )
 
 
+{-| JSON coder for an Access Token.
+-}
+coderAccessToken : Json.Coder AccessToken
+coderAccessToken =
+    Json.object5
+        { name = Debug.todo "Needs docs"
+        , description = Debug.todo "Needs docs"
+        , init = AccessToken
+        }
+        (Json.field.required
+            { fieldName = "created"
+            , toField = .created
+            , description = Debug.todo "Needs docs"
+            , coder = Timestamp.coder
+            }
+        )
+        (Json.field.optional.value
+            { fieldName = "expiryMs"
+            , toField = .expiryMs
+            , description = Debug.todo "Needs docs"
+            , coder = Json.int
+            }
+        )
+        (Json.field.required
+            { fieldName = "lastUsed"
+            , toField = .lastUsed
+            , description = Debug.todo "Needs docs"
+            , coder = Timestamp.coder
+            }
+        )
+        (Json.field.optional.value
+            { fieldName = "refresh"
+            , toField = .refresh
+            , description = Debug.todo "Needs docs"
+            , coder = Json.string
+            }
+        )
+        (Json.field.required
+            { fieldName = "value"
+            , toField = .value
+            , description = Debug.todo "Needs docs"
+            , coder = Json.string
+            }
+        )
+
+
 {-| Decode a Context type from a JSON value.
 -}
 decoder : Json.Decoder Context
@@ -195,8 +273,9 @@ encode =
 -}
 init : String -> Context
 init sn =
-    { accessToken = Nothing
+    { accessTokens = Hashdict.empty .value
     , baseUrl = Nothing
+    , now = Nothing
     , refreshToken = Nothing
     , password = Nothing
     , serverName = sn
@@ -206,6 +285,29 @@ init sn =
     }
 
 
+{-| Get the most popular access token available, if any.
+-}
+mostPopularToken : Context -> Maybe String
+mostPopularToken c =
+    c.accessTokens
+        |> Hashdict.values
+        |> List.sortBy
+            (\token ->
+                case token.expiryMs of
+                    Nothing ->
+                        ( 0, Timestamp.toMs token.created )
+
+                    Just e ->
+                        ( 1
+                        , token.created
+                            |> Timestamp.add e
+                            |> Timestamp.toMs
+                        )
+            )
+        |> List.head
+        |> Maybe.map .value
+
+
 {-| Get an inserted access token.
 -}
 getAccessToken : APIContext { a | accessToken : () } -> String
@@ -234,6 +336,20 @@ setBaseUrl value (APIContext c) =
     APIContext { c | baseUrl = value }
 
 
+{-| Get an inserted timestamp.
+-}
+getNow : APIContext { a | now : () } -> Timestamp
+getNow (APIContext c) =
+    c.now
+
+
+{-| Insert a Timestamp into the APIContext.
+-}
+setNow : Timestamp -> APIContext a -> APIContext { a | now : () }
+setNow t (APIContext c) =
+    APIContext { c | now = t }
+
+
 {-| Get an inserted transaction id.
 -}
 getTransaction : APIContext { a | transaction : () } -> String

src/Internal/Values/Envelope.elm

@@ -51,8 +51,9 @@ settings that can be adjusted manually.
 import Internal.Api.Request as Request
 import Internal.Config.Log exposing (Log)
 import Internal.Config.Text as Text
+import Internal.Tools.Hashdict as Hashdict
 import Internal.Tools.Json as Json
-import Internal.Values.Context as Context exposing (Context, Versions)
+import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
 import Internal.Values.Settings as Settings
 
 
@@ -74,7 +75,8 @@ type EnvelopeUpdate a
     = ContentUpdate a
     | HttpRequest (Request.Request ( Request.Error, List Log ) ( EnvelopeUpdate a, List Log ))
     | More (List (EnvelopeUpdate a))
-    | SetAccessToken String
+    | RemoveAccessToken String
+    | SetAccessToken AccessToken
     | SetBaseUrl String
     | SetRefreshToken String
     | SetVersions Versions
@@ -179,10 +181,10 @@ getContent =
 {-| Create a new enveloped data type. All settings are set to default values
 from the [Internal.Config.Default](Internal-Config-Default) module.
 -}
-init : a -> Envelope a
+init : { serverName : String, content : a } -> Envelope a
-init x =
+init data =
-    { content = x
+    { content = data.content
-    , context = Context.init
+    , context = Context.init data.serverName
     , settings = Settings.init
     }
 
@@ -296,8 +298,11 @@ update updateContent eu ({ context } as data) =
         More items ->
             List.foldl (update updateContent) data items
 
+        RemoveAccessToken token ->
+            { data | context = { context | accessTokens = Hashdict.removeKey token context.accessTokens } }
+
         SetAccessToken a ->
-            { data | context = { context | accessToken = Just a } }
+            { data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } }
 
         SetBaseUrl b ->
             { data | context = { context | baseUrl = Just b } }