Add complex functions for API endpoints

The Vault will now get an event after having sent it to see what it looks like.

If the user has an expired access token, the Vault will get a new token on the next sync.
pull/1/head
Bram van den Heuvel 2023-03-14 22:11:15 +01:00
parent 8c473425f2
commit 92e9527854
10 changed files with 139 additions and 33 deletions

View File

@ -24,6 +24,13 @@ accessToken (Credentials { access }) =
access
{-| Retrieves the access token type without the access token value in case the value is no longer valid.
-}
refreshedAccessToken : Credentials -> AccessToken
refreshedAccessToken (Credentials { access }) =
Login.removeToken access
{-| Add a new access token to the `Credentials` type.
-}
addToken : String -> Credentials -> Credentials

View File

@ -2,14 +2,13 @@ module Internal.Api.GetEvent.Api exposing (..)
import Internal.Api.GetEvent.V1.SpecObjects as SO1
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
type alias GetEventInputV1 =
{ eventId : String
, roomId : String
{ roomId : String
}
@ -17,12 +16,13 @@ type alias GetEventOutputV1 =
SO1.ClientEvent
getEventInputV1 : GetEventInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetEventOutputV1
getEventInputV1 data =
R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/event/{eventId}"
>> R.withAttributes
getEventInputV1 : GetEventInputV1 -> Context { a | accessToken : (), baseUrl : (), sentEvent : () } -> Task X.Error GetEventOutputV1
getEventInputV1 data context =
context
|> R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/event/{eventId}"
|> R.withAttributes
[ R.accessToken
, R.replaceInUrl "eventId" data.eventId
, R.replaceInUrl "eventId" (Context.getSentEvent context)
, R.replaceInUrl "roomId" data.roomId
]
>> R.toTask SO1.clientEventDecoder
|> R.toTask SO1.clientEventDecoder

View File

@ -7,7 +7,7 @@ import Internal.Tools.VersionControl as VC
import Task exposing (Task)
getEvent : Context (VBA a) -> EventInput -> Task X.Error EventOutput
getEvent : Context (VBA { a | sentEvent : () }) -> EventInput -> Task X.Error EventOutput
getEvent context input =
VC.withBottomLayer
{ current = Api.getEventInputV1

View File

@ -5,9 +5,7 @@ import Internal.Tools.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Json.Encode as E
import Process
import Task exposing (Task)
import Time
import Url
import Url.Builder as UrlBuilder

View File

@ -5,7 +5,7 @@ module Internal.Api.Task exposing (..)
import Hash
import Internal.Api.Chain as Chain
import Internal.Api.Credentials exposing (Credentials)
import Internal.Api.Credentials as Cred exposing (Credentials)
import Internal.Api.GetEvent.Main exposing (EventInput)
import Internal.Api.Invite.Main exposing (InviteInput)
import Internal.Api.JoinedMembers.Main exposing (JoinedMembersInput)
@ -19,10 +19,17 @@ type alias FutureTask =
C.FutureTask
type alias EventInput =
{ eventId : String
, roomId : String
}
getEvent : EventInput -> Credentials -> FutureTask
getEvent data cred =
getEvent { eventId, roomId } cred =
C.makeVBA cred
|> Chain.andThen (C.getEvent data)
|> Chain.andThen (C.withSentEvent eventId)
|> Chain.andThen (C.getEvent { roomId = roomId })
|> C.toTask
@ -63,8 +70,9 @@ redact { eventId, extraTransactionNoise, reason, roomId } cred =
|> Hash.toString
)
|> Chain.andThen (C.redact { eventId = eventId, reason = reason, roomId = roomId })
|> Chain.andThen (C.withSentEvent eventId)
|> Chain.andThen
(Chain.maybe <| C.getEvent { eventId = eventId, roomId = roomId })
(Chain.maybe <| C.getEvent { roomId = roomId })
|> C.toTask
@ -91,7 +99,8 @@ sendMessageEvent { content, eventType, extraTransactionNoise, roomId } cred =
|> Hash.toString
)
|> Chain.andThen (C.sendMessageEvent { content = content, eventType = eventType, roomId = roomId })
-- TODO: Get event from API to see what it looks like
|> Chain.andThen
(Chain.maybe <| C.getEvent { roomId = roomId })
|> C.toTask
@ -99,7 +108,8 @@ sendStateEvent : SendStateKeyInput -> Credentials -> FutureTask
sendStateEvent data cred =
C.makeVBA cred
|> Chain.andThen (C.sendStateEvent data)
-- TODO: Get event from API to see what it looks like
|> Chain.andThen
(Chain.maybe <| C.getEvent { roomId = data.roomId })
|> C.toTask
@ -108,3 +118,12 @@ sync data cred =
C.makeVBA cred
|> Chain.andThen (C.sync data)
|> C.toTask
loginMaybeSync : SyncInput -> Credentials -> FutureTask
loginMaybeSync data cred =
C.makeVB cred
|> Chain.andThen (C.accessToken (Cred.refreshedAccessToken cred))
|> Chain.andThen
(Chain.maybe <| C.sync data)
|> C.toTask

View File

