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.

src/Internal/Api/Credentials.elm

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

src/Internal/Api/GetEvent/Api.elm

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

src/Internal/Api/GetEvent/Main.elm

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

src/Internal/Api/Request.elm

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

src/Internal/Api/Task.elm

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

src/Internal/Api/VaultUpdate.elm

@@ -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 : () }

src/Internal/Room.elm

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

src/Internal/Tools/Context.elm

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

src/Internal/Tools/LoginValues.elm

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

src/Internal/Vault.elm

@@ -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
+    let
+        syncInput : SyncInput
+        syncInput =
             { filter = Nothing
             , fullState = Nothing
             , setPresence = Nothing
             , since = Internal.getSince cred
             , timeout = Just 30
             }
-        context
+    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.