Extract access token value on r0.0.0 login endpoint

4-compiler-bug
Bram 2024-05-23 18:57:55 +02:00
parent 6e89371845
commit c84bb2a1ef
6 changed files with 172 additions and 28 deletions

View File

@ -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

View File

@ -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.SetRefreshToken out.refreshToken
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
]
, []
)
}
context
coderV1 : Json.Coder LoginWithUsernameAndPasswordOutputV1

View File

@ -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

View File

@ -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

View File

@ -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
{ fieldName = "accessToken"
, toField = .accessToken
(Json.field.required
{ fieldName = "accessTokens"
, 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

View File

@ -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 x =
{ content = x
, context = Context.init
init : { serverName : String, content : a } -> Envelope a
init data =
{ content = data.content
, 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 } }