noordstar
/
elm-matrix-sdk-beta
mirror of https://github.com/noordstar/elm-matrix-sdk-beta
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Add spec version control for API endpoints

4-compiler-bug
Bram 2024-05-19 00:22:12 +02:00
parent e49a0e3dc3
commit 3fdd25d6d6
7 changed files with 243 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
src/Internal/Api/Api.elm
View File

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

6
src/Internal/Api/Chain.elm
View File

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

62
src/Internal/Api/Request.elm
View File

@ -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 coder statusCodeErrors =
rawApiCallResolver : Json.Coder a -> (a -> ( b, List Log )) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( b, List Log )
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

8
src/Internal/Api/Task.elm
View File

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

4
src/Internal/Config/Text.elm
View File

@ -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."
]

31
src/Internal/Values/Context.elm
View File

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

15
src/Internal/Values/Room.elm
View File

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