Add spec version control for API endpoints

src/Internal/Api/Api.elm

@@ -1,4 +1,7 @@
-module Internal.Api.Api exposing (TaskChain, request)
+module Internal.Api.Api exposing
+    ( TaskChain, request
+    , VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
+    )
 
 {-|
 
@@ -12,14 +15,25 @@ implementation simple and understandable.
 
 @docs TaskChain, request
 
+
+## Spec versions
+
+To respect spec versions, there is often a variety of ways to communicate with
+the homeserver. For this reason, users can differentiate spec versions using
+these functions.
+
+@docs VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
+
 -}
 
 import Internal.Api.Chain as C
 import Internal.Api.Request as R
-import Internal.Config.Log exposing (log)
+import Internal.Config.Log exposing (Log, log)
 import Internal.Tools.Json as Json
-import Internal.Values.Context exposing (APIContext)
+import Internal.Values.Context as Context exposing (APIContext, Versions)
 import Internal.Values.Vault as V
+import Recursion
+import Set
 
 
 {-| A TaskChain helps create a chain of HTTP requests.
@@ -32,10 +46,11 @@ type alias TaskChain ph1 ph2 =
 -}
 request :
     { attributes : List (R.Attribute { ph1 | baseUrl : () })
-    , coder : Json.Coder V.VaultUpdate
+    , coder : Json.Coder returnValue
     , contextChange : V.VaultUpdate -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
     , method : String
     , path : List String
+    , toUpdate : returnValue -> ( V.VaultUpdate, List Log )
     }
     -> TaskChain ph1 ph2
 request data =
@@ -61,4 +76,120 @@ request data =
                 }
                 |> R.withAttributes data.attributes
         , toContextChange = data.contextChange
+        , toUpdate = data.toUpdate
         }
+
+
+{-| This type allows different definitions for different spec versions,
+allowing the Elm SDK to communicate differently to the server depending on
+how up-to-date the server is.
+-}
+type VersionControl a ph1 ph2
+    = VC
+        { name : VersionType
+        , chain : a -> TaskChain (WithV ph1) (WithV ph2)
+        , prev : Maybe (VersionControl a ph1 ph2)
+        }
+
+
+type VersionType
+    = SpecVersion String
+    | UnstableFeature String
+
+
+type alias WithV ph =
+    { ph | versions : () }
+
+
+{-| Start with a given spec version supporting a given API endpoint.
+-}
+startWithVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
+startWithVersion name chain =
+    VC
+        { name = SpecVersion name
+        , chain = chain
+        , prev = Nothing
+        }
+
+
+{-| Start with a given unstable feature supporting a given API endpoint.
+-}
+startWithUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
+startWithUnstableFeature name chain =
+    VC
+        { name = UnstableFeature name
+        , chain = chain
+        , prev = Nothing
+        }
+
+
+{-| Add a new unstable feature that supports a different version of the API endpoint.
+-}
+forUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
+forUnstableFeature name chain prev =
+    VC
+        { name = UnstableFeature name
+        , chain = chain
+        , prev = Just prev
+        }
+
+
+{-| Add a new spec version that supports a different version of the API endpoint.
+-}
+forVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
+forVersion name chain prev =
+    VC
+        { name = SpecVersion name
+        , chain = chain
+        , prev = Just prev
+        }
+
+
+{-| Add another spec version that has the API endpoint defined the same as the previous API endpoint.
+-}
+sameForVersion : String -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
+sameForVersion name (VC data) =
+    VC
+        { name = SpecVersion name
+        , chain = data.chain
+        , prev = Just (VC data)
+        }
+
+
+supportedVersion : Versions -> VersionType -> Bool
+supportedVersion { versions, unstableFeatures } name =
+    case name of
+        SpecVersion n ->
+            List.member n versions
+
+        UnstableFeature n ->
+            Set.member n unstableFeatures
+
+
+
+-- NOTE: Interesting detail! For some reason, I cannot add the `context`
+-- NOTE: variable to the top line of the defined input values!
+-- NOTE: Maybe this is a bug?
+
+
+{-| Once you are done, turn a VersionControl type into a Task Chain.
+-}
+versionChain : VersionControl a ph1 ph2 -> a -> TaskChain (WithV ph1) (WithV ph2)
+versionChain vc input =
+    \context ->
+        case Context.getVersions context of
+            versions ->
+                Recursion.runRecursion
+                    (\mvc ->
+                        case mvc of
+                            Nothing ->
+                                Recursion.base (C.fail R.NoSupportedVersion context)
+
+                            Just (VC data) ->
+                                if supportedVersion versions data.name then
+                                    Recursion.base (data.chain input context)
+
+                                else
+                                    Recursion.recurse data.prev
+                    )
+                    (Just vc)

src/Internal/Api/Chain.elm

@@ -1,6 +1,7 @@
 module Internal.Api.Chain exposing
     ( TaskChain, CompleteChain
     , IdemChain, toTask
+    , fail, succeed
     )
 
 {-|
@@ -23,6 +24,11 @@ avoid leaking values passing through the API in unexpected ways.
 
 @docs IdemChain, toTask
 
+
+## Operations
+
+@docs fail, succeed
+
 -}
 
 import Internal.Config.Log exposing (Log)