@ -94,7 +94,7 @@ accessToken ctoken =
{-| Get an event from the API.
-}
getEvent : GetEvent.EventInput -> IdemChain VaultUpdate (VBA a)
getEvent : GetEvent.EventInput -> IdemChain VaultUpdate (VBA { a | sentEvent : () })
getEvent input =
toChain
(\output ->
@ -212,12 +212,12 @@ redact input =
{-| Send a message event to a room.
-}
sendMessageEvent : SendMessageEvent.SendMessageEventInput -> TaskChain VaultUpdate (VBAT a) (VBA a)
sendMessageEvent : SendMessageEvent.SendMessageEventInput -> TaskChain VaultUpdate (VBAT a) (VBA { a | sentEvent : () })
sendMessageEvent input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId
{ contextChange = Context.removeTransactionId >> Context.setSentEvent output.eventId
, messages = [ MessageEventSent input output ]
}
)
@ -227,12 +227,12 @@ sendMessageEvent input =
{-| Send a state key event to a room.
-}
sendStateEvent : SendStateKey.SendStateKeyInput -> IdemChain VaultUpdate (VBA a)
sendStateEvent : SendStateKey.SendStateKeyInput -> TaskChain VaultUpdate (VBA a) (VBA { a | sentEvent : () })
sendStateEvent input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
{ contextChange = Context.setSentEvent output.eventId
, messages = [ StateEventSent input output ]
}
)
@ -279,6 +279,18 @@ withBaseUrl baseUrl =
|> always
{-| Create a task that inserts an event id into the context, as if it were just sent.
-}
withSentEvent : String -> TaskChain VaultUpdate a { a | sentEvent : () }
withSentEvent sentEvent =
{ contextChange = Context.setSentEvent sentEvent
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
{-| Create a task that inserts a transaction id into the context.
-}
withTransactionId : (Int -> String) -> TaskChain VaultUpdate a { a | transactionId : () }

View File

@ -4,7 +4,7 @@ module Internal.Room exposing (..)
-}
import Dict
import Internal.Api.Credentials as Credentials exposing (Credentials)
import Internal.Api.Credentials exposing (Credentials)
import Internal.Api.Sync.V2.SpecObjects as Sync
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate)

View File

@ -22,6 +22,7 @@ type Context a
= Context
{ accessToken : String
, baseUrl : String
, sentEvent : String
, transactionId : String
, usernameAndPassword : Maybe UsernameAndPassword
, versions : List String
@ -51,6 +52,7 @@ init =
Context
{ accessToken = L.accessToken
, baseUrl = L.baseUrl
, sentEvent = L.eventId
, transactionId = L.transactionId
, usernameAndPassword = Nothing
, versions = L.versions
@ -71,6 +73,13 @@ getBaseUrl (Context { baseUrl }) =
baseUrl
{-| Get the event that has been sent to the API recently.
-}
getSentEvent : Context { a | sentEvent : () } -> String
getSentEvent (Context { sentEvent }) =
sentEvent
{-| Get the transaction id from the Context.
-}
getTransactionId : Context { a | transactionId : () } -> String
@ -106,6 +115,13 @@ setBaseUrl baseUrl (Context data) =
Context { data | baseUrl = baseUrl }
{-| Insert a sent event id into the context.
-}
setSentEvent : String -> Context a -> Context { a | sentEvent : () }
setSentEvent sentEvent (Context data) =
Context { data | sentEvent = sentEvent }
{-| Insert a transaction id into the context.
-}
setTransactionId : String -> Context a -> Context { a | transactionId : () }
@ -134,6 +150,13 @@ removeBaseUrl (Context data) =
Context data
{-| Remove the sent event's id from the Context
-}
removeSentEvent : Context { a | sentEvent : () } -> Context a
removeSentEvent (Context data) =
Context data
{-| Remove the transaction id from the Context
-}
removeTransactionId : Context { a | transactionId : () } -> Context a

View File

@ -79,3 +79,20 @@ addUsernameAndPassword { username, password } t =
, password = password
, token = token
}
removeToken : AccessToken -> AccessToken
removeToken t =
case t of
NoAccess ->
NoAccess
AccessToken _ ->
NoAccess
UsernameAndPassword { username, password } ->
UsernameAndPassword
{ username = username
, password = password
, token = Nothing
}

View File

@ -9,12 +9,12 @@ This file combines the internal functions with the API endpoints to create a ful
import Dict
import Internal.Api.Credentials as Credentials exposing (Credentials)
import Internal.Api.Sync.Main exposing (SyncInput)
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Event as Event
import Internal.Room as Room
import Internal.Tools.Exceptions as X
import Internal.Values.Event as IEvent
import Internal.Values.Room as IRoom
import Internal.Values.StateManager as StateManager
import Internal.Values.Vault as Internal
@ -195,14 +195,44 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as credentials) =
-}
sync : Vault -> Task X.Error VaultUpdate
sync (Vault { cred, context }) =
Api.sync
{ filter = Nothing
, fullState = Nothing
, setPresence = Nothing
, since = Internal.getSince cred
, timeout = Just 30
}
context
let
syncInput : SyncInput
syncInput =
{ filter = Nothing
, fullState = Nothing
, setPresence = Nothing
, since = Internal.getSince cred
, timeout = Just 30
}
in
Api.sync syncInput context
-- TODO: The sync function is described as "updating all the tokens".
-- TODO: For this reason, (only) the sync function should handle errors
-- TODO: that indicate that the user's access tokens have expired.
-- TODO: This implementation needs to be tested.
|> Task.onError
(\err ->
case err of
X.UnsupportedSpecVersion ->
Task.fail err
X.SDKException _ ->
Task.fail err
X.InternetException _ ->
Task.fail err
-- TODO: The login should be different when soft_logout.
-- TODO: Add support for refresh token.
X.ServerException (X.M_UNKNOWN_TOKEN { soft_logout }) ->
Api.loginMaybeSync syncInput context
X.ServerException (X.M_MISSING_TOKEN { soft_logout }) ->
Api.loginMaybeSync syncInput context
X.ServerException _ ->
Task.fail err
)
{-| Get a list of all synchronised rooms.