From 305a312b723ae41b0a61c93aee35c5f020b95a8d Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Fri, 17 Feb 2023 15:08:57 +0100 Subject: [PATCH] Add CredUpdate type --- src/Internal/Api/All.elm | 14 ++- src/Internal/Api/CredUpdate.elm | 104 +++++++++++++++++++++ src/Internal/Api/GetEvent/Api.elm | 4 +- src/Internal/Api/GetEvent/Main.elm | 4 +- src/Internal/Api/Helpers.elm | 50 ++++++++++ src/Internal/Api/JoinedMembers/Api.elm | 6 +- src/Internal/Api/JoinedMembers/Main.elm | 4 +- src/Internal/Api/SendMessageEvent/Api.elm | 6 +- src/Internal/Api/SendMessageEvent/Main.elm | 5 +- src/Internal/Api/SendStateKey/Api.elm | 6 +- src/Internal/Api/SendStateKey/Main.elm | 5 +- src/Internal/Api/Sync/Api.elm | 8 +- src/Internal/Api/Sync/Main.elm | 5 +- src/Internal/Api/Versions/Main.elm | 4 +- src/Internal/Tools/Exceptions.elm | 8 +- 15 files changed, 202 insertions(+), 31 deletions(-) create mode 100644 src/Internal/Api/CredUpdate.elm create mode 100644 src/Internal/Api/Helpers.elm diff --git a/src/Internal/Api/All.elm b/src/Internal/Api/All.elm index 020f92c..3cef9f0 100644 --- a/src/Internal/Api/All.elm +++ b/src/Internal/Api/All.elm @@ -6,39 +6,43 @@ import Internal.Api.SendMessageEvent.Main as SendMessageEvent import Internal.Api.SendStateKey.Main as SendStateKey import Internal.Api.Sync.Main as Sync import Internal.Api.Versions.Main as Versions +import Internal.Tools.Exceptions as X +import Task exposing (Task) +type alias Future a = + Task X.Error a {-| Get a specific event from the Matrix API. -} -getEvent : List String -> Maybe (GetEvent.EventInput -> GetEvent.EventOutput) +getEvent : List String -> Maybe (GetEvent.EventInput -> Future GetEvent.EventOutput) getEvent = GetEvent.getEvent {-| Get a list of members who are part of a Matrix room. -} -joinedMembers : List String -> Maybe (JoinedMembers.JoinedMembersInput -> JoinedMembers.JoinedMembersOutput) +joinedMembers : List String -> Maybe (JoinedMembers.JoinedMembersInput -> Future JoinedMembers.JoinedMembersOutput) joinedMembers = JoinedMembers.joinedMembers {-| Send a message event into a Matrix room. -} -sendMessageEvent : List String -> Maybe (SendMessageEvent.SendMessageEventInput -> SendMessageEvent.SendMessageEventOutput) +sendMessageEvent : List String -> Maybe (SendMessageEvent.SendMessageEventInput -> Future SendMessageEvent.SendMessageEventOutput) sendMessageEvent = SendMessageEvent.sendMessageEvent {-| Send a state event into a Matrix room. -} -sendStateEvent : List String -> Maybe (SendStateKey.SendStateKeyInput -> SendStateKey.SendStateKeyOutput) +sendStateEvent : List String -> Maybe (SendStateKey.SendStateKeyInput -> Future SendStateKey.SendStateKeyOutput) sendStateEvent = SendStateKey.sendStateKey {-| Get the latest sync from the Matrix API. -} -syncCredentials : List String -> Maybe (Sync.SyncInput -> Sync.SyncOutput) +syncCredentials : List String -> Maybe (Sync.SyncInput -> Future Sync.SyncOutput) syncCredentials = Sync.sync diff --git a/src/Internal/Api/CredUpdate.elm b/src/Internal/Api/CredUpdate.elm new file mode 100644 index 0000000..cac742c --- /dev/null +++ b/src/Internal/Api/CredUpdate.elm @@ -0,0 +1,104 @@ +module Internal.Api.CredUpdate exposing (getEvent, joinedMembers, sendMessage, sendState, sync) +{-| Sometimes, the `Credentials` type needs to refresh its tokens, log in again, +change some state or adjust its values to be able to keep talking to the server. + +That's what the `CredUpdate` type is for. It is a list of changes that the +`Credentials` type needs to make. +-} + +import Internal.Api.GetEvent.Main as GetEvent +import Internal.Api.Helpers as H +import Internal.Api.JoinedMembers.Main as JoinedMembers +import Internal.Api.SendMessageEvent.Main as SendMessageEvent +import Internal.Api.SendStateKey.Main as SendStateKey +import Internal.Api.Sync.Main as Sync +import Internal.Api.Versions.Main as Versions +import Internal.Tools.Exceptions as X +import Task exposing (Task) + +type CredUpdate + = MultipleChanges (List CredUpdate) + | EventDetails GetEvent.EventOutput + | RoomMemberList JoinedMembers.JoinedMembersOutput + | MessageEventSent SendMessageEvent.SendMessageEventOutput + | StateEventSent SendStateKey.SendStateKeyOutput + | SyncReceived Sync.SyncOutput + | VersionReceived Versions.VersionsOutput + +type alias Updater = Task X.Error CredUpdate + +getEvent : Maybe (List String) -> GetEvent.EventInput -> Updater +getEvent versions = + maybeWithVersions + { maybeVersions = versions + , f = GetEvent.getEvent + , toUpdate = EventDetails + } + >> H.retryTask 2 + +joinedMembers : Maybe (List String) -> JoinedMembers.JoinedMembersInput -> Updater +joinedMembers versions = + maybeWithVersions + { maybeVersions = versions + , f = JoinedMembers.joinedMembers + , toUpdate = RoomMemberList + } + +sendMessage : Maybe (List String) -> SendMessageEvent.SendMessageEventInput -> Updater +sendMessage versions = + maybeWithVersions + { maybeVersions = versions + , f = SendMessageEvent.sendMessageEvent + , toUpdate = MessageEventSent + } + >> H.retryTask 5 + +sendState : Maybe (List String) -> SendStateKey.SendStateKeyInput -> Updater +sendState versions = + maybeWithVersions + { maybeVersions = versions + , f = SendStateKey.sendStateKey + , toUpdate = StateEventSent + } + >> H.retryTask 5 + +sync : Maybe (List String) -> Sync.SyncInput -> Updater +sync versions = + maybeWithVersions + { maybeVersions = versions + , f = Sync.sync + , toUpdate = SyncReceived + } + >> H.retryTask 1 + + +maybeWithVersions : + { maybeVersions : Maybe (List String) + , f : (List String -> Maybe ({ in | baseUrl : String } -> Task X.Error out)) + , toUpdate : (out -> CredUpdate) + } -> + { in | baseUrl : String } -> Updater +maybeWithVersions {maybeVersions, f, toUpdate} params = + case maybeVersions of + Just versions -> + case f versions of + Just task -> + task params + |> Task.map toUpdate + Nothing -> + Task.fail X.UnsupportedSpecVersion + + Nothing -> + Versions.getVersions params.baseUrl + |> Task.andThen + (\versions -> + maybeWithVersions (Just versions.supportedVersions) f toUpdate params + |> Task.map + (\update -> + MultipleChanges + [ update + , VersionReceived versions + ] + ) + ) + diff --git a/src/Internal/Api/GetEvent/Api.elm b/src/Internal/Api/GetEvent/Api.elm index 785b6be..9071c6a 100644 --- a/src/Internal/Api/GetEvent/Api.elm +++ b/src/Internal/Api/GetEvent/Api.elm @@ -15,10 +15,10 @@ type alias GetEventInputV1 = type alias GetEventOutputV1 = - Task X.Error SO1.ClientEvent + SO1.ClientEvent -getEventInputV1 : GetEventInputV1 -> GetEventOutputV1 +getEventInputV1 : GetEventInputV1 -> Task X.Error GetEventOutputV1 getEventInputV1 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken diff --git a/src/Internal/Api/GetEvent/Main.elm b/src/Internal/Api/GetEvent/Main.elm index cde1f36..3284b8b 100644 --- a/src/Internal/Api/GetEvent/Main.elm +++ b/src/Internal/Api/GetEvent/Main.elm @@ -1,10 +1,12 @@ module Internal.Api.GetEvent.Main exposing (..) import Internal.Api.GetEvent.Api as Api +import Internal.Tools.Exceptions as X import Internal.Tools.VersionControl as VC +import Task exposing (Task) -getEvent : List String -> Maybe (EventInput -> EventOutput) +getEvent : List String -> Maybe (EventInput -> Task X.Error EventOutput) getEvent versions = VC.withBottomLayer { current = Api.getEventInputV1 diff --git a/src/Internal/Api/Helpers.elm b/src/Internal/Api/Helpers.elm new file mode 100644 index 0000000..eb428ea --- /dev/null +++ b/src/Internal/Api/Helpers.elm @@ -0,0 +1,50 @@ +module Internal.Api.Helpers exposing (..) + +import Internal.Tools.Exceptions as X +import Process +import Task exposing (Task) +import Http + +{-| Sometimes, a URL endpoint might be ratelimited. In such a case, +the homeserver tells the SDK to wait for a while and then send its response again. +-} +ratelimited : Task X.Error a -> Task X.Error a +ratelimited task = + task + |> Task.onError + (\e -> + case e of + X.ServerException (X.M_LIMIT_EXCEEDED { retryAfterMs }) -> + case retryAfterMs of + Just interval -> + interval + |> (+) 1 + |> toFloat + |> Process.sleep + |> Task.andThen (\_ -> task) + |> ratelimited + + Nothing -> + Task.fail e + + X.InternetException (Http.BadStatus 429) -> + 1000 + |> Process.sleep + |> Task.andThen (\_ -> task) + |> ratelimited + + _ -> + Task.fail e + ) + +{-| Sometimes, you don't really care if something went wrong - you just want to try again. + +This task will only return an error if it went wrong on the n'th attempt. +-} +retryTask : Int -> Task x a -> Task x a +retryTask n task = + if n <= 0 then + task + else + Task.onError (\_ -> retryTask (n - 1) task ) task + diff --git a/src/Internal/Api/JoinedMembers/Api.elm b/src/Internal/Api/JoinedMembers/Api.elm index cb899b7..27d95d8 100644 --- a/src/Internal/Api/JoinedMembers/Api.elm +++ b/src/Internal/Api/JoinedMembers/Api.elm @@ -14,10 +14,10 @@ type alias JoinedMembersInputV1 = type alias JoinedMembersOutputV1 = - Task X.Error SO1.RoomMemberList + SO1.RoomMemberList -joinedMembersV1 : JoinedMembersInputV1 -> JoinedMembersOutputV1 +joinedMembersV1 : JoinedMembersInputV1 -> Task X.Error JoinedMembersOutputV1 joinedMembersV1 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken @@ -34,7 +34,7 @@ joinedMembersV1 data = } -joinedMembersV2 : JoinedMembersInputV1 -> JoinedMembersOutputV1 +joinedMembersV2 : JoinedMembersInputV1 -> Task X.Error JoinedMembersOutputV1 joinedMembersV2 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken diff --git a/src/Internal/Api/JoinedMembers/Main.elm b/src/Internal/Api/JoinedMembers/Main.elm index e21bc0c..2dc5aa0 100644 --- a/src/Internal/Api/JoinedMembers/Main.elm +++ b/src/Internal/Api/JoinedMembers/Main.elm @@ -1,10 +1,12 @@ module Internal.Api.JoinedMembers.Main exposing (..) import Internal.Api.JoinedMembers.Api as Api +import Internal.Tools.Exceptions as X import Internal.Tools.VersionControl as VC +import Task exposing (Task) -joinedMembers : List String -> Maybe (JoinedMembersInput -> JoinedMembersOutput) +joinedMembers : List String -> Maybe (JoinedMembersInput -> Task X.Error JoinedMembersOutput) joinedMembers versions = VC.withBottomLayer { current = Api.joinedMembersV1 diff --git a/src/Internal/Api/SendMessageEvent/Api.elm b/src/Internal/Api/SendMessageEvent/Api.elm index 7c72b90..b640dbf 100644 --- a/src/Internal/Api/SendMessageEvent/Api.elm +++ b/src/Internal/Api/SendMessageEvent/Api.elm @@ -18,10 +18,10 @@ type alias SendMessageEventInputV1 = type alias SendMessageEventOutputV1 = - Task X.Error SO1.EventResponse + SO1.EventResponse -sendMessageEventV1 : SendMessageEventInputV1 -> SendMessageEventOutputV1 +sendMessageEventV1 : SendMessageEventInputV1 -> Task X.Error SendMessageEventOutputV1 sendMessageEventV1 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken @@ -40,7 +40,7 @@ sendMessageEventV1 data = } -sendMessageEventV2 : SendMessageEventInputV1 -> SendMessageEventOutputV1 +sendMessageEventV2 : SendMessageEventInputV1 -> Task X.Error SendMessageEventOutputV1 sendMessageEventV2 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken diff --git a/src/Internal/Api/SendMessageEvent/Main.elm b/src/Internal/Api/SendMessageEvent/Main.elm index 7c45936..f34206e 100644 --- a/src/Internal/Api/SendMessageEvent/Main.elm +++ b/src/Internal/Api/SendMessageEvent/Main.elm @@ -1,10 +1,11 @@ module Internal.Api.SendMessageEvent.Main exposing (..) import Internal.Api.SendMessageEvent.Api as Api +import Internal.Tools.Exceptions as X import Internal.Tools.VersionControl as VC +import Task exposing (Task) - -sendMessageEvent : List String -> Maybe (SendMessageEventInput -> SendMessageEventOutput) +sendMessageEvent : List String -> Maybe (SendMessageEventInput -> Task X.Error SendMessageEventOutput) sendMessageEvent versions = VC.withBottomLayer { current = Api.sendMessageEventV1 diff --git a/src/Internal/Api/SendStateKey/Api.elm b/src/Internal/Api/SendStateKey/Api.elm index eba7938..13ebd25 100644 --- a/src/Internal/Api/SendStateKey/Api.elm +++ b/src/Internal/Api/SendStateKey/Api.elm @@ -18,10 +18,10 @@ type alias SendStateKeyInputV1 = type alias SendStateKeyOutputV1 = - Task X.Error SO1.EventResponse + SO1.EventResponse -sendStateKeyV1 : SendStateKeyInputV1 -> SendStateKeyOutputV1 +sendStateKeyV1 : SendStateKeyInputV1 -> Task X.Error SendStateKeyOutputV1 sendStateKeyV1 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken @@ -40,7 +40,7 @@ sendStateKeyV1 data = } -sendStateKeyV2 : SendStateKeyInputV1 -> SendStateKeyOutputV1 +sendStateKeyV2 : SendStateKeyInputV1 -> Task X.Error SendStateKeyOutputV1 sendStateKeyV2 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken diff --git a/src/Internal/Api/SendStateKey/Main.elm b/src/Internal/Api/SendStateKey/Main.elm index 7099dc7..e923fb0 100644 --- a/src/Internal/Api/SendStateKey/Main.elm +++ b/src/Internal/Api/SendStateKey/Main.elm @@ -1,10 +1,11 @@ module Internal.Api.SendStateKey.Main exposing (..) import Internal.Api.SendStateKey.Api as Api +import Internal.Tools.Exceptions as X import Internal.Tools.VersionControl as VC +import Task exposing (Task) - -sendStateKey : List String -> Maybe (SendStateKeyInput -> SendStateKeyOutput) +sendStateKey : List String -> Maybe (SendStateKeyInput -> Task X.Error SendStateKeyOutput) sendStateKey versions = VC.withBottomLayer { current = Api.sendStateKeyV1 diff --git a/src/Internal/Api/Sync/Api.elm b/src/Internal/Api/Sync/Api.elm index 7b0fe05..6591c5f 100644 --- a/src/Internal/Api/Sync/Api.elm +++ b/src/Internal/Api/Sync/Api.elm @@ -20,14 +20,14 @@ type alias SyncInputV1 = type alias SyncOutputV1 = - Task X.Error SO1.Sync + SO1.Sync type alias SyncOutputV2 = - Task X.Error SO2.Sync + SO2.Sync -syncV1 : SyncInputV1 -> SyncOutputV1 +syncV1 : SyncInputV1 -> Task X.Error SyncOutputV1 syncV1 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken @@ -51,7 +51,7 @@ syncV1 data = } -syncV2 : SyncInputV1 -> SyncOutputV2 +syncV2 : SyncInputV1 -> Task X.Error SyncOutputV2 syncV2 data = R.rawApiCall { headers = R.WithAccessToken data.accessToken diff --git a/src/Internal/Api/Sync/Main.elm b/src/Internal/Api/Sync/Main.elm index 4f5aa1a..56e8cdd 100644 --- a/src/Internal/Api/Sync/Main.elm +++ b/src/Internal/Api/Sync/Main.elm @@ -2,11 +2,12 @@ module Internal.Api.Sync.Main exposing (..) import Internal.Api.Sync.Api as Api import Internal.Api.Sync.V2.Upcast as U2 +import Internal.Tools.Exceptions as X import Internal.Tools.VersionControl as VC -import Task +import Task exposing (Task) -sync : List String -> Maybe (SyncInput -> SyncOutput) +sync : List String -> Maybe (SyncInput -> Task X.Error SyncOutput) sync versions = VC.withBottomLayer { current = Api.syncV1 diff --git a/src/Internal/Api/Versions/Main.elm b/src/Internal/Api/Versions/Main.elm index 979d711..d4ad59f 100644 --- a/src/Internal/Api/Versions/Main.elm +++ b/src/Internal/Api/Versions/Main.elm @@ -11,9 +11,9 @@ type alias VersionsInput = type alias VersionsOutput = - Task X.Error O.Versions + O.Versions -getVersions : VersionsInput -> VersionsOutput +getVersions : VersionsInput -> Task X.Error VersionsOutput getVersions baseUrl = Api.versionsV1 { baseUrl = baseUrl } diff --git a/src/Internal/Tools/Exceptions.elm b/src/Internal/Tools/Exceptions.elm index dd41862..c31185e 100644 --- a/src/Internal/Tools/Exceptions.elm +++ b/src/Internal/Tools/Exceptions.elm @@ -10,12 +10,18 @@ import Internal.Tools.DecodeExtra exposing (opField) import Json.Decode as D import Json.Encode as E +{-| Errors that may return in any circumstance: +- `InternetException` Errors that the `elm/http` library might raise. +- `SDKException` Errors that this SDK might raise if it doesn't like its own input +- `ServerException` Errors that the homeserver might bring +- `UnsupportedSpecVersion` This SDK does not support the needed spec versions for certain operations - usually because a homeserver is extremely old. +-} type Error = InternetException Http.Error | SDKException ClientError | ServerException ServerError - | UnsupportedVersion + | UnsupportedSpecVersion {-| Errors that this SDK might return if it doesn't like its own input, if it