commit
c5e546b25c
2
elm.json
2
elm.json
|
@ -14,9 +14,11 @@
|
||||||
"elm-version": "0.19.0 <= v < 0.20.0",
|
"elm-version": "0.19.0 <= v < 0.20.0",
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"elm/core": "1.0.0 <= v < 2.0.0",
|
"elm/core": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/http": "2.0.0 <= v < 3.0.0",
|
||||||
"elm/json": "1.0.0 <= v < 2.0.0",
|
"elm/json": "1.0.0 <= v < 2.0.0",
|
||||||
"elm/parser": "1.0.0 <= v < 2.0.0",
|
"elm/parser": "1.0.0 <= v < 2.0.0",
|
||||||
"elm/time": "1.0.0 <= v < 2.0.0",
|
"elm/time": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/url": "1.0.0 <= v < 2.0.0",
|
||||||
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
||||||
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
||||||
},
|
},
|
||||||
|
|
|
@ -0,0 +1,196 @@
|
||||||
|
module Internal.Api.Api exposing
|
||||||
|
( TaskChain, request
|
||||||
|
, VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API
|
||||||
|
|
||||||
|
The API module is a front-end for implementing API endpoints according to spec.
|
||||||
|
|
||||||
|
This module is imported by various API endpoint implementations to keep the
|
||||||
|
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, log)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext, Versions)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
import Recursion
|
||||||
|
import Set
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChain helps create a chain of HTTP requests.
|
||||||
|
-}
|
||||||
|
type alias TaskChain ph1 ph2 =
|
||||||
|
C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) { ph1 | baseUrl : () } { ph2 | baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Make an HTTP request that adheres to the Matrix spec rules.
|
||||||
|
-}
|
||||||
|
request :
|
||||||
|
{ attributes : List (R.Attribute { ph1 | baseUrl : () })
|
||||||
|
, coder : Json.Coder returnValue
|
||||||
|
, contextChange : returnValue -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
|
||||||
|
, method : String
|
||||||
|
, path : List String
|
||||||
|
, toUpdate : returnValue -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
|
||||||
|
}
|
||||||
|
-> TaskChain ph1 ph2
|
||||||
|
request data =
|
||||||
|
R.toChain
|
||||||
|
{ logHttp =
|
||||||
|
\r ->
|
||||||
|
( E.HttpRequest r
|
||||||
|
, String.concat
|
||||||
|
-- TODO: Move this to Internal.Config.Text module
|
||||||
|
[ "Matrix HTTP: "
|
||||||
|
, r.method
|
||||||
|
, " "
|
||||||
|
, r.url
|
||||||
|
]
|
||||||
|
|> log.info
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
, coder = data.coder
|
||||||
|
, request =
|
||||||
|
R.callAPI
|
||||||
|
{ method = data.method
|
||||||
|
, path = data.path
|
||||||
|
}
|
||||||
|
|> 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)
|
|
@ -0,0 +1,157 @@
|
||||||
|
module Internal.Api.BaseUrl.Api exposing (baseUrl)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Base URL
|
||||||
|
|
||||||
|
This module looks for the right homeserver address.
|
||||||
|
|
||||||
|
@docs baseUrl
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Leaks as L
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the homeserver base URL of a given server name.
|
||||||
|
-}
|
||||||
|
baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () }
|
||||||
|
baseUrl data =
|
||||||
|
R.toChain
|
||||||
|
{ logHttp =
|
||||||
|
\r ->
|
||||||
|
( E.HttpRequest r
|
||||||
|
, Text.logs.httpRequest r.method r.url
|
||||||
|
|> log.info
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
, coder = coder
|
||||||
|
, request =
|
||||||
|
\context ->
|
||||||
|
{ attributes = []
|
||||||
|
, baseUrl = data.url
|
||||||
|
, context = context
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ ".well-known", "matrix", "client" ]
|
||||||
|
}
|
||||||
|
, toContextChange = \info -> Context.setBaseUrl info.homeserver.baseUrl
|
||||||
|
, toUpdate =
|
||||||
|
\info ->
|
||||||
|
( E.SetBaseUrl info.homeserver.baseUrl
|
||||||
|
, Text.logs.baseUrlFound data.url info.homeserver.baseUrl
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias BaseUrlInput =
|
||||||
|
{ url : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias DiscoveryInformation =
|
||||||
|
{ homeserver : HomeserverInformation
|
||||||
|
, identityServer : Maybe IdentityServerInformation
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias HomeserverInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias IdentityServerInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
coder : Json.Coder DiscoveryInformation
|
||||||
|
coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Discovery Information"
|
||||||
|
, description =
|
||||||
|
[ "Gets discovery information about the domain. The file may include additional keys, which MUST follow the Java package naming convention, e.g. com.example.myapp.property. This ensures property names are suitably namespaced for each application and reduces the risk of clashes."
|
||||||
|
, "Note that this endpoint is not necessarily handled by the homeserver, but by another webserver, to be used for discovering the homeserver URL."
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#getwell-knownmatrixclient"
|
||||||
|
]
|
||||||
|
, init = DiscoveryInformation
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "m.homeserver"
|
||||||
|
, toField = .homeserver
|
||||||
|
, coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = \a _ -> { baseUrl = a }
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = L.field
|
||||||
|
, toField = always Nothing
|
||||||
|
, description =
|
||||||
|
[ "The Elm SDK always expects objects to have at least two fields."
|
||||||
|
, "Otherwise, what's the point of hiding the value in an object?"
|
||||||
|
, "For this reason, this empty placeholder key will always be ignored."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "m.identity_server"
|
||||||
|
, toField = .identityServer
|
||||||
|
, coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = \a _ -> { baseUrl = a }
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = L.field
|
||||||
|
, toField = always Nothing
|
||||||
|
, description =
|
||||||
|
[ "The Elm SDK always expects objects to have at least two fields."
|
||||||
|
, "Otherwise, what's the point of hiding the value in an object?"
|
||||||
|
, "For this reason, this empty placeholder key will always be ignored."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover identity server information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,203 @@
|
||||||
|
module Internal.Api.Chain exposing
|
||||||
|
( TaskChain, CompleteChain
|
||||||
|
, IdemChain, toTask
|
||||||
|
, fail, succeed, andThen, catchWith, maybe
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Task chains
|
||||||
|
|
||||||
|
Elm uses a `Task` type to avoid issues that JavaScript deals with, yet the same
|
||||||
|
**callback hell** issue might appear that JavaScript developers often deal with.
|
||||||
|
For this reason, this module helps chain different `Task` types together such
|
||||||
|
that all information is stored and values are dealt with appropriately.
|
||||||
|
|
||||||
|
Elm's type checking system helps making this system sufficiently rigorous to
|
||||||
|
avoid leaking values passing through the API in unexpected ways.
|
||||||
|
|
||||||
|
@docs TaskChain, CompleteChain
|
||||||
|
|
||||||
|
|
||||||
|
## Finished chain
|
||||||
|
|
||||||
|
@docs IdemChain, toTask
|
||||||
|
|
||||||
|
|
||||||
|
## Operations
|
||||||
|
|
||||||
|
@docs fail, succeed, andThen, catchWith, maybe
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Log exposing (Log)
|
||||||
|
import Internal.Values.Context exposing (APIContext)
|
||||||
|
import Task
|
||||||
|
|
||||||
|
|
||||||
|
type alias Backpacked u a =
|
||||||
|
{ a | messages : List u, logs : List Log }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The TaskChain is a piece in the long chain of tasks that need to be completed.
|
||||||
|
The type defines four variables:
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be returned
|
||||||
|
- `a` phantom type before executing the chain's context
|
||||||
|
- `b` phantom type after executing the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChain err u a b =
|
||||||
|
APIContext a -> Task.Task (FailedChainPiece err u) (TaskChainPiece u a b)
|
||||||
|
|
||||||
|
|
||||||
|
{-| An IdemChain is a TaskChain that does not influence the chain's context
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be executed
|
||||||
|
- `a` phantom type before, during and after the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias IdemChain err u a =
|
||||||
|
TaskChain err u a a
|
||||||
|
|
||||||
|
|
||||||
|
{-| A CompleteChain is a complete task chain where all necessary information
|
||||||
|
has been defined. In simple terms, whenever a Matrix API call is made, all
|
||||||
|
necessary information for that endpoint:
|
||||||
|
|
||||||
|
1. Was previously known and has been inserted, or
|
||||||
|
2. Was acquired before actually making the API call.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias CompleteChain u =
|
||||||
|
TaskChain Never u {} {}
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChainPiece is a piece that updates the chain's context.
|
||||||
|
|
||||||
|
Once a chain is executed, the process will add the `messages` value to its list
|
||||||
|
of updates, and it will update its context according to the `contextChange`
|
||||||
|
function.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChainPiece u a b =
|
||||||
|
Backpacked u { contextChange : APIContext a -> APIContext b }
|
||||||
|
|
||||||
|
|
||||||
|
{-| A FailedChainPiece initiates an early breakdown of a chain. Unless caught,
|
||||||
|
this halts execution of the chain. The process will add the `messages` value to
|
||||||
|
its list of updates, and it will return the given `err` value for a direct
|
||||||
|
explanation of what went wrong.
|
||||||
|
-}
|
||||||
|
type alias FailedChainPiece err u =
|
||||||
|
Backpacked u { error : err }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Chain two tasks together. The second task will only run if the first one
|
||||||
|
succeeds.
|
||||||
|
-}
|
||||||
|
andThen : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
|
||||||
|
andThen f2 f1 =
|
||||||
|
\context ->
|
||||||
|
f1 context
|
||||||
|
|> Task.andThen
|
||||||
|
(\old ->
|
||||||
|
context
|
||||||
|
|> old.contextChange
|
||||||
|
|> f2
|
||||||
|
|> Task.map
|
||||||
|
(\new ->
|
||||||
|
{ contextChange = old.contextChange >> new.contextChange
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\new ->
|
||||||
|
{ error = new.error
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error has occurred, "fix" it with an artificial task chain result.
|
||||||
|
-}
|
||||||
|
catchWith : (err -> TaskChainPiece u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
catchWith onErr f =
|
||||||
|
onError (\e -> succeed <| onErr e) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always fails.
|
||||||
|
-}
|
||||||
|
fail : err -> TaskChain err u a b
|
||||||
|
fail e _ =
|
||||||
|
Task.fail { error = e, logs = [], messages = [] }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Optionally run a task that doesn't need to succeed.
|
||||||
|
|
||||||
|
If the provided chain fails, it will be ignored. This way, the chain can be
|
||||||
|
executed without breaking the whole chain if it fails. This can be useful for:
|
||||||
|
|
||||||
|
1. Sending information to the Matrix API and not caring if it actually arrives
|
||||||
|
2. Gaining optional information that might be nice to know, but not necessary
|
||||||
|
|
||||||
|
Consequently, the optional chain cannot add any information that the rest of
|
||||||
|
the chain relies on.
|
||||||
|
|
||||||
|
-}
|
||||||
|
maybe : IdemChain err u a -> IdemChain err2 u a
|
||||||
|
maybe f =
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = []
|
||||||
|
, messages = []
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> always
|
||||||
|
|> onError
|
||||||
|
|> (|>) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error occurs, this function allows the task chain to go down a
|
||||||
|
similar but different route.
|
||||||
|
-}
|
||||||
|
onError : (err -> TaskChain err2 u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
onError onErr f =
|
||||||
|
\context ->
|
||||||
|
f context
|
||||||
|
|> Task.onError
|
||||||
|
(\old ->
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = old.logs -- TODO: Log caught errors
|
||||||
|
, messages = old.messages
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> andThen (onErr old.error)
|
||||||
|
|> (|>) context
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always succeeds.
|
||||||
|
-}
|
||||||
|
succeed : TaskChainPiece u a b -> TaskChain err u a b
|
||||||
|
succeed piece _ =
|
||||||
|
Task.succeed piece
|
||||||
|
|
||||||
|
|
||||||
|
{-| Once the chain is complete, turn it into a valid task.
|
||||||
|
-}
|
||||||
|
toTask : IdemChain Never u a -> APIContext a -> Task.Task Never (Backpacked u {})
|
||||||
|
toTask chain context =
|
||||||
|
chain context
|
||||||
|
|> Task.onError (\e -> Task.succeed <| never e.error)
|
||||||
|
|> Task.map
|
||||||
|
(\backpack ->
|
||||||
|
{ messages = backpack.messages
|
||||||
|
, logs = backpack.logs
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,247 @@
|
||||||
|
module Internal.Api.GetEvent.Api exposing (GetEventInput, getEvent)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Get event
|
||||||
|
|
||||||
|
Get a single event based on `roomId/eventId`. You must have permission to
|
||||||
|
retrieve this event e.g. by being a member in the room for this event.
|
||||||
|
|
||||||
|
@docs GetEventInput, getEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
|
import Internal.Values.Room as Room
|
||||||
|
import Internal.Values.User as User
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Input for getting an event.
|
||||||
|
-}
|
||||||
|
type alias GetEventInput =
|
||||||
|
{ eventId : String, roomId : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Standard input for version 1 of the GetEvent API endpoint.
|
||||||
|
-}
|
||||||
|
type alias GetEventInputV1 a =
|
||||||
|
{ a | eventId : String, roomId : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Universal phantom type encompassing all versions of this API endpoint.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
PhantomV1 { a | versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Phantom values necessary for version 1 of the GetEvent API endpoint.
|
||||||
|
-}
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an event based on a room id and event id.
|
||||||
|
-}
|
||||||
|
getEvent : GetEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
getEvent =
|
||||||
|
A.startWithVersion "r0.5.0" getEventV1
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" getEventV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Version 1 of the GetEvent API endpoint
|
||||||
|
-}
|
||||||
|
getEventV1 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
getEventV1 { eventId, roomId } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.onStatusCode 404 "M_NOT_FOUND"
|
||||||
|
]
|
||||||
|
, coder = getEventCoderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "event", eventId ]
|
||||||
|
, toUpdate =
|
||||||
|
\event ->
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
|
||||||
|
, event.eventId
|
||||||
|
|> Text.logs.getEventId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Version 2 of the GetEvent API endpoint
|
||||||
|
-}
|
||||||
|
getEventV2 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
getEventV2 { eventId, roomId } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.onStatusCode 404 "M_NOT_FOUND"
|
||||||
|
]
|
||||||
|
, coder = getEventCoderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "event", eventId ]
|
||||||
|
, toUpdate =
|
||||||
|
\event ->
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
|
||||||
|
, event.eventId
|
||||||
|
|> Text.logs.getEventId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
getEventCoderV1 : Json.Coder Event
|
||||||
|
getEventCoderV1 =
|
||||||
|
Json.object8
|
||||||
|
{ name = "ClientEvent"
|
||||||
|
, description =
|
||||||
|
[ "ClientEvent as described by the Matrix spec"
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||||
|
]
|
||||||
|
, init = Event
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "content"
|
||||||
|
, toField = .content
|
||||||
|
, description =
|
||||||
|
[ "The body of this event, as created by the client which sent it."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description =
|
||||||
|
[ "The globally unique identifier for this event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "origin_server_ts"
|
||||||
|
, toField = .originServerTs
|
||||||
|
, description =
|
||||||
|
[ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent."
|
||||||
|
]
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "room_id"
|
||||||
|
, toField = .roomId
|
||||||
|
, description =
|
||||||
|
[ "The ID of the room associated with this event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "sender"
|
||||||
|
, toField = .sender
|
||||||
|
, description =
|
||||||
|
[ "Contains the fully-qualified ID of the user who sent this event."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state_key"
|
||||||
|
, toField = .stateKey
|
||||||
|
, description =
|
||||||
|
[ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string."
|
||||||
|
, "State keys starting with an @ are reserved for referencing user IDs, such as room members. With the exception of a few events, state events set with a given user’s ID as the state key MUST only be set by that user."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "type"
|
||||||
|
, toField = .eventType
|
||||||
|
, description =
|
||||||
|
[ "The type of the event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unsigned"
|
||||||
|
, toField = .unsigned
|
||||||
|
, description =
|
||||||
|
[ "Contains optional extra information about the event."
|
||||||
|
]
|
||||||
|
, coder =
|
||||||
|
Json.object4
|
||||||
|
{ name = "UnsignedData"
|
||||||
|
, description =
|
||||||
|
[ "UnsignedData as described by the Matrix spec"
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||||
|
]
|
||||||
|
, init = \a b c d -> Event.UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "age"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.age
|
||||||
|
, description =
|
||||||
|
[ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is."
|
||||||
|
]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "prev_content"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.prevContent
|
||||||
|
, description =
|
||||||
|
[ " The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content."
|
||||||
|
, "Changed in v1.2: Previously, this field was specified at the top level of returned events rather than in unsigned (with the exception of the GET .../notifications endpoint), though in practice no known server implementations honoured this."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "redacted_because"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.redactedBecause
|
||||||
|
, description =
|
||||||
|
[ "The event that redacted this event, if any."
|
||||||
|
]
|
||||||
|
, coder = Json.lazy (\() -> getEventCoderV1)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "transaction_id"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.transactionId
|
||||||
|
, description =
|
||||||
|
[ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,127 @@
|
||||||
|
module Internal.Api.Invite.Api exposing (InviteInput, Phantom, invite)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Invite
|
||||||
|
|
||||||
|
This API invites a user to participate in a particular room. They do not start
|
||||||
|
participating in the room until they actually join the room.
|
||||||
|
|
||||||
|
Only users currently in a particular room can invite other users to join that
|
||||||
|
room.
|
||||||
|
|
||||||
|
If the user was invited to the room, the homeserver will append a m.room.member
|
||||||
|
event to the room.
|
||||||
|
|
||||||
|
@docs InviteInput, Phantom, invite
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Room as Room
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invite a user to a room.
|
||||||
|
-}
|
||||||
|
invite : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
|
||||||
|
invite =
|
||||||
|
A.startWithVersion "r0.0.0" inviteV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" inviteV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for inviting a user.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Input for inviting a user.
|
||||||
|
-}
|
||||||
|
type alias InviteInput =
|
||||||
|
{ reason : Maybe String, roomId : String, user : User }
|
||||||
|
|
||||||
|
|
||||||
|
type alias InviteInputV1 a =
|
||||||
|
{ a | roomId : String, user : User }
|
||||||
|
|
||||||
|
|
||||||
|
type alias InviteInputV2 a =
|
||||||
|
{ a | roomId : String, user : User, reason : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
inviteV1 : InviteInputV1 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
|
||||||
|
inviteV1 { roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "invite" ]
|
||||||
|
, toUpdate =
|
||||||
|
always
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
|
||||||
|
, Text.logs.invitedUser (User.toString user) roomId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
inviteV2 : InviteInputV2 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
|
||||||
|
inviteV2 { reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "reason" reason
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "invite" ]
|
||||||
|
, toUpdate =
|
||||||
|
always
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
|
||||||
|
, Text.logs.invitedUser (User.toString user) roomId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
|
@ -0,0 +1,951 @@
|
||||||
|
module Internal.Api.LoginWithUsernameAndPassword.Api exposing (Phantom, loginWithUsernameAndPassword)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Login
|
||||||
|
|
||||||
|
This module allows the user to log in using a username and password.
|
||||||
|
|
||||||
|
@docs Phantom, loginWithUsernameAndPassword
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Leaks as L
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
import Json.Encode as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Log in using a username and password.
|
||||||
|
-}
|
||||||
|
loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> A.TaskChain (Phantom a) (Phantom { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPassword =
|
||||||
|
A.startWithVersion "r0.0.0" loginWithUsernameAndPasswordV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.forVersion "r0.3.0" loginWithUsernameAndPasswordV2
|
||||||
|
|> A.forVersion "r0.4.0" loginWithUsernameAndPasswordV3
|
||||||
|
|> A.forVersion "r0.5.0" loginWithUsernameAndPasswordV4
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" loginWithUsernameAndPasswordV5
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.forVersion "v1.3" loginWithUsernameAndPasswordV6
|
||||||
|
|> A.forVersion "v1.4" loginWithUsernameAndPasswordV7
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for logging in with a username and password
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | baseUrl : (), now : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInput =
|
||||||
|
{ deviceId : Maybe String
|
||||||
|
, enableRefreshToken : Maybe Bool
|
||||||
|
, initialDeviceDisplayName : Maybe String
|
||||||
|
, password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInputV1 a =
|
||||||
|
{ a
|
||||||
|
| password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInputV2 a =
|
||||||
|
{ a
|
||||||
|
| deviceId : Maybe String
|
||||||
|
, initialDeviceDisplayName : Maybe String
|
||||||
|
, password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInputV3 a =
|
||||||
|
{ a
|
||||||
|
| deviceId : Maybe String
|
||||||
|
, enableRefreshToken : Maybe Bool
|
||||||
|
, initialDeviceDisplayName : Maybe String
|
||||||
|
, password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV1 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, homeserver : String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV2 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, homeserver : String
|
||||||
|
, user : Maybe User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV3 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV4 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
, wellKnown : Maybe DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV5 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, expiresInMs : Maybe Int
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
, wellKnown : Maybe DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV6 =
|
||||||
|
{ accessToken : String
|
||||||
|
, deviceId : String
|
||||||
|
, expiresInMs : Maybe Int
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, user : User
|
||||||
|
, wellKnown : Maybe DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias DiscoveryInformationV1 =
|
||||||
|
{ homeserver : HomeserverInformation
|
||||||
|
, identityServer : Maybe IdentityServerInformation
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias HomeserverInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias IdentityServerInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | baseUrl : (), now : () }
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV1 { username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
]
|
||||||
|
, coder = coderV1
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = out.refreshToken
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV2 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "string" -- Yup. That's what it says.
|
||||||
|
]
|
||||||
|
, coder = coderV2
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV3 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV3
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV4 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV4
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||||
|
|> E.Optional
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV5 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV4
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||||
|
|> E.Optional
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV6 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyOpBool "refresh_token" enableRefreshToken
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV5
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = out.expiresInMs
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = out.refreshToken
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||||
|
|> E.Optional
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV7 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyOpBool "refresh_token" enableRefreshToken
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV6
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = out.expiresInMs
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = out.refreshToken
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.ContentUpdate (V.SetUser out.user)
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, E.SetDeviceId out.deviceId
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder LoginWithUsernameAndPasswordOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/r0.0.0/client_server.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests. The access token may expire at some point, and if so, it SHOULD come with a refresh_token. There is no specific error message to indicate that a request has failed because an access token has expired; instead, if a client has reason to believe its access token is valid, and it receives an auth error, they should attempt to refresh for a new token on failure, and retry the request with the new token."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh_token"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description =
|
||||||
|
[ "A refresh_token may be exchanged for a new access_token using the /tokenrefresh API endpoint."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder LoginWithUsernameAndPasswordOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.3.0.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV2
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV3 : Json.Coder LoginWithUsernameAndPasswordOutputV3
|
||||||
|
coderV3 =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.3.0.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV3
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV4 : Json.Coder LoginWithUsernameAndPasswordOutputV4
|
||||||
|
coderV4 =
|
||||||
|
Json.object5
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.5.0.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV4
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "well_known"
|
||||||
|
, toField = .wellKnown
|
||||||
|
, description =
|
||||||
|
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
|
||||||
|
]
|
||||||
|
, coder = disoveryInformationCoderV1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV5 : Json.Coder LoginWithUsernameAndPasswordOutputV5
|
||||||
|
coderV5 =
|
||||||
|
Json.object7
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/v1.3/client-server-api/#post_matrixclientv3login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV5
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "expires_in_ms"
|
||||||
|
, toField = .expiresInMs
|
||||||
|
, description =
|
||||||
|
[ "The lifetime of the access token, in milliseconds. Once the access token has expired a new access token can be obtained by using the provided refresh token. If no refresh token is provided, the client will need to re-log in to obtain a new access token. If not given, the client can assume that the access token will not expire. "
|
||||||
|
]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh_token"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description =
|
||||||
|
[ "A refresh token for the account. This token can be used to obtain a new access token when it expires by calling the /refresh endpoint."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "well_known"
|
||||||
|
, toField = .wellKnown
|
||||||
|
, description =
|
||||||
|
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
|
||||||
|
]
|
||||||
|
, coder = disoveryInformationCoderV1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV6 : Json.Coder LoginWithUsernameAndPasswordOutputV6
|
||||||
|
coderV6 =
|
||||||
|
Json.object7
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/v1.3/client-server-api/#post_matrixclientv3login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV6
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "expires_in_ms"
|
||||||
|
, toField = .expiresInMs
|
||||||
|
, description =
|
||||||
|
[ "The lifetime of the access token, in milliseconds. Once the access token has expired a new access token can be obtained by using the provided refresh token. If no refresh token is provided, the client will need to re-log in to obtain a new access token. If not given, the client can assume that the access token will not expire. "
|
||||||
|
]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh_token"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description =
|
||||||
|
[ "A refresh token for the account. This token can be used to obtain a new access token when it expires by calling the /refresh endpoint."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "well_known"
|
||||||
|
, toField = .wellKnown
|
||||||
|
, description =
|
||||||
|
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
|
||||||
|
]
|
||||||
|
, coder = disoveryInformationCoderV1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
disoveryInformationCoderV1 : Json.Coder DiscoveryInformationV1
|
||||||
|
disoveryInformationCoderV1 =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Discovery Information"
|
||||||
|
, description =
|
||||||
|
[ "Gets discovery information about the domain. The file may include additional keys, which MUST follow the Java package naming convention, e.g. com.example.myapp.property. This ensures property names are suitably namespaced for each application and reduces the risk of clashes."
|
||||||
|
, "Note that this endpoint is not necessarily handled by the homeserver, but by another webserver, to be used for discovering the homeserver URL."
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#getwell-knownmatrixclient"
|
||||||
|
]
|
||||||
|
, init = DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "m.homeserver"
|
||||||
|
, toField = .homeserver
|
||||||
|
, coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = \a _ -> { baseUrl = a }
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = L.field
|
||||||
|
, toField = always Nothing
|
||||||
|
, description =
|
||||||
|
[ "The Elm SDK always expects objects to have at least two fields."
|
||||||
|
, "Otherwise, what's the point of hiding the value in an object?"
|
||||||
|
, "For this reason, this empty placeholder key will always be ignored."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "m.identity_server"
|
||||||
|
, toField = .identityServer
|
||||||
|
, coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = \a _ -> { baseUrl = a }
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = L.field
|
||||||
|
, toField = always Nothing
|
||||||
|
, description =
|
||||||
|
[ "The Elm SDK always expects objects to have at least two fields."
|
||||||
|
, "Otherwise, what's the point of hiding the value in an object?"
|
||||||
|
, "For this reason, this empty placeholder key will always be ignored."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover identity server information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,59 @@
|
||||||
|
module Internal.Api.Main exposing
|
||||||
|
( Msg
|
||||||
|
, sendMessageEvent
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Main API module
|
||||||
|
|
||||||
|
This module is used as reference for getting
|
||||||
|
|
||||||
|
|
||||||
|
## VaultUpdate
|
||||||
|
|
||||||
|
@docs Msg
|
||||||
|
|
||||||
|
|
||||||
|
## Actions
|
||||||
|
|
||||||
|
@docs sendMessageEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Task as ITask exposing (Backpack)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Update message type that is being returned.
|
||||||
|
-}
|
||||||
|
type alias Msg =
|
||||||
|
Backpack
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event.
|
||||||
|
-}
|
||||||
|
sendMessageEvent :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
sendMessageEvent env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.sendMessageEvent
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, transactionId = data.transactionId
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
|
@ -0,0 +1,40 @@
|
||||||
|
module Internal.Api.Now.Api exposing (getNow)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Now
|
||||||
|
|
||||||
|
Get the current time.
|
||||||
|
|
||||||
|
@docs getNow
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Task
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the current time and place it in the context.
|
||||||
|
-}
|
||||||
|
getNow : A.TaskChain a { a | now : () }
|
||||||
|
getNow =
|
||||||
|
\_ ->
|
||||||
|
Task.map
|
||||||
|
(\now ->
|
||||||
|
{ messages = [ E.SetNow now ]
|
||||||
|
, logs =
|
||||||
|
now
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Text.logs.getNow
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
, contextChange = Context.setNow now
|
||||||
|
}
|
||||||
|
)
|
||||||
|
Time.now
|
|
@ -0,0 +1,613 @@
|
||||||
|
module Internal.Api.Request exposing
|
||||||
|
( ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||||
|
, Request, Error(..)
|
||||||
|
, accessToken, timeout, onStatusCode
|
||||||
|
, fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
, queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API module
|
||||||
|
|
||||||
|
This module helps describe API requests.
|
||||||
|
|
||||||
|
|
||||||
|
## Plan
|
||||||
|
|
||||||
|
@docs ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||||
|
|
||||||
|
Sometimes, APIs might fail. As a result, you may receive an error.
|
||||||
|
|
||||||
|
@docs Request, Error
|
||||||
|
|
||||||
|
|
||||||
|
## API attributes
|
||||||
|
|
||||||
|
|
||||||
|
### General attributes
|
||||||
|
|
||||||
|
@docs accessToken, timeout, onStatusCode
|
||||||
|
|
||||||
|
|
||||||
|
### Body
|
||||||
|
|
||||||
|
@docs fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
|
||||||
|
|
||||||
|
### Query parameters
|
||||||
|
|
||||||
|
@docs queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Dict
|
||||||
|
import Http
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Task
|
||||||
|
import Url
|
||||||
|
import Url.Builder as UrlBuilder
|
||||||
|
|
||||||
|
|
||||||
|
{-| The API call is a plan that describes how an interaction is planned with
|
||||||
|
the Matrix API.
|
||||||
|
-}
|
||||||
|
type alias ApiCall ph =
|
||||||
|
{ attributes : List ContextAttr
|
||||||
|
, baseUrl : String
|
||||||
|
, context : APIContext ph
|
||||||
|
, method : String
|
||||||
|
, path : List String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Shortcut definition to define a function that bases an APICall on a given
|
||||||
|
APIContext.
|
||||||
|
-}
|
||||||
|
type alias ApiPlan a =
|
||||||
|
APIContext a -> ApiCall a
|
||||||
|
|
||||||
|
|
||||||
|
{-| An attribute maps a given context to an attribute for an API call.
|
||||||
|
-}
|
||||||
|
type alias Attribute a =
|
||||||
|
APIContext a -> ContextAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| A context attribute describes one aspect of the API call that is to be made.
|
||||||
|
-}
|
||||||
|
type ContextAttr
|
||||||
|
= BodyParam String Json.Value
|
||||||
|
| FullBody Json.Value
|
||||||
|
| Header Http.Header
|
||||||
|
| NoAttr
|
||||||
|
| QueryParam UrlBuilder.QueryParameter
|
||||||
|
| StatusCodeResponse Int ( Error, List Log )
|
||||||
|
| Timeout Float
|
||||||
|
|
||||||
|
|
||||||
|
{-| Error indicating that something went wrong.
|
||||||
|
-}
|
||||||
|
type Error
|
||||||
|
= InternetException Http.Error
|
||||||
|
| MissingUsername
|
||||||
|
| MissingPassword
|
||||||
|
| NoSupportedVersion
|
||||||
|
| ServerReturnsBadJSON String
|
||||||
|
| ServerReturnsError String Json.Value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Ordinary shape of an HTTP request.
|
||||||
|
-}
|
||||||
|
type alias Request x a =
|
||||||
|
{ headers : List Http.Header
|
||||||
|
, body : Http.Body
|
||||||
|
, method : String
|
||||||
|
, url : String
|
||||||
|
, resolver : Http.Resolver x a
|
||||||
|
, timeout : Maybe Float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that requires an access token to be present
|
||||||
|
-}
|
||||||
|
accessToken : Attribute { a | accessToken : () }
|
||||||
|
accessToken =
|
||||||
|
Context.getAccessToken
|
||||||
|
>> (++) "Bearer "
|
||||||
|
>> Http.header "Authorization"
|
||||||
|
>> Header
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyBool : String -> Bool -> Attribute a
|
||||||
|
bodyBool key value =
|
||||||
|
bodyValue key <| Json.encode Json.bool value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyInt : String -> Int -> Attribute a
|
||||||
|
bodyInt key value =
|
||||||
|
bodyValue key <| Json.encode Json.int value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
bodyOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
bodyOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpString : String -> Maybe String -> Attribute a
|
||||||
|
bodyOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpValue : String -> Maybe Json.Value -> Attribute a
|
||||||
|
bodyOpValue key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyValue key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyString : String -> String -> Attribute a
|
||||||
|
bodyString key value =
|
||||||
|
bodyValue key <| Json.encode Json.string value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyValue : String -> Json.Value -> Attribute a
|
||||||
|
bodyValue key value _ =
|
||||||
|
BodyParam key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a plan to create an API call.
|
||||||
|
-}
|
||||||
|
callAPI : { method : String, path : List String } -> ApiPlan { a | baseUrl : () }
|
||||||
|
callAPI { method, path } context =
|
||||||
|
{ attributes = []
|
||||||
|
, baseUrl = Context.getBaseUrl context
|
||||||
|
, context = context
|
||||||
|
, method = method
|
||||||
|
, path = path
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode the server's response into (hopefully) something meaningful.
|
||||||
|
-}
|
||||||
|
decodeServerResponse : D.Decoder ( a, List Log ) -> String -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||||
|
decodeServerResponse decoder body statusCodeError =
|
||||||
|
case D.decodeString D.value body of
|
||||||
|
Err e ->
|
||||||
|
let
|
||||||
|
description : String
|
||||||
|
description =
|
||||||
|
D.errorToString e
|
||||||
|
in
|
||||||
|
Err
|
||||||
|
( ServerReturnsBadJSON description
|
||||||
|
, description
|
||||||
|
|> Text.logs.serverReturnedInvalidJSON
|
||||||
|
|> log.error
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
|
||||||
|
Ok v ->
|
||||||
|
decodeServerValue decoder v statusCodeError
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode the server's response, assuming that it parses correctly to
|
||||||
|
a JSON value.
|
||||||
|
-}
|
||||||
|
decodeServerValue : D.Decoder ( a, List Log ) -> Json.Value -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||||
|
decodeServerValue decoder value statusCodeError =
|
||||||
|
value
|
||||||
|
|> D.decodeValue decoder
|
||||||
|
|> Result.mapError
|
||||||
|
(\err ->
|
||||||
|
let
|
||||||
|
description : String
|
||||||
|
description =
|
||||||
|
D.errorToString err
|
||||||
|
|
||||||
|
-- TODO: Parse errors returned by Matrix API
|
||||||
|
error : Maybe ( Error, List Log )
|
||||||
|
error =
|
||||||
|
Nothing
|
||||||
|
in
|
||||||
|
case ( error, statusCodeError ) of
|
||||||
|
( Just e, _ ) ->
|
||||||
|
e
|
||||||
|
|
||||||
|
( Nothing, Just e ) ->
|
||||||
|
e
|
||||||
|
|
||||||
|
( Nothing, Nothing ) ->
|
||||||
|
( ServerReturnsBadJSON description
|
||||||
|
, description
|
||||||
|
|> Text.logs.serverReturnedUnknownJSON
|
||||||
|
|> log.error
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an empty attribute that does nothing.
|
||||||
|
-}
|
||||||
|
empty : Attribute a
|
||||||
|
empty =
|
||||||
|
always NoAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| Adds a JSON value as the HTTP body.
|
||||||
|
-}
|
||||||
|
fullBody : Json.Value -> Attribute a
|
||||||
|
fullBody value _ =
|
||||||
|
FullBody value
|
||||||
|
|
||||||
|
|
||||||
|
getBody : List ContextAttr -> Maybe Json.Value
|
||||||
|
getBody attributes =
|
||||||
|
attributes
|
||||||
|
|> List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
FullBody v ->
|
||||||
|
Just v
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|> List.reverse
|
||||||
|
|> List.head
|
||||||
|
|> (\fb ->
|
||||||
|
case fb of
|
||||||
|
Just _ ->
|
||||||
|
fb
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
case
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
BodyParam key value ->
|
||||||
|
Just ( key, value )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
attributes
|
||||||
|
of
|
||||||
|
[] ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
head :: tail ->
|
||||||
|
Just <| E.object (head :: tail)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getHeaders : List ContextAttr -> List Http.Header
|
||||||
|
getHeaders =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
Header h ->
|
||||||
|
Just h
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getQueryParams : List ContextAttr -> List UrlBuilder.QueryParameter
|
||||||
|
getQueryParams =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
QueryParam q ->
|
||||||
|
Just q
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getStatusCodes : List ContextAttr -> Dict.Dict Int ( Error, List Log )
|
||||||
|
getStatusCodes =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
StatusCodeResponse code err ->
|
||||||
|
Just ( code, err )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> Dict.fromList
|
||||||
|
|
||||||
|
|
||||||
|
getTimeout : List ContextAttr -> Maybe Float
|
||||||
|
getTimeout =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
Timeout f ->
|
||||||
|
Just f
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> List.reverse
|
||||||
|
>> List.head
|
||||||
|
|
||||||
|
|
||||||
|
getUrl : ApiCall a -> String
|
||||||
|
getUrl { attributes, baseUrl, path } =
|
||||||
|
UrlBuilder.crossOrigin
|
||||||
|
baseUrl
|
||||||
|
(List.map Url.percentEncode 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
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryBool : String -> Bool -> Attribute a
|
||||||
|
queryBool key value _ =
|
||||||
|
(if value then
|
||||||
|
"true"
|
||||||
|
|
||||||
|
else
|
||||||
|
"false"
|
||||||
|
)
|
||||||
|
|> UrlBuilder.string key
|
||||||
|
|> QueryParam
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryInt : String -> Int -> Attribute a
|
||||||
|
queryInt key value _ =
|
||||||
|
QueryParam <| UrlBuilder.int key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
queryOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
queryOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpString : String -> Maybe String -> Attribute a
|
||||||
|
queryOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryString : String -> String -> Attribute a
|
||||||
|
queryString key value _ =
|
||||||
|
QueryParam <| UrlBuilder.string key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Resolve the response of a Matrix API call.
|
||||||
|
-}
|
||||||
|
rawApiCallResolver : D.Decoder ( a, List Log ) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
|
||||||
|
rawApiCallResolver decoder statusCodeErrors =
|
||||||
|
Http.stringResolver
|
||||||
|
(\response ->
|
||||||
|
case response of
|
||||||
|
Http.BadUrl_ s ->
|
||||||
|
Http.BadUrl s
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error ("Encountered bad URL " ++ s) ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.Timeout_ ->
|
||||||
|
Http.Timeout
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error "Encountered timeout - maybe the server is down?" ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.NetworkError_ ->
|
||||||
|
Http.NetworkError
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error "Encountered a network error - the user might be offline" ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.BadStatus_ metadata body ->
|
||||||
|
statusCodeErrors
|
||||||
|
|> Dict.get metadata.statusCode
|
||||||
|
|> decodeServerResponse decoder body
|
||||||
|
|
||||||
|
Http.GoodStatus_ metadata body ->
|
||||||
|
statusCodeErrors
|
||||||
|
|> Dict.get metadata.statusCode
|
||||||
|
|> decodeServerResponse decoder body
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Configure the HTTP request to time out after a given expiry time.
|
||||||
|
-}
|
||||||
|
timeout : Float -> Attribute a
|
||||||
|
timeout f _ =
|
||||||
|
Timeout f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform an APICall to a TaskChain.
|
||||||
|
-}
|
||||||
|
toChain :
|
||||||
|
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
|
||||||
|
, coder : Json.Coder httpOut
|
||||||
|
, request : ApiPlan ph1
|
||||||
|
, toContextChange : httpOut -> (APIContext ph1 -> APIContext ph2)
|
||||||
|
, toUpdate : httpOut -> ( update, List Log )
|
||||||
|
}
|
||||||
|
-> C.TaskChain Error update ph1 ph2
|
||||||
|
toChain data apiContext =
|
||||||
|
data.request apiContext
|
||||||
|
|> (\call ->
|
||||||
|
let
|
||||||
|
r : Request ( Error, List Log ) ( httpOut, List Log )
|
||||||
|
r =
|
||||||
|
{ method = call.method
|
||||||
|
, headers = getHeaders call.attributes
|
||||||
|
, url = getUrl call
|
||||||
|
, body =
|
||||||
|
getBody call.attributes
|
||||||
|
|> Maybe.map Http.jsonBody
|
||||||
|
|> Maybe.withDefault Http.emptyBody
|
||||||
|
, resolver = rawApiCallResolver (Json.decode data.coder) (getStatusCodes call.attributes)
|
||||||
|
, timeout = getTimeout call.attributes
|
||||||
|
}
|
||||||
|
|
||||||
|
logR : Request ( Error, List Log ) ( update, List Log )
|
||||||
|
logR =
|
||||||
|
{ method = call.method
|
||||||
|
, headers = getHeaders call.attributes
|
||||||
|
, url = getUrl call
|
||||||
|
, body =
|
||||||
|
getBody call.attributes
|
||||||
|
|> Maybe.map Http.jsonBody
|
||||||
|
|> Maybe.withDefault Http.emptyBody
|
||||||
|
, resolver =
|
||||||
|
rawApiCallResolver
|
||||||
|
(Json.decode data.coder
|
||||||
|
|> D.map
|
||||||
|
(\( out, logs ) ->
|
||||||
|
case data.toUpdate out of
|
||||||
|
( u, uLogs ) ->
|
||||||
|
( u, List.append logs uLogs )
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(getStatusCodes call.attributes)
|
||||||
|
, timeout = getTimeout call.attributes
|
||||||
|
}
|
||||||
|
in
|
||||||
|
case data.logHttp logR of
|
||||||
|
( httpU, httpLogs ) ->
|
||||||
|
Http.task r
|
||||||
|
|> Task.map
|
||||||
|
(\( httpO, logs ) ->
|
||||||
|
case data.toUpdate httpO of
|
||||||
|
( u, uLogs ) ->
|
||||||
|
{ contextChange = data.toContextChange httpO
|
||||||
|
, logs = List.concat [ httpLogs, logs, uLogs ]
|
||||||
|
, messages = [ httpU, u ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\( err, logs ) ->
|
||||||
|
{ error = err
|
||||||
|
, logs = List.append httpLogs logs
|
||||||
|
, messages = [ httpU ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add more attributes to the API plan.
|
||||||
|
-}
|
||||||
|
withAttributes : List (Attribute a) -> ApiPlan a -> ApiPlan a
|
||||||
|
withAttributes attrs f context =
|
||||||
|
f context
|
||||||
|
|> (\data ->
|
||||||
|
{ data
|
||||||
|
| attributes =
|
||||||
|
attrs
|
||||||
|
|> List.map (\attr -> attr data.context)
|
||||||
|
|> List.append data.attributes
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,203 @@
|
||||||
|
module Internal.Api.SendMessageEvent.Api exposing (Phantom, sendMessageEvent)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Send message event
|
||||||
|
|
||||||
|
This module helps send message events to rooms on the Matrix API.
|
||||||
|
|
||||||
|
@docs Phantom, sendMessageEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Leaks as L
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event to the Matrix room.
|
||||||
|
-}
|
||||||
|
sendMessageEvent : SendMessageEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
sendMessageEvent =
|
||||||
|
A.startWithVersion "r0.0.0" sendMessageEventV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.forVersion "r0.6.1" sendMessageEventV2
|
||||||
|
|> A.forVersion "v1.1" sendMessageEventV3
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for sending a message event
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventInput =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventInputV1 a =
|
||||||
|
{ a
|
||||||
|
| content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventOutputV1 =
|
||||||
|
{ eventId : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventOutputV2 =
|
||||||
|
{ eventId : String }
|
||||||
|
|
||||||
|
|
||||||
|
sendMessageEventV1 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendMessageEventV1 { content, eventType, roomId, transactionId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "send", eventType, transactionId ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendMessageEventV2 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendMessageEventV2 { content, eventType, roomId, transactionId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "send", eventType, transactionId ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendMessageEventV3 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendMessageEventV3 { content, eventType, roomId, transactionId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "send", eventType, transactionId ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SendMessageEventOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object2
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This endpoint is used to send a message event to a room. Message events allow access to historical events and pagination, making them suited for \"once-off\" activity in a room."
|
||||||
|
, "The body of the request should be the content object of the event; the fields in this object will vary depending on the type of event."
|
||||||
|
, "https://spec.matrix.org/legacy/r0.0.0/client_server.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
|
||||||
|
]
|
||||||
|
, init = always SendMessageEventOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = L.field
|
||||||
|
, toField = always Nothing
|
||||||
|
, description =
|
||||||
|
[ "The Elm SDK always expects objects to have at least two fields."
|
||||||
|
, "Otherwise, what's the point of hiding the value in an object?"
|
||||||
|
, "For this reason, this empty placeholder key will always be ignored."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder SendMessageEventOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.object2
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This endpoint is used to send a message event to a room. Message events allow access to historical events and pagination, making them suited for \"once-off\" activity in a room."
|
||||||
|
, "The body of the request should be the content object of the event; the fields in this object will vary depending on the type of event."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.6.1.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
|
||||||
|
]
|
||||||
|
, init = always SendMessageEventOutputV2
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = L.field
|
||||||
|
, toField = always Nothing
|
||||||
|
, description =
|
||||||
|
[ "The Elm SDK always expects objects to have at least two fields."
|
||||||
|
, "Otherwise, what's the point of hiding the value in an object?"
|
||||||
|
, "For this reason, this empty placeholder key will always be ignored."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,226 @@
|
||||||
|
module Internal.Api.Task exposing
|
||||||
|
( Task, run, Backpack
|
||||||
|
, sendMessageEvent
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# 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.
|
||||||
|
|
||||||
|
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, Backpack
|
||||||
|
|
||||||
|
|
||||||
|
## Tasks
|
||||||
|
|
||||||
|
@docs sendMessageEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.BaseUrl.Api
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Api.LoginWithUsernameAndPassword.Api
|
||||||
|
import Internal.Api.Now.Api
|
||||||
|
import Internal.Api.Request as Request
|
||||||
|
import Internal.Api.SendMessageEvent.Api
|
||||||
|
import Internal.Api.Versions.Api
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Internal.Values.Envelope exposing (EnvelopeUpdate(..))
|
||||||
|
import Internal.Values.Room exposing (RoomUpdate(..))
|
||||||
|
import Internal.Values.Vault exposing (VaultUpdate(..))
|
||||||
|
import Task
|
||||||
|
|
||||||
|
|
||||||
|
{-| A Backpack is the ultimate message type that gets sent back by the Elm
|
||||||
|
runtime, which can be accessed, viewed and inspected.
|
||||||
|
-}
|
||||||
|
type alias Backpack =
|
||||||
|
{ messages : List (EnvelopeUpdate VaultUpdate), logs : List Log }
|
||||||
|
|
||||||
|
|
||||||
|
{-| A Task is a task that is ready to be sent to the outside world.
|
||||||
|
-}
|
||||||
|
type alias Task =
|
||||||
|
C.TaskChain Never (EnvelopeUpdate VaultUpdate) {} {}
|
||||||
|
|
||||||
|
|
||||||
|
{-| An UnFinished Task that is used somewhere else in this module to write a
|
||||||
|
complete Task type.
|
||||||
|
-}
|
||||||
|
type alias UFTask a b =
|
||||||
|
C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an access token to talk to the Matrix API
|
||||||
|
-}
|
||||||
|
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
|
||||||
|
getAccessToken c =
|
||||||
|
case Context.fromApiFormat c of
|
||||||
|
context ->
|
||||||
|
case ( Context.mostPopularToken context, context.username, context.password ) of
|
||||||
|
( Just a, _, _ ) ->
|
||||||
|
C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.debug "Using cached access token from Vault" ]
|
||||||
|
, contextChange = Context.setAccessToken a
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
( Nothing, Just u, Just p ) ->
|
||||||
|
Internal.Api.LoginWithUsernameAndPassword.Api.loginWithUsernameAndPassword
|
||||||
|
{ deviceId = Context.fromApiFormat c |> .deviceId
|
||||||
|
, enableRefreshToken = Just True -- TODO: Turn this into a setting
|
||||||
|
, initialDeviceDisplayName = Nothing -- TODO: Turn this into a setting
|
||||||
|
, password = p
|
||||||
|
, username = u
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
( Nothing, Nothing, _ ) ->
|
||||||
|
C.fail Request.MissingUsername c
|
||||||
|
|
||||||
|
( Nothing, Just _, Nothing ) ->
|
||||||
|
C.fail Request.MissingPassword c
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the base URL where the Matrix API can be accessed
|
||||||
|
-}
|
||||||
|
getBaseUrl : UFTask a { a | baseUrl : () }
|
||||||
|
getBaseUrl c =
|
||||||
|
case Context.fromApiFormat c |> .baseUrl of
|
||||||
|
Just b ->
|
||||||
|
C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.debug "Using cached baseURL from Vault" ]
|
||||||
|
, contextChange = Context.setBaseUrl b
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Internal.Api.BaseUrl.Api.baseUrl
|
||||||
|
{ url = Context.fromApiFormat c |> .serverName }
|
||||||
|
c
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the current timestamp
|
||||||
|
-}
|
||||||
|
getNow : UFTask { a | baseUrl : () } { a | baseUrl : (), now : () }
|
||||||
|
getNow =
|
||||||
|
Internal.Api.Now.Api.getNow
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the versions that are potentially supported by the Matrix API
|
||||||
|
-}
|
||||||
|
getVersions : UFTask { a | baseUrl : () } { a | baseUrl : (), versions : () }
|
||||||
|
getVersions c =
|
||||||
|
case Context.fromApiFormat c |> .versions of
|
||||||
|
Just v ->
|
||||||
|
C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.debug "Using cached versions from Vault" ]
|
||||||
|
, contextChange = Context.setVersions v
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Internal.Api.Versions.Api.versions c
|
||||||
|
|
||||||
|
|
||||||
|
finishTask : UFTask {} b -> Task
|
||||||
|
finishTask uftask =
|
||||||
|
uftask
|
||||||
|
|> C.andThen
|
||||||
|
(C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = []
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> C.catchWith
|
||||||
|
(\e ->
|
||||||
|
case e of
|
||||||
|
Request.MissingPassword ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error "Cannot log in - password is missing" ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.MissingUsername ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error "Cannot log in - username is missing" ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.NoSupportedVersion ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error "No supported version is available to complete the API interaction." ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.ServerReturnsBadJSON t ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error ("The server returned invalid JSON: " ++ t) ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.ServerReturnsError name _ ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error ("The server returns an error: " ++ name) ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
{ messages = [] -- TODO: Maybe categorize errors?
|
||||||
|
, logs = [ log.warn "Encountered unhandled error" ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Establish a Task Chain context where the base URL and supported list of
|
||||||
|
versions are known.
|
||||||
|
-}
|
||||||
|
makeVB : UFTask a { a | baseUrl : (), versions : () }
|
||||||
|
makeVB =
|
||||||
|
C.andThen getVersions getBaseUrl
|
||||||
|
|
||||||
|
|
||||||
|
{-| Establish a Task Chain context where the base URL and supported list of
|
||||||
|
versions are known, and where an access token is available to make an
|
||||||
|
authenticated API call.
|
||||||
|
-}
|
||||||
|
makeVBA : UFTask a { a | accessToken : (), baseUrl : (), now : (), versions : () }
|
||||||
|
makeVBA =
|
||||||
|
makeVB
|
||||||
|
|> C.andThen getNow
|
||||||
|
|> C.andThen getAccessToken
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event to a room.
|
||||||
|
-}
|
||||||
|
sendMessageEvent : { content : Json.Value, eventType : String, roomId : String, transactionId : String } -> Task
|
||||||
|
sendMessageEvent input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SendMessageEvent.Api.sendMessageEvent input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform a completed task into a Cmd.
|
||||||
|
-}
|
||||||
|
run : (Backpack -> msg) -> Task -> APIContext {} -> Cmd msg
|
||||||
|
run toMsg task context =
|
||||||
|
context
|
||||||
|
|> C.toTask task
|
||||||
|
|> Task.perform toMsg
|
|
@ -0,0 +1,91 @@
|
||||||
|
module Internal.Api.Versions.Api exposing (versions, Phantom)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Versions
|
||||||
|
|
||||||
|
Ask the Matrix API which versions it supports.
|
||||||
|
|
||||||
|
@docs versions, Phantom
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Dict
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (Versions)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Set
|
||||||
|
|
||||||
|
|
||||||
|
{-| Task chain to ask which spec versions the Matrix API supports.
|
||||||
|
-}
|
||||||
|
versions : A.TaskChain (Phantom ph) (Phantom { ph | versions : () })
|
||||||
|
versions =
|
||||||
|
A.request
|
||||||
|
{ attributes = []
|
||||||
|
, coder = versionsCoder
|
||||||
|
, contextChange = Context.setVersions
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "versions" ]
|
||||||
|
, toUpdate = \v -> ( E.SetVersions v, [] )
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for asking the server's available spec versions
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
versionsCoder : Json.Coder Versions
|
||||||
|
versionsCoder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Versions"
|
||||||
|
, description =
|
||||||
|
[ "Gets the versions of the specification supported by the server."
|
||||||
|
, "Values will take the form vX.Y or rX.Y.Z in historical cases. See the Specification Versioning for more information."
|
||||||
|
, "The server may additionally advertise experimental features it supports through unstable_features. These features should be namespaced and may optionally include version information within their name if desired. Features listed here are not for optionally toggling parts of the Matrix specification and should only be used to advertise support for a feature which has not yet landed in the spec. For example, a feature currently undergoing the proposal process may appear here and eventually be taken off this list once the feature lands in the spec and the server deems it reasonable to do so. Servers can choose to enable some features only for some users, so clients should include authentication in the request to get all the features available for the logged-in user. If no authentication is provided, the server should only return the features available to all users. Servers may wish to keep advertising features here after they’ve been released into the spec to give clients a chance to upgrade appropriately. Additionally, clients should avoid using unstable features in their stable releases."
|
||||||
|
]
|
||||||
|
, init = Versions
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "versions"
|
||||||
|
, toField = .versions
|
||||||
|
, description =
|
||||||
|
[ "The supported versions."
|
||||||
|
]
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "unstable_features"
|
||||||
|
, toField = .unstableFeatures
|
||||||
|
, description =
|
||||||
|
[ "Experimental features the server supports. Features not listed here, or the lack of this property all together, indicate that a feature is not supported."
|
||||||
|
]
|
||||||
|
, coder =
|
||||||
|
Json.bool
|
||||||
|
|> Json.slowDict
|
||||||
|
|> Json.map
|
||||||
|
{ name = "Dict to set"
|
||||||
|
, description =
|
||||||
|
[ "Turn a dictionary of supported values into a set that contains only supported values"
|
||||||
|
]
|
||||||
|
, back = Set.foldl (\k d -> Dict.insert k True d) Dict.empty
|
||||||
|
, forth =
|
||||||
|
Dict.foldl
|
||||||
|
(\k v s ->
|
||||||
|
if v then
|
||||||
|
Set.insert k s
|
||||||
|
|
||||||
|
else
|
||||||
|
s
|
||||||
|
)
|
||||||
|
Set.empty
|
||||||
|
}
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
, defaultToString = always "{}"
|
||||||
|
}
|
||||||
|
)
|
|
@ -1,5 +1,5 @@
|
||||||
module Internal.Config.Leaks exposing
|
module Internal.Config.Leaks exposing
|
||||||
( accessToken, baseUrl, transaction, versions
|
( accessToken, baseUrl, field, transaction, versions
|
||||||
, allLeaks
|
, allLeaks
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -30,7 +30,7 @@ know 100% sure that the value isn't `Nothing`.
|
||||||
|
|
||||||
Just 5 |> Maybe.withDefault Leaks.number
|
Just 5 |> Maybe.withDefault Leaks.number
|
||||||
|
|
||||||
@docs accessToken, baseUrl, transaction, versions
|
@docs accessToken, baseUrl, field, transaction, versions
|
||||||
|
|
||||||
For safety purposes, all leaking values are stored in the following value:
|
For safety purposes, all leaking values are stored in the following value:
|
||||||
|
|
||||||
|
@ -52,14 +52,15 @@ accessToken =
|
||||||
-}
|
-}
|
||||||
allLeaks : Set String
|
allLeaks : Set String
|
||||||
allLeaks =
|
allLeaks =
|
||||||
Set.union
|
Set.fromList
|
||||||
(Set.fromList versions)
|
[ accessToken
|
||||||
(Set.fromList
|
, baseUrl
|
||||||
[ accessToken
|
, field
|
||||||
, baseUrl
|
, transaction
|
||||||
, transaction
|
, "elm-sdk-placeholder-versions-leaks" -- Old leaking value
|
||||||
]
|
]
|
||||||
)
|
|> Set.union (Set.fromList versions.versions)
|
||||||
|
|> Set.union versions.unstableFeatures
|
||||||
|
|
||||||
|
|
||||||
{-| Placeholder base URL.
|
{-| Placeholder base URL.
|
||||||
|
@ -69,6 +70,13 @@ baseUrl =
|
||||||
"elm-sdk-placeholder-baseurl-leaks.example.org"
|
"elm-sdk-placeholder-baseurl-leaks.example.org"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder JSON field.
|
||||||
|
-}
|
||||||
|
field : String
|
||||||
|
field =
|
||||||
|
"elm-sdk-placeholder-json-field"
|
||||||
|
|
||||||
|
|
||||||
{-| Placeholder transaction id.
|
{-| Placeholder transaction id.
|
||||||
-}
|
-}
|
||||||
transaction : String
|
transaction : String
|
||||||
|
@ -78,6 +86,8 @@ transaction =
|
||||||
|
|
||||||
{-| Placeholder versions list.
|
{-| Placeholder versions list.
|
||||||
-}
|
-}
|
||||||
versions : List String
|
versions : { versions : List String, unstableFeatures : Set String }
|
||||||
versions =
|
versions =
|
||||||
[ "elm-sdk-placeholder-versions-leaks" ]
|
{ versions = [ "elm-sdk-placeholder-versions-versions-leaks" ]
|
||||||
|
, unstableFeatures = Set.singleton "elm-sdk-placeholder-versions-unstableFeatures-leaks"
|
||||||
|
}
|
||||||
|
|
|
@ -112,7 +112,8 @@ decodedDictSize from to =
|
||||||
{-| Documentation used for all functions and data types in JSON coders
|
{-| Documentation used for all functions and data types in JSON coders
|
||||||
-}
|
-}
|
||||||
docs :
|
docs :
|
||||||
{ context : TypeDocs
|
{ accessToken : TypeDocs
|
||||||
|
, context : TypeDocs
|
||||||
, envelope : TypeDocs
|
, envelope : TypeDocs
|
||||||
, event : TypeDocs
|
, event : TypeDocs
|
||||||
, hashdict : TypeDocs
|
, hashdict : TypeDocs
|
||||||
|
@ -127,9 +128,16 @@ docs :
|
||||||
, timelineFilter : TypeDocs
|
, timelineFilter : TypeDocs
|
||||||
, unsigned : TypeDocs
|
, unsigned : TypeDocs
|
||||||
, vault : TypeDocs
|
, vault : TypeDocs
|
||||||
|
, versions : TypeDocs
|
||||||
}
|
}
|
||||||
docs =
|
docs =
|
||||||
{ context =
|
{ accessToken =
|
||||||
|
{ name = "Access Token"
|
||||||
|
, description =
|
||||||
|
[ "The Access Token type stores information about an access token - its value, when it expires, and how one may get a new access token when the current value expires."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, context =
|
||||||
{ name = "Context"
|
{ name = "Context"
|
||||||
, description =
|
, description =
|
||||||
[ "The Context is the set of variables that the user (mostly) cannot control."
|
[ "The Context is the set of variables that the user (mostly) cannot control."
|
||||||
|
@ -223,6 +231,12 @@ docs =
|
||||||
[ "Main type storing all relevant information from the Matrix API."
|
[ "Main type storing all relevant information from the Matrix API."
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
, versions =
|
||||||
|
{ name = "Versions"
|
||||||
|
, description =
|
||||||
|
[ "Versions type describing the supported spec versions and MSC properties."
|
||||||
|
]
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -244,12 +258,24 @@ failures =
|
||||||
what they do and what they are for.
|
what they do and what they are for.
|
||||||
-}
|
-}
|
||||||
fields :
|
fields :
|
||||||
{ context :
|
{ accessToken :
|
||||||
|
{ created : Desc
|
||||||
|
, expiryMs : Desc
|
||||||
|
, lastUsed : Desc
|
||||||
|
, refresh : Desc
|
||||||
|
, value : Desc
|
||||||
|
}
|
||||||
|
, context :
|
||||||
{ accessToken : Desc
|
{ accessToken : Desc
|
||||||
, baseUrl : Desc
|
, baseUrl : Desc
|
||||||
|
, deviceId : Desc
|
||||||
|
, experimental : Desc
|
||||||
|
, now : Desc
|
||||||
, password : Desc
|
, password : Desc
|
||||||
, refreshToken : Desc
|
, refreshToken : Desc
|
||||||
, username : Desc
|
, username : Desc
|
||||||
|
, serverName : Desc
|
||||||
|
, suggestedAccessToken : Desc
|
||||||
, transaction : Desc
|
, transaction : Desc
|
||||||
, versions : Desc
|
, versions : Desc
|
||||||
}
|
}
|
||||||
|
@ -319,25 +345,58 @@ fields :
|
||||||
, vault :
|
, vault :
|
||||||
{ accountData : Desc
|
{ accountData : Desc
|
||||||
, rooms : Desc
|
, rooms : Desc
|
||||||
|
, user : Desc
|
||||||
|
}
|
||||||
|
, versions :
|
||||||
|
{ unstableFeatures : Desc
|
||||||
|
, versions : Desc
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
fields =
|
fields =
|
||||||
{ context =
|
{ accessToken =
|
||||||
|
{ created =
|
||||||
|
[ "Timestamp of when the access token was received." ]
|
||||||
|
, expiryMs =
|
||||||
|
[ "Given time in milliseconds of when the access token might expire." ]
|
||||||
|
, lastUsed =
|
||||||
|
[ "Timestamp of when the access token was last used." ]
|
||||||
|
, refresh =
|
||||||
|
[ "Refresh token used to gain a new access token." ]
|
||||||
|
, value =
|
||||||
|
[ "Secret access token value." ]
|
||||||
|
}
|
||||||
|
, context =
|
||||||
{ accessToken =
|
{ accessToken =
|
||||||
[ "The access token used for authentication with the Matrix server."
|
[ "The access token used for authentication with the Matrix server."
|
||||||
]
|
]
|
||||||
, baseUrl =
|
, baseUrl =
|
||||||
[ "The base URL of the Matrix server."
|
[ "The base URL of the Matrix server."
|
||||||
]
|
]
|
||||||
|
, deviceId =
|
||||||
|
[ "The reported device ID according to the API."
|
||||||
|
]
|
||||||
|
, experimental =
|
||||||
|
[ "Experimental features supported by the homeserver."
|
||||||
|
]
|
||||||
|
, now =
|
||||||
|
[ "The most recently found timestamp."
|
||||||
|
]
|
||||||
, password =
|
, password =
|
||||||
[ "The user's password for authentication purposes."
|
[ "The user's password for authentication purposes."
|
||||||
]
|
]
|
||||||
, refreshToken =
|
, refreshToken =
|
||||||
[ "The token used to obtain a new access token upon expiration of the current access token."
|
[ "The token used to obtain a new access token upon expiration of the current access token."
|
||||||
]
|
]
|
||||||
|
, suggestedAccessToken =
|
||||||
|
[ "An access token provided with no context by the user."
|
||||||
|
]
|
||||||
, username =
|
, username =
|
||||||
[ "The username of the Matrix account."
|
[ "The username of the Matrix account."
|
||||||
]
|
]
|
||||||
|
, serverName =
|
||||||
|
[ "The homeserver that the user is trying to communicate with."
|
||||||
|
, "This name doesn't need to be the address. For example, the name might be `matrix.org` even though the homeserver is at a different location."
|
||||||
|
]
|
||||||
, transaction =
|
, transaction =
|
||||||
[ "A unique identifier for a transaction initiated by the user."
|
[ "A unique identifier for a transaction initiated by the user."
|
||||||
]
|
]
|
||||||
|
@ -501,6 +560,16 @@ fields =
|
||||||
, rooms =
|
, rooms =
|
||||||
[ "Directory of joined rooms that the user is a member of."
|
[ "Directory of joined rooms that the user is a member of."
|
||||||
]
|
]
|
||||||
|
, user =
|
||||||
|
[ "User that the Vault is logging in as."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, versions =
|
||||||
|
{ unstableFeatures =
|
||||||
|
[ "Unstable features such as experimental MSCs that are supported by a homeserver."
|
||||||
|
]
|
||||||
|
, versions =
|
||||||
|
[ "Spec versions supported by a homeserver." ]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -535,15 +604,54 @@ leakingValueFound leaking_value =
|
||||||
happened. Most of these unexpected results, are taken account of by the Elm SDK,
|
happened. Most of these unexpected results, are taken account of by the Elm SDK,
|
||||||
but logged so that the programmer can do something about it.
|
but logged so that the programmer can do something about it.
|
||||||
-}
|
-}
|
||||||
logs : { keyIsNotAnInt : String -> String }
|
logs :
|
||||||
|
{ baseUrlFound : String -> String -> String
|
||||||
|
, getEventId : String -> String
|
||||||
|
, getNow : Int -> String
|
||||||
|
, httpRequest : String -> String -> String
|
||||||
|
, invitedUser : String -> String -> String
|
||||||
|
, keyIsNotAnInt : String -> String
|
||||||
|
, loggedInAs : String -> String
|
||||||
|
, sendEvent : Maybe String -> String
|
||||||
|
, serverReturnedInvalidJSON : String -> String
|
||||||
|
, serverReturnedUnknownJSON : String -> String
|
||||||
|
}
|
||||||
logs =
|
logs =
|
||||||
{ keyIsNotAnInt =
|
{ baseUrlFound =
|
||||||
|
\url baseUrl ->
|
||||||
|
String.concat [ "Found baseURL of ", url, " at address ", baseUrl ]
|
||||||
|
, getEventId = (++) "Received event with id = "
|
||||||
|
, getNow =
|
||||||
|
\now ->
|
||||||
|
String.concat
|
||||||
|
[ "Identified current time at Unix time "
|
||||||
|
, String.fromInt now
|
||||||
|
]
|
||||||
|
, httpRequest =
|
||||||
|
\method url -> String.concat [ "Matrix HTTP: ", method, " ", url ]
|
||||||
|
, invitedUser =
|
||||||
|
\userId roomId ->
|
||||||
|
String.concat [ "Invited user ", userId, " to room ", roomId ]
|
||||||
|
, keyIsNotAnInt =
|
||||||
\key ->
|
\key ->
|
||||||
String.concat
|
String.concat
|
||||||
[ "Encountered a key `"
|
[ "Encountered a key `"
|
||||||
, key
|
, key
|
||||||
, "` that cannot be converted to an Int"
|
, "` that cannot be converted to an Int"
|
||||||
]
|
]
|
||||||
|
, loggedInAs =
|
||||||
|
\username ->
|
||||||
|
String.concat [ "Successfully logged in as user ", username ]
|
||||||
|
, sendEvent =
|
||||||
|
\eventId ->
|
||||||
|
case eventId of
|
||||||
|
Just e ->
|
||||||
|
"Sent event, received event id " ++ e
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
"Sent event, event id not known - make sure to check transaction id"
|
||||||
|
, serverReturnedInvalidJSON = (++) "The server returned invalid JSON: "
|
||||||
|
, serverReturnedUnknownJSON = (++) "The server returned JSON that doesn't seem to live up to spec rules: "
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -50,8 +50,6 @@ for interacting with the Matrix API.
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
import Internal.Grammar.UserId as U
|
import Internal.Grammar.UserId as U
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Json.Decode as D
|
|
||||||
import Json.Encode as E
|
|
||||||
import Set exposing (Set)
|
import Set exposing (Set)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
module Internal.Tools.Timestamp exposing
|
module Internal.Tools.Timestamp exposing
|
||||||
( Timestamp
|
( Timestamp
|
||||||
|
, add, toMs
|
||||||
, coder, encode, decoder
|
, coder, encode, decoder
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -12,6 +13,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways.
|
||||||
@docs Timestamp
|
@docs Timestamp
|
||||||
|
|
||||||
|
|
||||||
|
## Calculate
|
||||||
|
|
||||||
|
@docs add, toMs
|
||||||
|
|
||||||
|
|
||||||
## JSON coders
|
## JSON coders
|
||||||
|
|
||||||
@docs coder, encode, decoder
|
@docs coder, encode, decoder
|
||||||
|
@ -28,6 +34,15 @@ type alias Timestamp =
|
||||||
Time.Posix
|
Time.Posix
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a given number of miliseconds to a given Timestamp.
|
||||||
|
-}
|
||||||
|
add : Int -> Timestamp -> Timestamp
|
||||||
|
add m =
|
||||||
|
Time.posixToMillis
|
||||||
|
>> (+) m
|
||||||
|
>> Time.millisToPosix
|
||||||
|
|
||||||
|
|
||||||
{-| Create a Json coder
|
{-| Create a Json coder
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Timestamp
|
coder : Json.Coder Timestamp
|
||||||
|
@ -55,3 +70,10 @@ encode =
|
||||||
decoder : Json.Decoder Timestamp
|
decoder : Json.Decoder Timestamp
|
||||||
decoder =
|
decoder =
|
||||||
Json.decode coder
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Turn a Timestamp into a number of miliseconds
|
||||||
|
-}
|
||||||
|
toMs : Timestamp -> Int
|
||||||
|
toMs =
|
||||||
|
Time.posixToMillis
|
||||||
|
|
|
@ -1,10 +1,13 @@
|
||||||
module Internal.Values.Context exposing
|
module Internal.Values.Context exposing
|
||||||
( Context, init, coder, encode, decoder
|
( Context, AccessToken, init, coder, encode, decoder
|
||||||
, APIContext, apiFormat
|
, mostPopularToken
|
||||||
|
, APIContext, apiFormat, fromApiFormat
|
||||||
, setAccessToken, getAccessToken
|
, setAccessToken, getAccessToken
|
||||||
, setBaseUrl, getBaseUrl
|
, setBaseUrl, getBaseUrl
|
||||||
|
, setNow, getNow
|
||||||
, setTransaction, getTransaction
|
, setTransaction, getTransaction
|
||||||
, setVersions, getVersions
|
, Versions, setVersions, getVersions
|
||||||
|
, reset
|
||||||
)
|
)
|
||||||
|
|
||||||
{-| The Context is the set of variables that the user (mostly) cannot control.
|
{-| The Context is the set of variables that the user (mostly) cannot control.
|
||||||
|
@ -14,7 +17,11 @@ the Matrix API.
|
||||||
|
|
||||||
## Context
|
## Context
|
||||||
|
|
||||||
@docs Context, init, coder, encode, decoder
|
@docs Context, AccessToken, init, coder, encode, decoder
|
||||||
|
|
||||||
|
Some functions are present to influence the general Context type itself.
|
||||||
|
|
||||||
|
@docs mostPopularToken
|
||||||
|
|
||||||
|
|
||||||
## APIContext
|
## APIContext
|
||||||
|
@ -22,7 +29,7 @@ the Matrix API.
|
||||||
Once the API starts needing information, that's when we use the APIContext type
|
Once the API starts needing information, that's when we use the APIContext type
|
||||||
to build the right environment for the API communication to work with.
|
to build the right environment for the API communication to work with.
|
||||||
|
|
||||||
@docs APIContext, apiFormat
|
@docs APIContext, apiFormat, fromApiFormat
|
||||||
|
|
||||||
Once the APIContext is ready, there's helper functions for each piece of
|
Once the APIContext is ready, there's helper functions for each piece of
|
||||||
information that can be inserted.
|
information that can be inserted.
|
||||||
|
@ -38,6 +45,11 @@ information that can be inserted.
|
||||||
@docs setBaseUrl, getBaseUrl
|
@docs setBaseUrl, getBaseUrl
|
||||||
|
|
||||||
|
|
||||||
|
### Timestamp
|
||||||
|
|
||||||
|
@docs setNow, getNow
|
||||||
|
|
||||||
|
|
||||||
### Transaction id
|
### Transaction id
|
||||||
|
|
||||||
@docs setTransaction, getTransaction
|
@docs setTransaction, getTransaction
|
||||||
|
@ -45,26 +57,52 @@ information that can be inserted.
|
||||||
|
|
||||||
### Versions
|
### Versions
|
||||||
|
|
||||||
@docs setVersions, getVersions
|
@docs Versions, setVersions, getVersions
|
||||||
|
|
||||||
|
|
||||||
|
### Reset
|
||||||
|
|
||||||
|
@docs reset
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Internal.Config.Leaks as L
|
import Internal.Config.Leaks as L
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import Json.Encode as E
|
||||||
|
import Set exposing (Set)
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Access Token is a combination of access tokens, values and refresh
|
||||||
|
tokens that contain and summarizes all properties of a known access token.
|
||||||
|
-}
|
||||||
|
type alias AccessToken =
|
||||||
|
{ created : Timestamp
|
||||||
|
, expiryMs : Maybe Int
|
||||||
|
, lastUsed : Timestamp
|
||||||
|
, refresh : Maybe String
|
||||||
|
, value : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| The Context type stores all the information in the Vault. This data type is
|
{-| The Context type stores all the information in the Vault. This data type is
|
||||||
static and hence can be passed on easily.
|
static and hence can be passed on easily.
|
||||||
-}
|
-}
|
||||||
type alias Context =
|
type alias Context =
|
||||||
{ accessToken : Maybe String
|
{ accessTokens : Hashdict AccessToken
|
||||||
, baseUrl : Maybe String
|
, baseUrl : Maybe String
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, now : Maybe Timestamp
|
||||||
, password : Maybe String
|
, password : Maybe String
|
||||||
, refreshToken : Maybe String
|
, refreshToken : Maybe String
|
||||||
, username : Maybe String
|
, serverName : String
|
||||||
|
, suggestedAccessToken : Maybe String
|
||||||
, transaction : Maybe String
|
, transaction : Maybe String
|
||||||
, versions : Maybe (List String)
|
, username : Maybe String
|
||||||
|
, versions : Maybe Versions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -77,38 +115,53 @@ type APIContext ph
|
||||||
{ accessToken : String
|
{ accessToken : String
|
||||||
, baseUrl : String
|
, baseUrl : String
|
||||||
, context : Context
|
, context : Context
|
||||||
|
, now : Timestamp
|
||||||
, transaction : String
|
, transaction : String
|
||||||
, versions : List String
|
, versions : Versions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Versions =
|
||||||
|
{ versions : List String, unstableFeatures : Set String }
|
||||||
|
|
||||||
|
|
||||||
{-| Create an unformatted APIContext type.
|
{-| Create an unformatted APIContext type.
|
||||||
-}
|
-}
|
||||||
apiFormat : Context -> APIContext {}
|
apiFormat : Context -> APIContext {}
|
||||||
apiFormat context =
|
apiFormat context =
|
||||||
APIContext
|
APIContext
|
||||||
{ accessToken = context.accessToken |> Maybe.withDefault L.accessToken
|
{ accessToken =
|
||||||
|
mostPopularToken context |> Maybe.withDefault L.accessToken
|
||||||
, baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
|
, baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
|
||||||
, context = context
|
, context = context
|
||||||
|
, now = context.now |> Maybe.withDefault (Time.millisToPosix 0)
|
||||||
, transaction = context.transaction |> Maybe.withDefault L.transaction
|
, transaction = context.transaction |> Maybe.withDefault L.transaction
|
||||||
, versions = context.versions |> Maybe.withDefault L.versions
|
, versions = context.versions |> Maybe.withDefault L.versions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the original context that contains all values from before any were
|
||||||
|
gotten from the Matrix API.
|
||||||
|
-}
|
||||||
|
fromApiFormat : APIContext a -> Context
|
||||||
|
fromApiFormat (APIContext c) =
|
||||||
|
c.context
|
||||||
|
|
||||||
|
|
||||||
{-| Define how a Context can be encoded to and decoded from a JSON object.
|
{-| Define how a Context can be encoded to and decoded from a JSON object.
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Context
|
coder : Json.Coder Context
|
||||||
coder =
|
coder =
|
||||||
Json.object7
|
Json.object11
|
||||||
{ name = Text.docs.context.name
|
{ name = Text.docs.context.name
|
||||||
, description = Text.docs.context.description
|
, description = Text.docs.context.description
|
||||||
, init = Context
|
, init = Context
|
||||||
}
|
}
|
||||||
(Json.field.optional.value
|
(Json.field.required
|
||||||
{ fieldName = "accessToken"
|
{ fieldName = "accessTokens"
|
||||||
, toField = .accessToken
|
, toField = .accessTokens
|
||||||
, description = Text.fields.context.accessToken
|
, description = Text.fields.context.accessToken
|
||||||
, coder = Json.string
|
, coder = Hashdict.coder .value coderAccessToken
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
|
@ -118,6 +171,20 @@ coder =
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "deviceId"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description = Text.fields.context.deviceId
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "now"
|
||||||
|
, toField = .now
|
||||||
|
, description = Text.fields.context.now
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
{ fieldName = "password"
|
{ fieldName = "password"
|
||||||
, toField = .password
|
, toField = .password
|
||||||
|
@ -132,10 +199,17 @@ coder =
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "serverName"
|
||||||
|
, toField = .serverName
|
||||||
|
, description = Text.fields.context.serverName
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
{ fieldName = "username"
|
{ fieldName = "suggestedAccessToken"
|
||||||
, toField = .username
|
, toField = always Nothing -- Do not save
|
||||||
, description = Text.fields.context.username
|
, description = Text.fields.context.suggestedAccessToken
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
@ -146,11 +220,64 @@ coder =
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "username"
|
||||||
|
, toField = .username
|
||||||
|
, description = Text.fields.context.username
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
{ fieldName = "versions"
|
{ fieldName = "versions"
|
||||||
, toField = .versions
|
, toField = .versions
|
||||||
, description = Text.fields.context.versions
|
, description = Text.fields.context.versions
|
||||||
, coder = Json.list Json.string
|
, coder = versionsCoder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| JSON coder for an Access Token.
|
||||||
|
-}
|
||||||
|
coderAccessToken : Json.Coder AccessToken
|
||||||
|
coderAccessToken =
|
||||||
|
Json.object5
|
||||||
|
{ name = Text.docs.accessToken.name
|
||||||
|
, description = Text.docs.accessToken.description
|
||||||
|
, init = AccessToken
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "created"
|
||||||
|
, toField = .created
|
||||||
|
, description = Text.fields.accessToken.created
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "expiryMs"
|
||||||
|
, toField = .expiryMs
|
||||||
|
, description = Text.fields.accessToken.expiryMs
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "lastUsed"
|
||||||
|
, toField = .lastUsed
|
||||||
|
, description = Text.fields.accessToken.lastUsed
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh"
|
||||||
|
, toField = .refresh
|
||||||
|
, description = Text.fields.accessToken.refresh
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "value"
|
||||||
|
, toField = .value
|
||||||
|
, description = Text.fields.accessToken.value
|
||||||
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -171,18 +298,57 @@ encode =
|
||||||
|
|
||||||
{-| A basic, untouched version of the Context, containing no information.
|
{-| A basic, untouched version of the Context, containing no information.
|
||||||
-}
|
-}
|
||||||
init : Context
|
init : String -> Context
|
||||||
init =
|
init sn =
|
||||||
{ accessToken = Nothing
|
{ accessTokens = Hashdict.empty .value
|
||||||
, baseUrl = Nothing
|
, baseUrl = Nothing
|
||||||
|
, deviceId = Nothing
|
||||||
|
, now = Nothing
|
||||||
, refreshToken = Nothing
|
, refreshToken = Nothing
|
||||||
, password = Nothing
|
, password = Nothing
|
||||||
, username = Nothing
|
, serverName = sn
|
||||||
|
, suggestedAccessToken = Nothing
|
||||||
, transaction = Nothing
|
, transaction = Nothing
|
||||||
|
, username = Nothing
|
||||||
, versions = Nothing
|
, versions = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the most popular access token available, if any.
|
||||||
|
-}
|
||||||
|
mostPopularToken : Context -> Maybe String
|
||||||
|
mostPopularToken c =
|
||||||
|
case c.suggestedAccessToken of
|
||||||
|
Just _ ->
|
||||||
|
c.suggestedAccessToken
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
c.accessTokens
|
||||||
|
|> Hashdict.values
|
||||||
|
|> List.sortBy
|
||||||
|
(\token ->
|
||||||
|
case token.expiryMs of
|
||||||
|
Nothing ->
|
||||||
|
( 0, Timestamp.toMs token.created )
|
||||||
|
|
||||||
|
Just e ->
|
||||||
|
( 1
|
||||||
|
, token.created
|
||||||
|
|> Timestamp.add e
|
||||||
|
|> Timestamp.toMs
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> List.head
|
||||||
|
|> Maybe.map .value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Reset the phantom type of the Context, effectively forgetting all values.
|
||||||
|
-}
|
||||||
|
reset : APIContext a -> APIContext {}
|
||||||
|
reset (APIContext c) =
|
||||||
|
APIContext c
|
||||||
|
|
||||||
|
|
||||||
{-| Get an inserted access token.
|
{-| Get an inserted access token.
|
||||||
-}
|
-}
|
||||||
getAccessToken : APIContext { a | accessToken : () } -> String
|
getAccessToken : APIContext { a | accessToken : () } -> String
|
||||||
|
@ -211,6 +377,20 @@ setBaseUrl value (APIContext c) =
|
||||||
APIContext { c | baseUrl = value }
|
APIContext { c | baseUrl = value }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an inserted timestamp.
|
||||||
|
-}
|
||||||
|
getNow : APIContext { a | now : () } -> Timestamp
|
||||||
|
getNow (APIContext c) =
|
||||||
|
c.now
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a Timestamp into the APIContext.
|
||||||
|
-}
|
||||||
|
setNow : Timestamp -> APIContext a -> APIContext { a | now : () }
|
||||||
|
setNow t (APIContext c) =
|
||||||
|
APIContext { c | now = t }
|
||||||
|
|
||||||
|
|
||||||
{-| Get an inserted transaction id.
|
{-| Get an inserted transaction id.
|
||||||
-}
|
-}
|
||||||
getTransaction : APIContext { a | transaction : () } -> String
|
getTransaction : APIContext { a | transaction : () } -> String
|
||||||
|
@ -227,13 +407,38 @@ setTransaction value (APIContext c) =
|
||||||
|
|
||||||
{-| Get an inserted versions list.
|
{-| Get an inserted versions list.
|
||||||
-}
|
-}
|
||||||
getVersions : APIContext { a | versions : () } -> List String
|
getVersions : APIContext { a | versions : () } -> Versions
|
||||||
getVersions (APIContext c) =
|
getVersions (APIContext c) =
|
||||||
c.versions
|
c.versions
|
||||||
|
|
||||||
|
|
||||||
{-| Insert a versions list into the APIContext.
|
{-| 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) =
|
setVersions value (APIContext c) =
|
||||||
APIContext { c | versions = value }
|
APIContext { c | versions = value }
|
||||||
|
|
||||||
|
|
||||||
|
versionsCoder : Json.Coder Versions
|
||||||
|
versionsCoder =
|
||||||
|
Json.object2
|
||||||
|
{ name = Text.docs.versions.name
|
||||||
|
, description = Text.docs.versions.description
|
||||||
|
, init = Versions
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "versions"
|
||||||
|
, toField = .versions
|
||||||
|
, description = Text.fields.versions.versions
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "unstableFeatures"
|
||||||
|
, toField = .unstableFeatures
|
||||||
|
, description = Text.fields.versions.unstableFeatures
|
||||||
|
, coder = Json.set Json.string
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
, defaultToString = Json.encode (Json.set Json.string) >> E.encode 0
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
|
@ -48,9 +48,13 @@ settings that can be adjusted manually.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Request as Request
|
||||||
|
import Internal.Config.Log exposing (Log)
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Hashdict as Hashdict
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Context as Context exposing (Context)
|
import Internal.Tools.Timestamp exposing (Timestamp)
|
||||||
|
import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
|
||||||
import Internal.Values.Settings as Settings
|
import Internal.Values.Settings as Settings
|
||||||
|
|
||||||
|
|
||||||
|
@ -70,10 +74,16 @@ type alias Envelope a =
|
||||||
-}
|
-}
|
||||||
type EnvelopeUpdate a
|
type EnvelopeUpdate a
|
||||||
= ContentUpdate a
|
= ContentUpdate a
|
||||||
|
| HttpRequest (Request.Request ( Request.Error, List Log ) ( EnvelopeUpdate a, List Log ))
|
||||||
| More (List (EnvelopeUpdate a))
|
| More (List (EnvelopeUpdate a))
|
||||||
| SetAccessToken String
|
| Optional (Maybe (EnvelopeUpdate a))
|
||||||
|
| RemoveAccessToken String
|
||||||
|
| SetAccessToken AccessToken
|
||||||
|
| SetBaseUrl String
|
||||||
|
| SetDeviceId String
|
||||||
|
| SetNow Timestamp
|
||||||
| SetRefreshToken String
|
| SetRefreshToken String
|
||||||
| SetVersions (List String)
|
| SetVersions Versions
|
||||||
|
|
||||||
|
|
||||||
{-| Settings value from
|
{-| Settings value from
|
||||||
|
@ -175,10 +185,10 @@ getContent =
|
||||||
{-| Create a new enveloped data type. All settings are set to default values
|
{-| Create a new enveloped data type. All settings are set to default values
|
||||||
from the [Internal.Config.Default](Internal-Config-Default) module.
|
from the [Internal.Config.Default](Internal-Config-Default) module.
|
||||||
-}
|
-}
|
||||||
init : a -> Envelope a
|
init : { serverName : String, content : a } -> Envelope a
|
||||||
init x =
|
init data =
|
||||||
{ content = x
|
{ content = data.content
|
||||||
, context = Context.init
|
, context = Context.init data.serverName
|
||||||
, settings = Settings.init
|
, settings = Settings.init
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -286,11 +296,32 @@ update updateContent eu ({ context } as data) =
|
||||||
ContentUpdate v ->
|
ContentUpdate v ->
|
||||||
{ data | content = updateContent v data.content }
|
{ data | content = updateContent v data.content }
|
||||||
|
|
||||||
|
HttpRequest _ ->
|
||||||
|
data
|
||||||
|
|
||||||
More items ->
|
More items ->
|
||||||
List.foldl (update updateContent) data items
|
List.foldl (update updateContent) data items
|
||||||
|
|
||||||
|
Optional (Just u) ->
|
||||||
|
update updateContent u data
|
||||||
|
|
||||||
|
Optional Nothing ->
|
||||||
|
data
|
||||||
|
|
||||||
|
RemoveAccessToken token ->
|
||||||
|
{ data | context = { context | accessTokens = Hashdict.removeKey token context.accessTokens } }
|
||||||
|
|
||||||
SetAccessToken a ->
|
SetAccessToken a ->
|
||||||
{ data | context = { context | accessToken = Just a } }
|
{ data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } }
|
||||||
|
|
||||||
|
SetBaseUrl b ->
|
||||||
|
{ data | context = { context | baseUrl = Just b } }
|
||||||
|
|
||||||
|
SetDeviceId d ->
|
||||||
|
{ data | context = { context | deviceId = Just d } }
|
||||||
|
|
||||||
|
SetNow n ->
|
||||||
|
{ data | context = { context | now = Just n } }
|
||||||
|
|
||||||
SetRefreshToken r ->
|
SetRefreshToken r ->
|
||||||
{ data | context = { context | refreshToken = Just r } }
|
{ data | context = { context | refreshToken = Just r } }
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Internal.Values.Room exposing
|
module Internal.Values.Room exposing
|
||||||
( Room, init
|
( Room, init
|
||||||
, RoomUpdate, update
|
, RoomUpdate(..), update
|
||||||
, Batch, addBatch, addSync, addEvents, mostRecentEvents
|
, Batch, addBatch, addSync, addEvents, mostRecentEvents
|
||||||
, getAccountData, setAccountData
|
, getAccountData, setAccountData
|
||||||
, coder, encode, decode
|
, coder, encode, decode
|
||||||
|
@ -56,6 +56,7 @@ import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Event as Event exposing (Event)
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
||||||
import Internal.Values.Timeline as Timeline exposing (Timeline)
|
import Internal.Values.Timeline as Timeline exposing (Timeline)
|
||||||
|
import Internal.Values.User exposing (User)
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
|
|
||||||
|
|
||||||
|
@ -81,7 +82,9 @@ type alias Room =
|
||||||
from the Matrix API.
|
from the Matrix API.
|
||||||
-}
|
-}
|
||||||
type RoomUpdate
|
type RoomUpdate
|
||||||
= AddSync Batch
|
= AddEvent Event
|
||||||
|
| AddSync Batch
|
||||||
|
| Invite User
|
||||||
| More (List RoomUpdate)
|
| More (List RoomUpdate)
|
||||||
| SetAccountData String Json.Value
|
| SetAccountData String Json.Value
|
||||||
|
|
||||||
|
@ -245,9 +248,17 @@ setAccountData key value room =
|
||||||
update : RoomUpdate -> Room -> Room
|
update : RoomUpdate -> Room -> Room
|
||||||
update ru room =
|
update ru room =
|
||||||
case ru of
|
case ru of
|
||||||
|
AddEvent _ ->
|
||||||
|
-- TODO: Add event
|
||||||
|
room
|
||||||
|
|
||||||
AddSync batch ->
|
AddSync batch ->
|
||||||
addSync batch room
|
addSync batch room
|
||||||
|
|
||||||
|
Invite _ ->
|
||||||
|
-- TODO: Invite user
|
||||||
|
room
|
||||||
|
|
||||||
More items ->
|
More items ->
|
||||||
List.foldl update room items
|
List.foldl update room items
|
||||||
|
|
||||||
|
|
|
@ -36,7 +36,7 @@ Since the username is safely parsed, one can get these parts of the username.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Internal.Config.Log as Log exposing (log)
|
import Internal.Config.Log exposing (log)
|
||||||
import Internal.Grammar.ServerName as ServerName
|
import Internal.Grammar.ServerName as ServerName
|
||||||
import Internal.Grammar.UserId as UserId
|
import Internal.Grammar.UserId as UserId
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
module Internal.Values.Vault exposing
|
module Internal.Values.Vault exposing
|
||||||
( Vault
|
( Vault, init
|
||||||
, VaultUpdate(..), update
|
, VaultUpdate(..), update
|
||||||
, fromRoomId, mapRoom, updateRoom
|
, fromRoomId, mapRoom, updateRoom
|
||||||
, getAccountData, setAccountData
|
, getAccountData, setAccountData
|
||||||
|
@ -12,7 +12,7 @@ can receive from the Matrix API.
|
||||||
|
|
||||||
## Vault type
|
## Vault type
|
||||||
|
|
||||||
@docs Vault
|
@docs Vault, init
|
||||||
|
|
||||||
To update the Vault, one uses VaultUpdate types.
|
To update the Vault, one uses VaultUpdate types.
|
||||||
|
|
||||||
|
@ -37,6 +37,7 @@ import Internal.Config.Text as Text
|
||||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Room as Room exposing (Room)
|
import Internal.Values.Room as Room exposing (Room)
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
|
||||||
|
|
||||||
{-| This is the Vault type.
|
{-| This is the Vault type.
|
||||||
|
@ -44,6 +45,7 @@ import Internal.Values.Room as Room exposing (Room)
|
||||||
type alias Vault =
|
type alias Vault =
|
||||||
{ accountData : Dict String Json.Value
|
{ accountData : Dict String Json.Value
|
||||||
, rooms : Hashdict Room
|
, rooms : Hashdict Room
|
||||||
|
, user : User
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -55,11 +57,12 @@ type VaultUpdate
|
||||||
| MapRoom String Room.RoomUpdate
|
| MapRoom String Room.RoomUpdate
|
||||||
| More (List VaultUpdate)
|
| More (List VaultUpdate)
|
||||||
| SetAccountData String Json.Value
|
| SetAccountData String Json.Value
|
||||||
|
| SetUser User
|
||||||
|
|
||||||
|
|
||||||
coder : Json.Coder Vault
|
coder : Json.Coder Vault
|
||||||
coder =
|
coder =
|
||||||
Json.object2
|
Json.object3
|
||||||
{ name = Text.docs.vault.name
|
{ name = Text.docs.vault.name
|
||||||
, description = Text.docs.vault.description
|
, description = Text.docs.vault.description
|
||||||
, init = Vault
|
, init = Vault
|
||||||
|
@ -78,6 +81,13 @@ coder =
|
||||||
, coder = Hashdict.coder .roomId Room.coder
|
, coder = Hashdict.coder .roomId Room.coder
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "user"
|
||||||
|
, toField = .user
|
||||||
|
, description = Text.fields.vault.user
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
{-| Get a given room by its room id.
|
{-| Get a given room by its room id.
|
||||||
|
@ -94,6 +104,16 @@ getAccountData key vault =
|
||||||
Dict.get key vault.accountData
|
Dict.get key vault.accountData
|
||||||
|
|
||||||
|
|
||||||
|
{-| Initiate a new Vault type.
|
||||||
|
-}
|
||||||
|
init : User -> Vault
|
||||||
|
init user =
|
||||||
|
{ accountData = Dict.empty
|
||||||
|
, rooms = Hashdict.empty .roomId
|
||||||
|
, user = user
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Update a room, if it exists. If the room isn´t known, this operation is
|
{-| Update a room, if it exists. If the room isn´t known, this operation is
|
||||||
ignored.
|
ignored.
|
||||||
-}
|
-}
|
||||||
|
@ -134,3 +154,6 @@ update vu vault =
|
||||||
|
|
||||||
SetAccountData key value ->
|
SetAccountData key value ->
|
||||||
setAccountData key value vault
|
setAccountData key value vault
|
||||||
|
|
||||||
|
SetUser user ->
|
||||||
|
{ vault | user = user }
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
module Matrix exposing
|
module Matrix exposing
|
||||||
( Vault
|
( Vault, fromUserId
|
||||||
, VaultUpdate, update
|
, VaultUpdate, update
|
||||||
|
, addAccessToken, sendMessageEvent
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -18,17 +19,25 @@ support a monolithic public registry. (:
|
||||||
|
|
||||||
## Vault
|
## Vault
|
||||||
|
|
||||||
@docs Vault
|
@docs Vault, fromUserId
|
||||||
|
|
||||||
|
|
||||||
## Keeping the Vault up-to-date
|
## Keeping the Vault up-to-date
|
||||||
|
|
||||||
@docs VaultUpdate, update
|
@docs VaultUpdate, update
|
||||||
|
|
||||||
|
|
||||||
|
## Debugging
|
||||||
|
|
||||||
|
@docs addAccessToken, sendMessageEvent
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Main as Api
|
||||||
import Internal.Values.Envelope as Envelope
|
import Internal.Values.Envelope as Envelope
|
||||||
|
import Internal.Values.User as User
|
||||||
import Internal.Values.Vault as Internal
|
import Internal.Values.Vault as Internal
|
||||||
|
import Json.Encode as E
|
||||||
import Types exposing (Vault(..), VaultUpdate(..))
|
import Types exposing (Vault(..), VaultUpdate(..))
|
||||||
|
|
||||||
|
|
||||||
|
@ -48,6 +57,54 @@ type alias VaultUpdate =
|
||||||
Types.VaultUpdate
|
Types.VaultUpdate
|
||||||
|
|
||||||
|
|
||||||
|
addAccessToken : String -> Vault -> Vault
|
||||||
|
addAccessToken token (Vault vault) =
|
||||||
|
Envelope.mapContext (\c -> { c | suggestedAccessToken = Just token }) vault
|
||||||
|
|> Vault
|
||||||
|
|
||||||
|
|
||||||
|
{-| Use a fully-fledged Matrix ID to connect.
|
||||||
|
|
||||||
|
case Matrix.fromUserId "@alice:example.org" of
|
||||||
|
Just vault ->
|
||||||
|
"We got a vault!"
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
"Invalid username"
|
||||||
|
|
||||||
|
-}
|
||||||
|
fromUserId : String -> Maybe Vault
|
||||||
|
fromUserId =
|
||||||
|
User.fromString
|
||||||
|
>> Maybe.map
|
||||||
|
(\u ->
|
||||||
|
Envelope.init
|
||||||
|
{ serverName = "https://" ++ User.domain u
|
||||||
|
, content = Internal.init u
|
||||||
|
}
|
||||||
|
)
|
||||||
|
>> Maybe.map Vault
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event to a room.
|
||||||
|
|
||||||
|
This function can be used in a scenario where the user does not want to sync
|
||||||
|
the client, or is unable to. This function doesn't check whether the given room
|
||||||
|
exists and the user is able to send a message to, and instead just sends the
|
||||||
|
request to the Matrix API.
|
||||||
|
|
||||||
|
-}
|
||||||
|
sendMessageEvent : Vault -> { content : E.Value, eventType : String, roomId : String, toMsg : VaultUpdate -> msg, transactionId : String } -> Cmd msg
|
||||||
|
sendMessageEvent (Vault vault) data =
|
||||||
|
Api.sendMessageEvent vault
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||||
|
, transactionId = data.transactionId
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Using new VaultUpdate information, update the Vault accordingly.
|
{-| Using new VaultUpdate information, update the Vault accordingly.
|
||||||
|
|
||||||
This allows us to change our perception of the Matrix environment: has anyone
|
This allows us to change our perception of the Matrix environment: has anyone
|
||||||
|
@ -56,6 +113,6 @@ sent a new message? Did someone send us an invite for a new room?
|
||||||
-}
|
-}
|
||||||
update : VaultUpdate -> Vault -> Vault
|
update : VaultUpdate -> Vault -> Vault
|
||||||
update (VaultUpdate vu) (Vault vault) =
|
update (VaultUpdate vu) (Vault vault) =
|
||||||
vault
|
vu.messages
|
||||||
|> Envelope.update Internal.update vu
|
|> List.foldl (Envelope.update Internal.update) vault
|
||||||
|> Vault
|
|> Vault
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
module Matrix.Settings exposing
|
module Matrix.Settings exposing
|
||||||
( getDeviceName, setDeviceName
|
( setAccessToken, removeAccessToken
|
||||||
|
, getDeviceName, setDeviceName
|
||||||
, getSyncTime, setSyncTime
|
, getSyncTime, setSyncTime
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -8,6 +9,18 @@ interact with. Usually, you configure these variables only when creating a new
|
||||||
Vault, or when a user explicitly changes one of their preferred settings.
|
Vault, or when a user explicitly changes one of their preferred settings.
|
||||||
|
|
||||||
|
|
||||||
|
## Access token
|
||||||
|
|
||||||
|
The Vault is able to log in on its own, but sometimes you would rather have the
|
||||||
|
Vault use an access token than log in to get one on its own. For this case, you
|
||||||
|
can use this option to insert an access token into the Vault.
|
||||||
|
|
||||||
|
As long as the access token remains valid, the Vault will use this provided
|
||||||
|
access token.
|
||||||
|
|
||||||
|
@docs setAccessToken, removeAccessToken
|
||||||
|
|
||||||
|
|
||||||
## Device name
|
## Device name
|
||||||
|
|
||||||
The default device name that is being communicated with the Matrix API.
|
The default device name that is being communicated with the Matrix API.
|
||||||
|
@ -43,6 +56,30 @@ import Internal.Values.Envelope as Envelope
|
||||||
import Types exposing (Vault(..))
|
import Types exposing (Vault(..))
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a suggested access token.
|
||||||
|
-}
|
||||||
|
setAccessToken : String -> Vault -> Vault
|
||||||
|
setAccessToken token (Vault vault) =
|
||||||
|
vault
|
||||||
|
|> Envelope.mapContext
|
||||||
|
(\c -> { c | suggestedAccessToken = Just token })
|
||||||
|
|> Vault
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove an access token that has been inserted using the
|
||||||
|
[setAccessToken](Matrix-Settings#setAccessToken) function.
|
||||||
|
|
||||||
|
This should generally not be necessary, but it can be nice security-wise.
|
||||||
|
|
||||||
|
-}
|
||||||
|
removeAccessToken : Vault -> Vault
|
||||||
|
removeAccessToken (Vault vault) =
|
||||||
|
vault
|
||||||
|
|> Envelope.mapContext
|
||||||
|
(\c -> { c | suggestedAccessToken = Nothing })
|
||||||
|
|> Vault
|
||||||
|
|
||||||
|
|
||||||
{-| Determine the device name.
|
{-| Determine the device name.
|
||||||
-}
|
-}
|
||||||
getDeviceName : Vault -> String
|
getDeviceName : Vault -> String
|
||||||
|
|
|
@ -16,6 +16,7 @@ safely access all exposed data types without risking to create circular imports.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Main as Api
|
||||||
import Internal.Values.Envelope as Envelope
|
import Internal.Values.Envelope as Envelope
|
||||||
import Internal.Values.Event as Event
|
import Internal.Values.Event as Event
|
||||||
import Internal.Values.Room as Room
|
import Internal.Values.Room as Room
|
||||||
|
@ -50,4 +51,4 @@ type Vault
|
||||||
{-| Opaque type for Matrix VaultUpdate
|
{-| Opaque type for Matrix VaultUpdate
|
||||||
-}
|
-}
|
||||||
type VaultUpdate
|
type VaultUpdate
|
||||||
= VaultUpdate (Envelope.EnvelopeUpdate Vault.VaultUpdate)
|
= VaultUpdate Api.Msg
|
||||||
|
|
|
@ -3,10 +3,13 @@ module Test.Values.Context exposing (..)
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Config.Leaks as Leaks
|
import Internal.Config.Leaks as Leaks
|
||||||
import Internal.Values.Context as Context exposing (Context)
|
import Internal.Tools.Hashdict as Hashdict
|
||||||
|
import Internal.Values.Context as Context exposing (Context, Versions)
|
||||||
import Json.Decode as D
|
import Json.Decode as D
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
|
import Set
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
|
import Test.Tools.Timestamp as TestTimestamp
|
||||||
|
|
||||||
|
|
||||||
fuzzer : Fuzzer Context
|
fuzzer : Fuzzer Context
|
||||||
|
@ -16,14 +19,31 @@ fuzzer =
|
||||||
maybeString =
|
maybeString =
|
||||||
Fuzz.maybe Fuzz.string
|
Fuzz.maybe Fuzz.string
|
||||||
in
|
in
|
||||||
Fuzz.map7 Context
|
Fuzz.map8 (\a b c d e ( f, g ) ( h, i ) ( j, k ) -> Context a b c d e f g h i j k)
|
||||||
|
(Fuzz.constant <| Hashdict.empty .value)
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
maybeString
|
||||||
|
(Fuzz.maybe TestTimestamp.fuzzer)
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
(Fuzz.pair
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
Fuzz.string
|
||||||
(Fuzz.maybe <| Fuzz.list Fuzz.string)
|
)
|
||||||
|
(Fuzz.pair
|
||||||
|
maybeString
|
||||||
|
maybeString
|
||||||
|
)
|
||||||
|
(Fuzz.pair
|
||||||
|
maybeString
|
||||||
|
(Fuzz.maybe <| versionsFuzzer)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
versionsFuzzer : Fuzzer Versions
|
||||||
|
versionsFuzzer =
|
||||||
|
Fuzz.map2 Versions
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.map Set.fromList <| Fuzz.list Fuzz.string)
|
||||||
|
|
||||||
|
|
||||||
{-| If a leak is spotted, make sure to change the leaking value and then test
|
{-| If a leak is spotted, make sure to change the leaking value and then test
|
||||||
|
@ -64,7 +84,7 @@ leaks =
|
||||||
|> Expect.notEqual Leaks.transaction
|
|> Expect.notEqual Leaks.transaction
|
||||||
)
|
)
|
||||||
, fuzz2 fuzzer
|
, fuzz2 fuzzer
|
||||||
(Fuzz.list Fuzz.string)
|
versionsFuzzer
|
||||||
"Versions"
|
"Versions"
|
||||||
(\context value ->
|
(\context value ->
|
||||||
context
|
context
|
||||||
|
@ -110,7 +130,7 @@ apiContext =
|
||||||
|> Expect.equal value
|
|> Expect.equal value
|
||||||
)
|
)
|
||||||
, fuzz2 fuzzer
|
, fuzz2 fuzzer
|
||||||
(Fuzz.list Fuzz.string)
|
versionsFuzzer
|
||||||
"Versions"
|
"Versions"
|
||||||
(\context value ->
|
(\context value ->
|
||||||
context
|
context
|
||||||
|
@ -126,7 +146,7 @@ json : Test
|
||||||
json =
|
json =
|
||||||
describe "JSON encode + JSON decode"
|
describe "JSON encode + JSON decode"
|
||||||
[ test "Empty is {}"
|
[ test "Empty is {}"
|
||||||
(Context.init
|
(Context.init ""
|
||||||
|> Context.encode
|
|> Context.encode
|
||||||
|> E.encode 0
|
|> E.encode 0
|
||||||
|> Expect.equal "{}"
|
|> Expect.equal "{}"
|
||||||
|
|
|
@ -28,7 +28,7 @@ suite =
|
||||||
[ fuzz Fuzz.string
|
[ fuzz Fuzz.string
|
||||||
"currentVersion"
|
"currentVersion"
|
||||||
(\s ->
|
(\s ->
|
||||||
s
|
{ content = s, serverName = "" }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .currentVersion
|
|> Envelope.extractSettings .currentVersion
|
||||||
|> Expect.equal Default.currentVersion
|
|> Expect.equal Default.currentVersion
|
||||||
|
@ -36,7 +36,7 @@ suite =
|
||||||
, fuzz Fuzz.string
|
, fuzz Fuzz.string
|
||||||
"deviceName"
|
"deviceName"
|
||||||
(\s ->
|
(\s ->
|
||||||
s
|
{ content = s, serverName = "" }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .deviceName
|
|> Envelope.extractSettings .deviceName
|
||||||
|> Expect.equal Default.deviceName
|
|> Expect.equal Default.deviceName
|
||||||
|
@ -44,7 +44,7 @@ suite =
|
||||||
, fuzz Fuzz.string
|
, fuzz Fuzz.string
|
||||||
"syncTime"
|
"syncTime"
|
||||||
(\s ->
|
(\s ->
|
||||||
s
|
{ content = s, serverName = "" }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .syncTime
|
|> Envelope.extractSettings .syncTime
|
||||||
|> Expect.equal Default.syncTime
|
|> Expect.equal Default.syncTime
|
||||||
|
|
|
@ -1,9 +1,7 @@
|
||||||
module Test.Values.Room exposing (..)
|
module Test.Values.Room exposing (..)
|
||||||
|
|
||||||
import Expect
|
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Values.Room as Room exposing (Room)
|
import Internal.Values.Room as Room exposing (Room)
|
||||||
import Json.Decode as D
|
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Filter.Timeline as TestFilter
|
import Test.Filter.Timeline as TestFilter
|
||||||
|
|
|
@ -2,7 +2,7 @@ module Test.Values.Timeline exposing (..)
|
||||||
|
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Filter.Timeline as Filter exposing (Filter)
|
import Internal.Filter.Timeline as Filter
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
|
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
|
||||||
import Json.Decode as D
|
import Json.Decode as D
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
module Test.Values.User exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Grammar.ServerName as SN
|
||||||
|
import Internal.Values.User exposing (User)
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer User
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.constant
|
||||||
|
{ localpart = "temporary"
|
||||||
|
, domain = { host = SN.DNS "matrix.org", port_ = Nothing }
|
||||||
|
}
|
|
@ -1,22 +1,22 @@
|
||||||
module Test.Values.Vault exposing (..)
|
module Test.Values.Vault exposing (..)
|
||||||
|
|
||||||
import FastDict as Dict exposing (Dict)
|
import FastDict as Dict
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Vault exposing (Vault)
|
import Internal.Values.Vault exposing (Vault)
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Tools.Hashdict as TestHashdict
|
import Test.Tools.Hashdict as TestHashdict
|
||||||
import Test.Values.Room as TestRoom
|
import Test.Values.Room as TestRoom
|
||||||
import Internal.Tools.Hashdict as Hashdict
|
import Test.Values.User as TestUser
|
||||||
|
|
||||||
|
|
||||||
vault : Fuzzer Vault
|
vault : Fuzzer Vault
|
||||||
vault =
|
vault =
|
||||||
Fuzz.map2 Vault
|
Fuzz.map3 Vault
|
||||||
(Fuzz.string
|
(Fuzz.string
|
||||||
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|
||||||
|> Fuzz.list
|
|> Fuzz.list
|
||||||
|> Fuzz.map Dict.fromList
|
|> Fuzz.map Dict.fromList
|
||||||
)
|
)
|
||||||
(Fuzz.constant <| Hashdict.empty .roomId)
|
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
|
||||||
-- (TestHashdict.fuzzer .roomId TestRoom.fuzzer)
|
TestUser.fuzzer
|
||||||
|
|
Loading…
Reference in New Issue