src/Internal/Api/Request.elm

@@ -1,7 +1,7 @@
 module Internal.Api.Request exposing
     ( ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
     , Request, Error(..)
-    , accessToken, withTransactionId, timeout
+    , accessToken, withTransactionId, timeout, onStatusCode
     , fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
     , queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
     )
@@ -28,7 +28,7 @@ Sometimes, APIs might fail. As a result, you may receive an error.
 
 ### General attributes
 
-@docs accessToken, withTransactionId, timeout
+@docs accessToken, withTransactionId, timeout, onStatusCode
 
 
 ### Body
@@ -98,7 +98,9 @@ type ContextAttr
 -}
 type Error
     = InternetException Http.Error
+    | NoSupportedVersion
     | ServerReturnsBadJSON String
+    | ServerReturnsError String Json.Value
 
 
 {-| Ordinary shape of an HTTP request.
@@ -396,10 +398,35 @@ getUrl { attributes, baseUrl, path } =
         (getQueryParams attributes)
 
 
+{-| When the HTTP request cannot be deciphered but the status code is known,
+return with a given default error.
+-}
+onStatusCode : Int -> String -> Attribute a
+onStatusCode code err _ =
+    StatusCodeResponse code
+        ( err
+            |> E.string
+            |> Tuple.pair "errcode"
+            |> List.singleton
+            |> E.object
+            |> ServerReturnsError err
+        , String.concat
+            -- TODO: Move to Internal.Config.Text
+            [ "Received an invalid HTTP response from Matrix server "
+            , "but managed to decode it using the status code "
+            , String.fromInt code
+            , ": Default to errcode "
+            , err
+            ]
+            |> log.warn
+            |> List.singleton
+        )
+
+
 {-| Resolve the response of a Matrix API call.
 -}
-rawApiCallResolver : Json.Coder a -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
+rawApiCallResolver : Json.Coder a -> (a -> ( b, List Log )) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( b, List Log )
-rawApiCallResolver coder statusCodeErrors =
+rawApiCallResolver coder f statusCodeErrors =
     Http.stringResolver
         (\response ->
             case response of
@@ -427,12 +454,30 @@ rawApiCallResolver coder statusCodeErrors =
                 Http.BadStatus_ metadata body ->
                     statusCodeErrors
                         |> Dict.get metadata.statusCode
-                        |> decodeServerResponse (Json.decode coder) body
+                        |> decodeServerResponse
+                            (Json.decode coder
+                                |> D.map
+                                    (\( u, l ) ->
+                                        case f u of
+                                            ( u2, l2 ) ->
+                                                ( u2, List.append l l2 )
+                                    )
+                            )
+                            body
 
                 Http.GoodStatus_ metadata body ->
                     statusCodeErrors
                         |> Dict.get metadata.statusCode
-                        |> decodeServerResponse (Json.decode coder) body
+                        |> decodeServerResponse
+                            (Json.decode coder
+                                |> D.map
+                                    (\( u, l ) ->
+                                        case f u of
+                                            ( u2, l2 ) ->
+                                                ( u2, List.append l l2 )
+                                    )
+                            )
+                            body
         )
 
 
@@ -511,9 +556,10 @@ timeout f _ =
 -}
 toChain :
     { logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
-    , coder : Json.Coder update
+    , coder : Json.Coder httpOut
     , request : ApiPlan ph1
     , toContextChange : update -> (APIContext ph1 -> APIContext ph2)
+    , toUpdate : httpOut -> ( update, List Log )
     }
     -> C.TaskChain Error update ph1 ph2
 toChain data apiContext =
@@ -526,7 +572,7 @@ toChain data apiContext =
                         , headers = getHeaders call.attributes
                         , url = getUrl call
                         , body = Http.jsonBody (getBody call.attributes)
-                        , resolver = rawApiCallResolver data.coder (getStatusCodes call.attributes)
+                        , resolver = rawApiCallResolver data.coder data.toUpdate (getStatusCodes call.attributes)
                         , timeout = getTimeout call.attributes
                         }
                 in

src/Internal/Api/Task.elm

@@ -1,5 +1,9 @@
 module Internal.Api.Task exposing (Task, run)
