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 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. {-| Add a new access token to the `Credentials` type.
-} -}
addToken : String -> Credentials -> Credentials 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.GetEvent.V1.SpecObjects as SO1
import Internal.Api.Request as R 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 Internal.Tools.Exceptions as X
import Task exposing (Task) import Task exposing (Task)
type alias GetEventInputV1 = type alias GetEventInputV1 =
{ eventId : String { roomId : String
, roomId : String
} }
@ -17,12 +16,13 @@ type alias GetEventOutputV1 =
SO1.ClientEvent SO1.ClientEvent
getEventInputV1 : GetEventInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetEventOutputV1 getEventInputV1 : GetEventInputV1 -> Context { a | accessToken : (), baseUrl : (), sentEvent : () } -> Task X.Error GetEventOutputV1
getEventInputV1 data = getEventInputV1 data context =
R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/event/{eventId}" context
>> R.withAttributes |> R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/event/{eventId}"
|> R.withAttributes
[ R.accessToken [ R.accessToken
, R.replaceInUrl "eventId" data.eventId , R.replaceInUrl "eventId" (Context.getSentEvent context)
, R.replaceInUrl "roomId" data.roomId , 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) 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 = getEvent context input =
VC.withBottomLayer VC.withBottomLayer
{ current = Api.getEventInputV1 { current = Api.getEventInputV1

View File

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

View File

@ -5,7 +5,7 @@ module Internal.Api.Task exposing (..)
import Hash import Hash
import Internal.Api.Chain as Chain 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.GetEvent.Main exposing (EventInput)
import Internal.Api.Invite.Main exposing (InviteInput) import Internal.Api.Invite.Main exposing (InviteInput)
import Internal.Api.JoinedMembers.Main exposing (JoinedMembersInput) import Internal.Api.JoinedMembers.Main exposing (JoinedMembersInput)
@ -19,10 +19,17 @@ type alias FutureTask =
C.FutureTask C.FutureTask
type alias EventInput =
{ eventId : String
, roomId : String
}
getEvent : EventInput -> Credentials -> FutureTask getEvent : EventInput -> Credentials -> FutureTask
getEvent data cred = getEvent { eventId, roomId } cred =
C.makeVBA cred C.makeVBA cred
|> Chain.andThen (C.getEvent data) |> Chain.andThen (C.withSentEvent eventId)
|> Chain.andThen (C.getEvent { roomId = roomId })
|> C.toTask |> C.toTask
@ -63,8 +70,9 @@ redact { eventId, extraTransactionNoise, reason, roomId } cred =
|> Hash.toString |> Hash.toString
) )
|> Chain.andThen (C.redact { eventId = eventId, reason = reason, roomId = roomId }) |> Chain.andThen (C.redact { eventId = eventId, reason = reason, roomId = roomId })
|> Chain.andThen (C.withSentEvent eventId)
|> Chain.andThen |> Chain.andThen
(Chain.maybe <| C.getEvent { eventId = eventId, roomId = roomId }) (Chain.maybe <| C.getEvent { roomId = roomId })
|> C.toTask |> C.toTask
@ -91,7 +99,8 @@ sendMessageEvent { content, eventType, extraTransactionNoise, roomId } cred =
|> Hash.toString |> Hash.toString
) )
|> Chain.andThen (C.sendMessageEvent { content = content, eventType = eventType, roomId = roomId }) |> 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 |> C.toTask
@ -99,7 +108,8 @@ sendStateEvent : SendStateKeyInput -> Credentials -> FutureTask
sendStateEvent data cred = sendStateEvent data cred =
C.makeVBA cred C.makeVBA cred
|> Chain.andThen (C.sendStateEvent data) |> 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 |> C.toTask
@ -108,3 +118,12 @@ sync data cred =
C.makeVBA cred C.makeVBA cred
|> Chain.andThen (C.sync data) |> Chain.andThen (C.sync data)
|> C.toTask |> 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. {-| Get an event from the API.
-} -}
getEvent : GetEvent.EventInput -> IdemChain VaultUpdate (VBA a) getEvent : GetEvent.EventInput -> IdemChain VaultUpdate (VBA { a | sentEvent : () })
getEvent input = getEvent input =
toChain toChain
(\output -> (\output ->
@ -212,12 +212,12 @@ redact input =
{-| Send a message event to a room. {-| 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 = sendMessageEvent input =
toChain toChain
(\output -> (\output ->
Chain.TaskChainPiece Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId { contextChange = Context.removeTransactionId >> Context.setSentEvent output.eventId
, messages = [ MessageEventSent input output ] , messages = [ MessageEventSent input output ]
} }
) )
@ -227,12 +227,12 @@ sendMessageEvent input =
{-| Send a state key event to a room. {-| 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 = sendStateEvent input =
toChain toChain
(\output -> (\output ->
Chain.TaskChainPiece Chain.TaskChainPiece
{ contextChange = identity { contextChange = Context.setSentEvent output.eventId
, messages = [ StateEventSent input output ] , messages = [ StateEventSent input output ]
} }
) )
@ -279,6 +279,18 @@ withBaseUrl baseUrl =
|> always |> 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. {-| Create a task that inserts a transaction id into the context.
-} -}
withTransactionId : (Int -> String) -> TaskChain VaultUpdate a { a | transactionId : () } withTransactionId : (Int -> String) -> TaskChain VaultUpdate a { a | transactionId : () }

View File

@ -4,7 +4,7 @@ module Internal.Room exposing (..)
-} -}
import Dict 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.Sync.V2.SpecObjects as Sync
import Internal.Api.Task as Api import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate) import Internal.Api.VaultUpdate exposing (VaultUpdate)

View File

@ -22,6 +22,7 @@ type Context a
= Context = Context
{ accessToken : String { accessToken : String
, baseUrl : String , baseUrl : String
, sentEvent : String
, transactionId : String , transactionId : String
, usernameAndPassword : Maybe UsernameAndPassword , usernameAndPassword : Maybe UsernameAndPassword
, versions : List String , versions : List String
@ -51,6 +52,7 @@ init =
Context Context
{ accessToken = L.accessToken { accessToken = L.accessToken
, baseUrl = L.baseUrl , baseUrl = L.baseUrl
, sentEvent = L.eventId
, transactionId = L.transactionId , transactionId = L.transactionId
, usernameAndPassword = Nothing , usernameAndPassword = Nothing
, versions = L.versions , versions = L.versions
@ -71,6 +73,13 @@ getBaseUrl (Context { baseUrl }) =
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. {-| Get the transaction id from the Context.
-} -}
getTransactionId : Context { a | transactionId : () } -> String getTransactionId : Context { a | transactionId : () } -> String
@ -106,6 +115,13 @@ setBaseUrl baseUrl (Context data) =
Context { data | baseUrl = baseUrl } 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. {-| Insert a transaction id into the context.
-} -}
setTransactionId : String -> Context a -> Context { a | transactionId : () } setTransactionId : String -> Context a -> Context { a | transactionId : () }
@ -134,6 +150,13 @@ removeBaseUrl (Context data) =
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 {-| Remove the transaction id from the Context
-} -}
removeTransactionId : Context { a | transactionId : () } -> Context a removeTransactionId : Context { a | transactionId : () } -> Context a

View File

@ -79,3 +79,20 @@ addUsernameAndPassword { username, password } t =
, password = password , password = password
, token = token , 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 Dict
import Internal.Api.Credentials as Credentials exposing (Credentials) import Internal.Api.Credentials as Credentials exposing (Credentials)
import Internal.Api.Sync.Main exposing (SyncInput)
import Internal.Api.Task as Api import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..)) import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Event as Event import Internal.Event as Event
import Internal.Room as Room import Internal.Room as Room
import Internal.Tools.Exceptions as X import Internal.Tools.Exceptions as X
import Internal.Values.Event as IEvent
import Internal.Values.Room as IRoom import Internal.Values.Room as IRoom
import Internal.Values.StateManager as StateManager import Internal.Values.StateManager as StateManager
import Internal.Values.Vault as Internal 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 -> Task X.Error VaultUpdate
sync (Vault { cred, context }) = sync (Vault { cred, context }) =
Api.sync let
{ filter = Nothing syncInput : SyncInput
, fullState = Nothing syncInput =
, setPresence = Nothing { filter = Nothing
, since = Internal.getSince cred , fullState = Nothing
, timeout = Just 30 , setPresence = Nothing
} , since = Internal.getSince cred
context , 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. {-| Get a list of all synchronised rooms.