Add spec version control for API endpoints
parent
e49a0e3dc3
commit
3fdd25d6d6
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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 }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue