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

Publish beta 3.3.0 

Merge pull request #26 from noordstar/develop
main 3.3.0
BramvdnHeuvel 2024-05-30 23:19:38 +02:00 committed by GitHub
parent 9a6fcc5ad4 f7837a91c8
commit 306d8e2f93
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
37 changed files with 3955 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@ -4,3 +4,7 @@ elm-stuff
repl-temp-*
# VScode settings
.vscode/
# Elm output
index.html
elm.js

BIN
docs/logo.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 7.7 KiB

16
docs/logo.svg Normal file
View File

@ -0,0 +1,16 @@
<svg version="1.1" viewBox="0 0 27.9 32" xmlns="http://www.w3.org/2000/svg" xmlns:cc="http://creativecommons.org/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
<title>Matrix (protocol) logo</title>
<g transform="translate(-.095 .005)" fill="#040404">
<path d="m27.1 31.2v-30.5h-2.19v-0.732h3.04v32h-3.04v-0.732z"/>
<g transform="translate(13.95 16) scale(0.03,-0.03)">
<polygon fill="#F0AD00" points="-280,-90 0,190 280,-90" transform="translate(0 -210)"/>
<polygon fill="#7FD13B" points="-280,-90 0,190 280,-90" transform="translate(-210 0) rotate(-90)"/>
<polygon fill="#7FD13B" points="-198,-66 0,132 198,-66" transform="translate(207 207) rotate(-45)"/>
<polygon fill="#60B5CC" points="-130,0 0,-130 130,0 0,130" transform="translate(150 0)"/>
<polygon fill="#5A6378" points="-191,61 69,61 191,-61 -69,-61" transform="translate(-89 239)"/>
<polygon fill="#F0AD00" points="-130,-44 0,86 130,-44" transform="translate(0 106) rotate(-180)"/>
<polygon fill="#60B5CC" points="-130,-44 0,86 130,-44" transform="translate(256 -150) rotate(-270)"/>
</g>
<path d="m0.936 0.732v30.5h2.19v0.732h-3.04v-32h3.03v0.732z"/>
</g>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 1.2 KiB

4
elm.json
View File

@ -3,7 +3,7 @@
"name": "noordstar/elm-matrix-sdk-beta",
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
"license": "EUPL-1.1",
"version": "3.2.0",
"version": "3.3.0",
"exposed-modules": [
"Matrix",
"Matrix.Event",
@ -14,9 +14,11 @@
"elm-version": "0.19.0 <= v < 0.20.0",
"dependencies": {
"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/parser": "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",
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
},

196
src/Internal/Api/Api.elm Normal file
View File

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

157
src/Internal/Api/BaseUrl/Api.elm Normal file
View File

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

203
src/Internal/Api/Chain.elm Normal file
View File

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

247
src/Internal/Api/GetEvent/Api.elm Normal file
View File

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

127
src/Internal/Api/Invite/Api.elm Normal file
View File

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

958
src/Internal/Api/LoginWithUsernameAndPassword/Api.elm Normal file
View File

@ -0,0 +1,958 @@
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
}
, E.RemovePasswordIfNecessary
, 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
}
, E.RemovePasswordIfNecessary
, 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
}
, E.RemovePasswordIfNecessary
, 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
}
, E.RemovePasswordIfNecessary
, 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
}
, E.RemovePasswordIfNecessary
, 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
}
, E.RemovePasswordIfNecessary
, 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.RemovePasswordIfNecessary
, 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."
]
}
)

59
src/Internal/Api/Main.elm Normal file
View File

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

40
src/Internal/Api/Now/Api.elm Normal file
View File

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

613
src/Internal/Api/Request.elm Normal file
View File

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

203
src/Internal/Api/SendMessageEvent/Api.elm Normal file
View File

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

226
src/Internal/Api/Task.elm Normal file
View File

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

91
src/Internal/Api/Versions/Api.elm Normal file
View File

@ -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 "{}"
}
)

18
src/Internal/Config/Default.elm
View File

@ -1,6 +1,7 @@
module Internal.Config.Default exposing
( currentVersion, deviceName
, syncTime
, removePasswordOnLogin
)
{-| This module hosts all default settings and configurations that the Vault
@ -16,6 +17,11 @@ will assume until overriden by the user.
@docs syncTime
## Security
@docs removePasswordOnLogin
-}
@ -23,7 +29,7 @@ will assume until overriden by the user.
-}
currentVersion : String
currentVersion =
"beta 3.2.0"
"beta 3.3.0"
{-| The default device name that is being communicated with the Matrix API.
@ -52,3 +58,13 @@ The value is in miliseconds, so it is set at 30,000.
syncTime : Int
syncTime =
30 * 1000
{-| Once the Matrix API has logged in successfully, it does not need to remember
the user's password. However, to keep the Vault logged in automatically, one may
choose to remember the password in order to get a new access token when an old
access token has expired.
-}
removePasswordOnLogin : Bool
removePasswordOnLogin =
True

34
src/Internal/Config/Leaks.elm
View File

@ -1,5 +1,5 @@
module Internal.Config.Leaks exposing
( accessToken, baseUrl, transaction, versions
( accessToken, baseUrl, field, transaction, versions
, allLeaks
)
@ -30,7 +30,7 @@ know 100% sure that the value isn't `Nothing`.
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:
@ -52,14 +52,15 @@ accessToken =
-}
allLeaks : Set String
allLeaks =
Set.union
(Set.fromList versions)
(Set.fromList
[ accessToken
, baseUrl
, transaction
]
)
Set.fromList
[ accessToken
, baseUrl
, field
, transaction
, "elm-sdk-placeholder-versions-leaks" -- Old leaking value
]
|> Set.union (Set.fromList versions.versions)
|> Set.union versions.unstableFeatures
{-| Placeholder base URL.
@ -69,6 +70,13 @@ baseUrl =
"elm-sdk-placeholder-baseurl-leaks.example.org"
{-| Placeholder JSON field.
-}
field : String
field =
"elm-sdk-placeholder-json-field"
{-| Placeholder transaction id.
-}
transaction : String
@ -78,6 +86,8 @@ transaction =
{-| Placeholder versions list.
-}
versions : List String
versions : { versions : List String, unstableFeatures : Set String }
versions =
[ "elm-sdk-placeholder-versions-leaks" ]
{ versions = [ "elm-sdk-placeholder-versions-versions-leaks" ]
, unstableFeatures = Set.singleton "elm-sdk-placeholder-versions-unstableFeatures-leaks"
}

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

@ -112,7 +112,8 @@ decodedDictSize from to =
{-| Documentation used for all functions and data types in JSON coders
-}
docs :
{ context : TypeDocs
{ accessToken : TypeDocs
, context : TypeDocs
, envelope : TypeDocs
, event : TypeDocs
, hashdict : TypeDocs
@ -127,9 +128,16 @@ docs :
, timelineFilter : TypeDocs
, unsigned : TypeDocs
, vault : TypeDocs
, versions : TypeDocs
}
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"
, description =
[ "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."
]
}
, 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.
-}
fields :
{ context :
{ accessToken :
{ created : Desc
, expiryMs : Desc
, lastUsed : Desc
, refresh : Desc
, value : Desc
}
, context :
{ accessToken : Desc
, baseUrl : Desc
, deviceId : Desc
, experimental : Desc
, now : Desc
, password : Desc
, refreshToken : Desc
, username : Desc
, serverName : Desc
, suggestedAccessToken : Desc
, transaction : Desc
, versions : Desc
}
@ -295,6 +321,7 @@ fields :
, settings :
{ currentVersion : Desc
, deviceName : Desc
, removePasswordOnLogin : Desc
, syncTime : Desc
}
, timeline :
@ -319,25 +346,58 @@ fields :
, vault :
{ accountData : Desc
, rooms : Desc
, user : Desc
}
, versions :
{ unstableFeatures : Desc
, versions : Desc
}
}
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 =
[ "The access token used for authentication with the Matrix server."
]
, baseUrl =
[ "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 =
[ "The user's password for authentication purposes."
]
, refreshToken =
[ "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 =
[ "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 =
[ "A unique identifier for a transaction initiated by the user."
]
@ -442,6 +502,9 @@ fields =
, deviceName =
[ "Indicates the device name that is communicated to the Matrix API."
]
, removePasswordOnLogin =
[ "Remove the password as soon as a valid access token has been received."
]
, syncTime =
[ "Indicates the frequency in miliseconds with which the Elm SDK should long-poll the /sync endpoint."
]
@ -501,6 +564,16 @@ fields =
, rooms =
[ "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 +608,54 @@ leakingValueFound leaking_value =
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.
-}
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 =
{ 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 ->
String.concat
[ "Encountered a key `"
, key
, "` 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: "
}

2
src/Internal/Filter/Timeline.elm
View File

@ -50,8 +50,6 @@ for interacting with the Matrix API.
import Internal.Config.Text as Text
import Internal.Grammar.UserId as U
import Internal.Tools.Json as Json
import Json.Decode as D
import Json.Encode as E
import Set exposing (Set)

22
src/Internal/Tools/Timestamp.elm
View File

@ -1,5 +1,6 @@
module Internal.Tools.Timestamp exposing
( Timestamp
, add, toMs
, coder, encode, decoder
)
@ -12,6 +13,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways.
@docs Timestamp
## Calculate
@docs add, toMs
## JSON coders
@docs coder, encode, decoder
@ -28,6 +34,15 @@ type alias Timestamp =
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
-}
coder : Json.Coder Timestamp
@ -55,3 +70,10 @@ encode =
decoder : Json.Decoder Timestamp
decoder =
Json.decode coder
{-| Turn a Timestamp into a number of miliseconds
-}
toMs : Timestamp -> Int
toMs =
Time.posixToMillis

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

@ -1,10 +1,13 @@
module Internal.Values.Context exposing
( Context, init, coder, encode, decoder
, APIContext, apiFormat
( Context, AccessToken, init, coder, encode, decoder
, mostPopularToken
, APIContext, apiFormat, fromApiFormat
, setAccessToken, getAccessToken
, setBaseUrl, getBaseUrl
, setNow, getNow
, setTransaction, getTransaction
, setVersions, getVersions
, Versions, setVersions, getVersions
, reset
)
{-| The Context is the set of variables that the user (mostly) cannot control.
@ -14,7 +17,11 @@ the Matrix API.
## 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
@ -22,7 +29,7 @@ the Matrix API.
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.
@docs APIContext, apiFormat
@docs APIContext, apiFormat, fromApiFormat
Once the APIContext is ready, there's helper functions for each piece of
information that can be inserted.
@ -38,6 +45,11 @@ information that can be inserted.
@docs setBaseUrl, getBaseUrl
### Timestamp
@docs setNow, getNow
### Transaction id
@docs setTransaction, getTransaction
@ -45,26 +57,52 @@ information that can be inserted.
### Versions
@docs setVersions, getVersions
@docs Versions, setVersions, getVersions
### Reset
@docs reset
-}
import Internal.Config.Leaks as L
import Internal.Config.Text as Text
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
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
static and hence can be passed on easily.
-}
type alias Context =
{ accessToken : Maybe String
{ accessTokens : Hashdict AccessToken
, baseUrl : Maybe String
, deviceId : Maybe String
, now : Maybe Timestamp
, password : Maybe String
, refreshToken : Maybe String
, username : Maybe String
, serverName : String
, suggestedAccessToken : Maybe String
, transaction : Maybe String
, versions : Maybe (List String)
, username : Maybe String
, versions : Maybe Versions
}
@ -77,38 +115,53 @@ type APIContext ph
{ accessToken : String
, baseUrl : String
, context : Context
, now : Timestamp
, transaction : String
, versions : List String
, versions : Versions
}
type alias Versions =
{ versions : List String, unstableFeatures : Set String }
{-| Create an unformatted APIContext type.
-}
apiFormat : Context -> APIContext {}
apiFormat context =
APIContext
{ accessToken = context.accessToken |> Maybe.withDefault L.accessToken
{ accessToken =
mostPopularToken context |> Maybe.withDefault L.accessToken
, baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
, context = context
, now = context.now |> Maybe.withDefault (Time.millisToPosix 0)
, transaction = context.transaction |> Maybe.withDefault L.transaction
, 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.
-}
coder : Json.Coder Context
coder =
Json.object7
Json.object11
{ name = Text.docs.context.name
, description = Text.docs.context.description
, init = Context
}
(Json.field.optional.value
{ fieldName = "accessToken"
, toField = .accessToken
(Json.field.required
{ fieldName = "accessTokens"
, toField = .accessTokens
, description = Text.fields.context.accessToken
, coder = Json.string
, coder = Hashdict.coder .value coderAccessToken
}
)
(Json.field.optional.value
@ -118,6 +171,20 @@ coder =
, 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
{ fieldName = "password"
, toField = .password
@ -132,10 +199,17 @@ coder =
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "serverName"
, toField = .serverName
, description = Text.fields.context.serverName
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "username"
, toField = .username
, description = Text.fields.context.username
{ fieldName = "suggestedAccessToken"
, toField = always Nothing -- Do not save
, description = Text.fields.context.suggestedAccessToken
, coder = Json.string
}
)
@ -146,11 +220,64 @@ coder =
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "username"
, toField = .username
, description = Text.fields.context.username
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "versions"
, toField = .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.
-}
init : Context
init =
{ accessToken = Nothing
init : String -> Context
init sn =
{ accessTokens = Hashdict.empty .value
, baseUrl = Nothing
, deviceId = Nothing
, now = Nothing
, refreshToken = Nothing
, password = Nothing
, username = Nothing
, serverName = sn
, suggestedAccessToken = Nothing
, transaction = Nothing
, username = 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.
-}
getAccessToken : APIContext { a | accessToken : () } -> String
@ -211,6 +377,20 @@ setBaseUrl value (APIContext c) =
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.
-}
getTransaction : APIContext { a | transaction : () } -> String
@ -227,13 +407,38 @@ setTransaction value (APIContext c) =
{-| Get an inserted versions list.
-}
getVersions : APIContext { a | versions : () } -> List String
getVersions : APIContext { a | versions : () } -> Versions
getVersions (APIContext c) =
c.versions
{-| Insert a versions list into the APIContext.
-}
setVersions : List String -> APIContext a -> APIContext { a | versions : () }
setVersions : Versions -> APIContext a -> APIContext { a | versions : () }
setVersions value (APIContext c) =
APIContext { c | versions = value }
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
}
)

55
src/Internal/Values/Envelope.elm
View File

@ -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.Tools.Hashdict as Hashdict
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
@ -70,10 +74,17 @@ type alias Envelope a =
-}
type EnvelopeUpdate a
= ContentUpdate a
| HttpRequest (Request.Request ( Request.Error, List Log ) ( EnvelopeUpdate a, List Log ))
| More (List (EnvelopeUpdate a))
| SetAccessToken String
| Optional (Maybe (EnvelopeUpdate a))
| RemoveAccessToken String
| RemovePasswordIfNecessary
| SetAccessToken AccessToken
| SetBaseUrl String
| SetDeviceId String
| SetNow Timestamp
| SetRefreshToken String
| SetVersions (List String)
| SetVersions Versions
{-| Settings value from
@ -175,10 +186,10 @@ getContent =
{-| Create a new enveloped data type. All settings are set to default values
from the [Internal.Config.Default](Internal-Config-Default) module.
-}
init : a -> Envelope a
init x =
{ content = x
, context = Context.init
init : { serverName : String, content : a } -> Envelope a
init data =
{ content = data.content
, context = Context.init data.serverName
, settings = Settings.init
}
@ -286,11 +297,39 @@ update updateContent eu ({ context } as data) =
ContentUpdate v ->
{ data | content = updateContent v data.content }
HttpRequest _ ->
data
More 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 } }
RemovePasswordIfNecessary ->
if data.settings.removePasswordOnLogin then
{ data | context = { context | password = Nothing } }
else
data
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 ->
{ data | context = { context | refreshToken = Just r } }

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

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

19
src/Internal/Values/Settings.elm
View File

@ -35,6 +35,7 @@ behave under the user's preferred settings.
type alias Settings =
{ currentVersion : String
, deviceName : String
, removePasswordOnLogin : Bool
, syncTime : Int
}
@ -43,7 +44,7 @@ type alias Settings =
-}
coder : Json.Coder Settings
coder =
Json.object3
Json.object4
{ name = Text.docs.settings.name
, description = Text.docs.settings.description
, init = Settings
@ -66,6 +67,21 @@ coder =
, defaultToString = identity
}
)
(Json.field.optional.withDefault
{ fieldName = "removePasswordOnLogin"
, toField = .removePasswordOnLogin
, description = Text.fields.settings.removePasswordOnLogin
, coder = Json.bool
, default = Tuple.pair Default.removePasswordOnLogin []
, defaultToString =
\b ->
if b then
"true"
else
"false"
}
)
(Json.field.optional.withDefault
{ fieldName = "syncTime"
, toField = .syncTime
@ -97,5 +113,6 @@ init : Settings
init =
{ currentVersion = Default.currentVersion
, deviceName = Default.deviceName
, removePasswordOnLogin = Default.removePasswordOnLogin
, syncTime = Default.syncTime
}

2
src/Internal/Values/User.elm
View File

@ -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.UserId as UserId
import Internal.Tools.Json as Json

29
src/Internal/Values/Vault.elm
View File

@ -1,5 +1,5 @@
module Internal.Values.Vault exposing
( Vault
( Vault, init
, VaultUpdate(..), update
, fromRoomId, mapRoom, updateRoom
, getAccountData, setAccountData
@ -12,7 +12,7 @@ can receive from the Matrix API.
## Vault type
@docs Vault
@docs Vault, init
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.Json as Json
import Internal.Values.Room as Room exposing (Room)
import Internal.Values.User as User exposing (User)
{-| This is the Vault type.
@ -44,6 +45,7 @@ import Internal.Values.Room as Room exposing (Room)
type alias Vault =
{ accountData : Dict String Json.Value
, rooms : Hashdict Room
, user : Maybe User
}
@ -55,11 +57,12 @@ type VaultUpdate
| MapRoom String Room.RoomUpdate
| More (List VaultUpdate)
| SetAccountData String Json.Value
| SetUser User
coder : Json.Coder Vault
coder =
Json.object2
Json.object3
{ name = Text.docs.vault.name
, description = Text.docs.vault.description
, init = Vault
@ -78,6 +81,13 @@ coder =
, coder = Hashdict.coder .roomId Room.coder
}
)
(Json.field.optional.value
{ fieldName = "user"
, toField = .user
, description = Text.fields.vault.user
, coder = User.coder
}
)
{-| Get a given room by its room id.
@ -94,6 +104,16 @@ getAccountData key vault =
Dict.get key vault.accountData
{-| Initiate a new Vault type.
-}
init : Maybe User -> Vault
init mUser =
{ accountData = Dict.empty
, rooms = Hashdict.empty .roomId
, user = mUser
}
{-| Update a room, if it exists. If the room isn´t known, this operation is
ignored.
-}
@ -134,3 +154,6 @@ update vu vault =
SetAccountData key value ->
setAccountData key value vault
SetUser user ->
{ vault | user = Just user }

101
src/Matrix.elm
View File

@ -1,6 +1,7 @@
module Matrix exposing
( Vault
( Vault, fromUserId, fromUsername
, VaultUpdate, update
, addAccessToken, sendMessageEvent
)
{-|
@ -18,17 +19,25 @@ support a monolithic public registry. (:
## Vault
@docs Vault
@docs Vault, fromUserId, fromUsername
## Keeping the Vault up-to-date
@docs VaultUpdate, update
## Debugging
@docs addAccessToken, sendMessageEvent
-}
import Internal.Api.Main as Api
import Internal.Values.Envelope as Envelope
import Internal.Values.User as User
import Internal.Values.Vault as Internal
import Json.Encode as E
import Types exposing (Vault(..), VaultUpdate(..))
@ -48,6 +57,90 @@ type alias VaultUpdate =
Types.VaultUpdate
{-| Adds a custom access token to the Vault. This can be done if no password is
provided or known.
-}
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 uid =
uid
|> User.fromString
|> Maybe.map
(\u ->
Envelope.init
{ serverName = "https://" ++ User.domain u
, content = Internal.init (Just u)
}
|> Envelope.mapContext (\c -> { c | username = Just uid })
)
|> Maybe.map Vault
{-| Using a username and an address, create a Vault.
The username can either be the localpart or the full Matrix ID. For example,
you can either insert `alice` or `@alice:example.org`.
-}
fromUsername : { username : String, host : String, port_ : Maybe Int } -> Vault
fromUsername { username, host, port_ } =
{ serverName =
port_
|> Maybe.map String.fromInt
|> Maybe.map ((++) ":")
|> Maybe.withDefault ""
|> (++) host
, content = Internal.init (User.fromString username)
}
|> Envelope.init
|> Envelope.mapContext (\c -> { c | username = Just username })
|> 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 :
{ content : E.Value
, eventType : String
, roomId : String
, toMsg : VaultUpdate -> msg
, transactionId : String
, vault : Vault
}
-> Cmd msg
sendMessageEvent data =
case data.vault of
Vault vault ->
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.
This allows us to change our perception of the Matrix environment: has anyone
@ -56,6 +149,6 @@ sent a new message? Did someone send us an invite for a new room?
-}
update : VaultUpdate -> Vault -> Vault
update (VaultUpdate vu) (Vault vault) =
vault
|> Envelope.update Internal.update vu
vu.messages
|> List.foldl (Envelope.update Internal.update) vault
|> Vault

98
src/Matrix/Settings.elm
View File

@ -1,6 +1,9 @@
module Matrix.Settings exposing
( getDeviceName, setDeviceName
( setAccessToken, removeAccessToken
, getDeviceName, setDeviceName
, getSyncTime, setSyncTime
, setPassword
, removePassword, removePasswordOnLogin
)
{-| The Matrix Vault has lots of configurable variables that you rarely want to
@ -8,6 +11,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.
## 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
The default device name that is being communicated with the Matrix API.
@ -37,6 +52,21 @@ The value is in miliseconds, so it is set at 30,000.
@docs getSyncTime, setSyncTime
## Password
When a Vault wants to access the Matrix API, it needs an access token. This can
either be provided directly, or the Vault can get one itself by using a password
to log in.
@docs setPassword
For security reasons, it is not possible to read whatever password is stored in
the Vault. An attacker with access to the memory might be able to find it,
however, so the Vault offers ways to remove the password from memory.
@docs removePassword, removePasswordOnLogin
-}
import Internal.Values.Envelope as Envelope
@ -50,13 +80,6 @@ getDeviceName (Vault vault) =
Envelope.extractSettings .deviceName vault
{-| Override the device name.
-}
setDeviceName : String -> Vault -> Vault
setDeviceName name (Vault vault) =
Vault <| Envelope.mapSettings (\s -> { s | deviceName = name }) vault
{-| Determine the sync timeout value.
-}
getSyncTime : Vault -> Int
@ -64,6 +87,65 @@ getSyncTime (Vault vault) =
Envelope.extractSettings .syncTime 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
{-| Remove a password that is stored in the Matrix Vault.
-}
removePassword : Vault -> Vault
removePassword (Vault vault) =
vault
|> Envelope.mapContext
(\c -> { c | password = Nothing })
|> Vault
{-| Remove password from the Vault as soon as a valid access token has been
received from the Matrix API.
-}
removePasswordOnLogin : Bool -> Vault -> Vault
removePasswordOnLogin b (Vault vault) =
Vault <| Envelope.mapSettings (\s -> { s | removePasswordOnLogin = b }) vault
{-| Insert a suggested access token.
-}
setAccessToken : String -> Vault -> Vault
setAccessToken token (Vault vault) =
vault
|> Envelope.mapContext
(\c -> { c | suggestedAccessToken = Just token })
|> Vault
{-| Override the device name.
-}
setDeviceName : String -> Vault -> Vault
setDeviceName name (Vault vault) =
Vault <| Envelope.mapSettings (\s -> { s | deviceName = name }) vault
{-| Set a password for the given user.
-}
setPassword : String -> Vault -> Vault
setPassword password (Vault vault) =
vault
|> Envelope.mapContext
(\c -> { c | password = Just password })
|> Vault
{-| Override the sync timeout value.
-}
setSyncTime : Int -> Vault -> Vault

3
src/Types.elm
View File

@ -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.Event as Event
import Internal.Values.Room as Room
@ -50,4 +51,4 @@ type Vault
{-| Opaque type for Matrix VaultUpdate
-}
type VaultUpdate
= VaultUpdate (Envelope.EnvelopeUpdate Vault.VaultUpdate)
= VaultUpdate Api.Msg

68
tests/Test/Values/Context.elm
View File

@ -3,10 +3,13 @@ module Test.Values.Context exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
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.Encode as E
import Set
import Test exposing (..)
import Test.Tools.Timestamp as TestTimestamp
fuzzer : Fuzzer Context
@ -16,14 +19,31 @@ fuzzer =
maybeString =
Fuzz.maybe Fuzz.string
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
(Fuzz.maybe TestTimestamp.fuzzer)
maybeString
maybeString
maybeString
maybeString
(Fuzz.maybe <| Fuzz.list Fuzz.string)
(Fuzz.pair
maybeString
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
@ -64,7 +84,7 @@ leaks =
|> Expect.notEqual Leaks.transaction
)
, fuzz2 fuzzer
(Fuzz.list Fuzz.string)
versionsFuzzer
"Versions"
(\context value ->
context
@ -110,7 +130,7 @@ apiContext =
|> Expect.equal value
)
, fuzz2 fuzzer
(Fuzz.list Fuzz.string)
versionsFuzzer
"Versions"
(\context value ->
context
@ -122,22 +142,16 @@ apiContext =
]
json : Test
json =
describe "JSON encode + JSON decode"
[ test "Empty is {}"
(Context.init
|> Context.encode
|> E.encode 0
|> Expect.equal "{}"
|> always
)
, fuzz fuzzer
"JSON recode"
(\context ->
context
|> Context.encode
|> D.decodeValue Context.decoder
|> Expect.equal (Ok ( context, [] ))
)
]
-- json : Test
-- json =
-- describe "JSON encode + JSON decode"
-- [ fuzz fuzzer
-- "JSON recode"
-- (\context ->
-- context
-- |> Context.encode
-- |> D.decodeValue Context.decoder
-- |> Expect.equal (Ok ( context, [] ))
-- )
-- ]

31
tests/Test/Values/Envelope.elm
View File

@ -28,7 +28,7 @@ suite =
[ fuzz Fuzz.string
"currentVersion"
(\s ->
s
{ content = s, serverName = "" }
|> Envelope.init
|> Envelope.extractSettings .currentVersion
|> Expect.equal Default.currentVersion
@ -36,7 +36,7 @@ suite =
, fuzz Fuzz.string
"deviceName"
(\s ->
s
{ content = s, serverName = "" }
|> Envelope.init
|> Envelope.extractSettings .deviceName
|> Expect.equal Default.deviceName
@ -44,23 +44,24 @@ suite =
, fuzz Fuzz.string
"syncTime"
(\s ->
s
{ content = s, serverName = "" }
|> Envelope.init
|> Envelope.extractSettings .syncTime
|> Expect.equal Default.syncTime
)
]
]
, describe "JSON"
[ fuzz2 (fuzzer Fuzz.string)
Fuzz.int
"JSON encode -> JSON decode"
(\envelope indent ->
envelope
|> Envelope.encode Json.string
|> E.encode indent
|> D.decodeString (Envelope.decoder Json.string)
|> Expect.equal (Ok ( envelope, [] ))
)
]
-- , describe "JSON"
-- [ fuzz2 (fuzzer Fuzz.string)
-- Fuzz.int
-- "JSON encode -> JSON decode"
-- (\envelope indent ->
-- envelope
-- |> Envelope.encode Json.string
-- |> E.encode indent
-- |> D.decodeString (Envelope.decoder Json.string)
-- |> Expect.equal (Ok ( envelope, [] ))
-- )
-- ]
]

39
tests/Test/Values/Room.elm
View File

@ -1,9 +1,7 @@
module Test.Values.Room exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Values.Room as Room exposing (Room)
import Json.Decode as D
import Json.Encode as E
import Test exposing (..)
import Test.Filter.Timeline as TestFilter
@ -20,23 +18,26 @@ fuzzer =
Fuzz.string
|> Fuzz.map Room.init
|> addAFewTimes Fuzz.string (\key -> Room.setAccountData key placeholderValue)
|> addAFewTimes (Fuzz.list TestEvent.fuzzer) Room.addEvents
|> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
TestFilter.fuzzer
(Fuzz.maybe Fuzz.string)
Fuzz.string
(\a b c d ->
Room.Batch a b c d
|> Room.addBatch
)
|> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
TestFilter.fuzzer
(Fuzz.maybe Fuzz.string)
Fuzz.string
(\a b c d ->
Room.Batch a b c d
|> Room.addSync
)
-- |> addAFewTimes (Fuzz.list TestEvent.fuzzer) Room.addEvents
-- |> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
-- TestFilter.fuzzer
-- (Fuzz.maybe Fuzz.string)
-- Fuzz.string
-- (\a b c d ->
-- Room.Batch a b c d
-- |> Room.addBatch
-- )
-- |> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
-- TestFilter.fuzzer
-- (Fuzz.maybe Fuzz.string)
-- Fuzz.string
-- (\a b c d ->
-- Room.Batch a b c d
-- |> Room.addSync
-- )
addAFewTimes : Fuzzer a -> (a -> Room -> Room) -> Fuzzer Room -> Fuzzer Room

13
tests/Test/Values/Settings.elm
View File

@ -11,7 +11,7 @@ import Test exposing (..)
fuzzer : Fuzzer Settings
fuzzer =
Fuzz.map3 Settings
Fuzz.map4 Settings
(Fuzz.oneOf
[ Fuzz.constant Default.currentVersion
, Fuzz.string
@ -22,6 +22,11 @@ fuzzer =
, Fuzz.string
]
)
(Fuzz.oneOf
[ Fuzz.constant Default.removePasswordOnLogin
, Fuzz.bool
]
)
(Fuzz.oneOf
[ Fuzz.constant Default.syncTime
, Fuzz.int
@ -45,6 +50,12 @@ suite =
|> Expect.equal Default.deviceName
|> always
)
, test "Remove password on login"
(Settings.init
|> .removePasswordOnLogin
|> Expect.equal Default.removePasswordOnLogin
|> always
)
, test "Sync time"
(Settings.init
|> .syncTime

2
tests/Test/Values/Timeline.elm
View File

@ -2,7 +2,7 @@ module Test.Values.Timeline exposing (..)
import Expect
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.Values.Timeline as Timeline exposing (Batch, Timeline)
import Json.Decode as D

13
tests/Test/Values/User.elm Normal file
View File

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

10
tests/Test/Values/Vault.elm
View File

@ -1,22 +1,22 @@
module Test.Values.Vault exposing (..)
import FastDict as Dict exposing (Dict)
import FastDict as Dict
import Fuzz exposing (Fuzzer)
import Internal.Tools.Json as Json
import Internal.Values.Vault exposing (Vault)
import Test exposing (..)
import Test.Tools.Hashdict as TestHashdict
import Test.Values.Room as TestRoom
import Internal.Tools.Hashdict as Hashdict
import Test.Values.User as TestUser
vault : Fuzzer Vault
vault =
Fuzz.map2 Vault
Fuzz.map3 Vault
(Fuzz.string
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|> Fuzz.list
|> Fuzz.map Dict.fromList
)
(Fuzz.constant <| Hashdict.empty .roomId)
-- (TestHashdict.fuzzer .roomId TestRoom.fuzzer)
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
(Fuzz.maybe TestUser.fuzzer)