-{-| # Task module
+
+{-|
+
+
+# Task module
 
 This module is used to define how API calls are made. These completed API tasks
 can be directly converted to Cmd types that the end user of the SDK can access.
@@ -8,9 +12,11 @@ These tasks do not affect the `Vault` directly, but instead, return a
 `VaultUpdate` type that the user can apply to keep their `Vault` type
 up-to-date.
 
+
 ## Use
 
 @docs Task, run
+
 -}
 
 import Internal.Api.Chain as C

src/Internal/Config/Text.elm

@@ -247,6 +247,7 @@ fields :
     { context :
         { accessToken : Desc
         , baseUrl : Desc
+        , experimental : Desc
         , password : Desc
         , refreshToken : Desc
         , username : Desc
@@ -329,6 +330,9 @@ fields =
         , baseUrl =
             [ "The base URL of the Matrix server."
             ]
+        , experimental =
+            [ "Experimental features supported by the homeserver."
+            ]
         , password =
             [ "The user's password for authentication purposes."
             ]

src/Internal/Values/Context.elm

@@ -4,7 +4,7 @@ module Internal.Values.Context exposing
     , setAccessToken, getAccessToken
     , setBaseUrl, getBaseUrl
     , setTransaction, getTransaction
-    , setVersions, getVersions
+    , Versions, setVersions, getVersions
     )
 
 {-| The Context is the set of variables that the user (mostly) cannot control.
@@ -45,13 +45,14 @@ information that can be inserted.
 
 ### Versions
 
-@docs setVersions, getVersions
+@docs Versions, setVersions, getVersions
 
 -}
 
 import Internal.Config.Leaks as L
 import Internal.Config.Text as Text
 import Internal.Tools.Json as Json
+import Set exposing (Set)
 
 
 {-| The Context type stores all the information in the Vault. This data type is
@@ -60,6 +61,7 @@ static and hence can be passed on easily.
 type alias Context =
     { accessToken : Maybe String
     , baseUrl : Maybe String
+    , experimental : Maybe (Set String)
     , password : Maybe String
     , refreshToken : Maybe String
     , username : Maybe String
@@ -78,10 +80,14 @@ type APIContext ph
         , baseUrl : String
         , context : Context
         , transaction : String
-        , versions : List String
+        , versions : Versions
         }
 
 
+type alias Versions =
+    { versions : List String, unstableFeatures : Set String }
+
+
 {-| Create an unformatted APIContext type.
 -}
 apiFormat : Context -> APIContext {}
@@ -91,7 +97,10 @@ apiFormat context =
         , baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
         , context = context
         , transaction = context.transaction |> Maybe.withDefault L.transaction
-        , versions = context.versions |> Maybe.withDefault L.versions
+        , versions =
+            { versions = context.versions |> Maybe.withDefault L.versions
+            , unstableFeatures = context.experimental |> Maybe.withDefault Set.empty
+            }
         }
 
 
@@ -99,7 +108,7 @@ apiFormat context =
 -}
 coder : Json.Coder Context
 coder =
-    Json.object7
+    Json.object8
         { name = Text.docs.context.name
         , description = Text.docs.context.description
         , init = Context
@@ -118,6 +127,13 @@ coder =
             , coder = Json.string
             }
         )
+        (Json.field.optional.value
+            { fieldName = "experimental"
+            , toField = .experimental
+            , description = Text.fields.context.experimental
+            , coder = Json.set Json.string
+            }
+        )
         (Json.field.optional.value
             { fieldName = "password"
             , toField = .password
@@ -175,6 +191,7 @@ init : Context
 init =
     { accessToken = Nothing
     , baseUrl = Nothing
+    , experimental = Nothing
     , refreshToken = Nothing
     , password = Nothing
     , username = Nothing
@@ -227,13 +244,13 @@ setTransaction value (APIContext c) =
 
 {-| Get an inserted versions list.
 -}
-getVersions : APIContext { a | versions : () } -> List String
+getVersions : APIContext { a | versions : () } -> Versions
 getVersions (APIContext c) =
     c.versions
 
 
 {-| Insert a versions list into the APIContext.
 -}
-setVersions : List String -> APIContext a -> APIContext { a | versions : () }
+setVersions : Versions -> APIContext a -> APIContext { a | versions : () }
 setVersions value (APIContext c) =
     APIContext { c | versions = value }

src/Internal/Values/Room.elm

@@ -1,6 +1,6 @@
 module Internal.Values.Room exposing
     ( Room, init
-    , RoomUpdate, update
+    , RoomUpdate(..), update
     , Batch, addBatch, addSync, addEvents, mostRecentEvents
     , getAccountData, setAccountData
     , coder, encode, decode
@@ -56,6 +56,7 @@ import Internal.Tools.Json as Json
 import Internal.Values.Event as Event exposing (Event)
 import Internal.Values.StateManager as StateManager exposing (StateManager)
 import Internal.Values.Timeline as Timeline exposing (Timeline)
+import Internal.Values.User as User exposing (User)
 import Json.Encode as E
 
 
@@ -81,7 +82,9 @@ type alias Room =
 from the Matrix API.
 -}
 type RoomUpdate
-    = AddSync Batch
+    = AddEvent Event
+    | AddSync Batch
+    | Invite User
     | More (List RoomUpdate)
     | SetAccountData String Json.Value
 
@@ -245,9 +248,17 @@ setAccountData key value room =
 update : RoomUpdate -> Room -> Room
 update ru room =
     case ru of
+        AddEvent _ ->
+            -- TODO: Add event
+            room
+
         AddSync batch ->
             addSync batch room
 
+        Invite user ->
+            -- TODO: Invite user
+            room
+
         More items ->
             List.foldl update room items