Compare commits

...

115 Commits
3.1.0 ... main

Author SHA1 Message Date
BramvdnHeuvel 1701904144
Publish beta 3.5.0
Merge pull request #38 from noordstar/develop
2024-07-26 09:38:59 +02:00
Bram e42ff71809 Prepare develop for master
elm-test --fuzz 1000 --seed 105375026504828
2024-07-26 09:34:06 +02:00
Bram c6d388bff6 Remove invalid function from documentation 2024-07-26 09:25:03 +02:00
BramvdnHeuvel a336c8b057
Merge pull request #37 from noordstar/4-transfer-api
Add lots of API features
2024-07-26 09:21:40 +02:00
Bram 8d28fe63b9 Fix bugs 2024-07-25 19:15:30 +02:00
Bram a8d879afbb elm-format 2024-07-24 14:05:49 +02:00
Bram 61a8e18714 Add kick + invite + ban user to Matrix.Room 2024-07-24 14:03:12 +02:00
Bram a2582f36f9 Add invite function 2024-07-22 12:58:52 +02:00
Bram 41bee45693 Add global account data functions 2024-07-21 10:38:34 +02:00
Bram 3566d3ee7a Solve elm test bugs from moving user 2024-07-19 09:02:01 +02:00
Bram 8b2db7bff6 Add setAccountData to Matrix rooms 2024-07-19 09:01:42 +02:00
Bram 5319f47145 Move user from Vault to Envelop Context 2024-07-19 08:51:19 +02:00
Bram 87ebcbcd21 Add sendStateEvent to Room API 2024-07-17 14:13:13 +02:00
Bram 0521ca2f3e Add sendMessageEvent to Room API 2024-07-16 12:41:09 +02:00
Bram fee68f7e0f Merge branch 'develop' into 4-transfer-api 2024-07-16 12:34:11 +02:00
Bram 7b615c6452 Merge branch '4-transfer-api' of github.com:noordstar/elm-matrix-sdk-beta into 4-transfer-api 2024-07-16 12:33:37 +02:00
BramvdnHeuvel 07c34c3530
Publish beta 3.4.0
Merge pull request #34 from noordstar/develop
2024-07-16 12:12:10 +02:00
Bram 1ed9fa7d22 Prepare develop for master
elm-test --fuzz 1000 --seed 156536263253947
2024-07-16 12:06:35 +02:00
Bram cacb876a95 Fix test errors
elm-test --fuzz 1000 --seed 156536263253947
2024-07-16 12:05:23 +02:00
Bram 20504d4a8b Remove test issues & warnings 2024-07-16 10:20:38 +02:00
Bram a401c25a47 Remove issues & warnings 2024-07-16 10:10:42 +02:00
Bram f3799add87 HOTFIX: Fix syntax error 2024-07-15 16:13:11 +02:00
BramvdnHeuvel eb8d90ab8b
Enable safe recursion in VaultUpdate type
Merge pull request #33 from noordstar/safe-recursion
2024-07-15 16:08:34 +02:00
Bram 1736679e0f elm-format 2024-07-15 16:07:28 +02:00
Bram 31817ed545 Merge develop into safe-recursion 2024-07-15 16:07:08 +02:00
BramvdnHeuvel 899088d63c
Add room navigation functions to exposed library
Merge pull request #32 from noordstar/4-lib-improvement
2024-07-15 16:01:52 +02:00
Bram 48e5eae327 Merge develop into 4-lib-improvement 2024-07-15 16:00:38 +02:00
Bram 90eb06f3a1 elm-format 2024-07-15 15:57:08 +02:00
BramvdnHeuvel a9e4a39e7f
Add /sync endpoint to Elm SDK
Merge pull request #31 from noordstar/4-transfer-api
2024-07-15 15:51:24 +02:00
Bram d7a7fa385c Enable safe recursion in VaultUpdate type 2024-07-15 15:50:32 +02:00
Bram c7204c4c41 Remove Debug.log from API definition 2024-07-13 13:39:33 +02:00
BramvdnHeuvel c473d60161
Merge branch 'develop' into 4-transfer-api 2024-07-13 09:58:40 +02:00
BramvdnHeuvel 41ec76822f
Add logs function to Matrix
Merge pull request #27 from noordstar/4-log-reader
2024-07-13 09:57:18 +02:00
Bram 458ea59425 Add ways to navigate through rooms 2024-07-13 09:50:39 +02:00
Bram 1eb07377fd Fix StrippedEvent JSON coder 2024-07-13 09:39:14 +02:00
Bram 39f8021a8f Fix spec misconception
Apparently, the  field is also meant for other reasons than the cputime         unlimited
filesize        unlimited
datasize        unlimited
stacksize       8MB
coredumpsize    unlimited
resident        unlimited
maxproc         62741
descriptors     524288
memorylocked    8MB
addressspace    unlimited
maxfilelocks    unlimited
sigpending      62741
msgqueue        819200
nice            0
rt_priority     0
rt_time         unlimited field on the filter, despite the description suggesting otherwise.
2024-07-13 09:38:57 +02:00
Bram 1aecb1116a Merge updated develop into branch
I accidentally forgot to pull the branch, but now the conflict has been resolved.
2024-07-09 18:39:24 +02:00
Bram 8a3b7efbf6 Merge branch 'develop' into 4-transfer-api 2024-07-09 17:53:47 +02:00
Bram 005e103389 Expose sync function 2024-07-09 17:50:48 +02:00
Bram 4e378a5f50 Add /sync as task 2024-07-09 17:33:41 +02:00
Bram 0978e43fc0 Finish /sync API definition 2024-07-09 16:55:19 +02:00
Bram 632158f309 Add toUpdate function for sync V4 2024-07-09 16:48:53 +02:00
Bram c5d07f0a94 Add toUpdate function for sync V1 - V3 2024-07-09 13:29:45 +02:00
Bram b239eecc6b Add toUpdate function for /sync v1 2024-07-09 00:08:46 +02:00
Bram e7d3a129b1 Finish /sync for all spec versions v1.1 to v1.11 2024-07-08 23:07:50 +02:00
Bram e122a7b262 Rename /sync v4 to v3 2024-07-08 22:11:04 +02:00
Bram 29906ff976 Remove redundant /sync versions 2024-07-08 22:10:29 +02:00
Bram 80bb05fd30 Add /sync from v1.1 to v1.5 2024-07-08 20:08:32 +02:00
Bram 1d0a9de7da Automate defaultToString behaviour 2024-07-08 18:24:41 +02:00
noordstar a95fbbb856
Merge pull request #30 from noordstar/patch-iddict
Move Iddict to noordstar/elm-iddict
2024-07-02 10:24:54 +02:00
Bram 95f0aa2934 Remove deprecated spec version
To improve backwards compatibility, we'll start with v1.1 and go from there. Then, if the spec versions seem fit, we can work backwards.
2024-06-13 22:43:25 +02:00
Bram 7ab21b4314 Add /sync at r0.4.0 (partially) 2024-06-13 22:42:36 +02:00
Bram 0092f96a25 Add /sync at r0.3.0 2024-06-13 22:27:12 +02:00
Bram 6300d15edf Move Iddict to noordstar/elm-iddict 2024-06-13 19:47:39 +02:00
BramvdnHeuvel 17a1d1af3e
Publish beta 3.3.1
Merge pull request #29 from noordstar/develop
2024-06-10 10:10:41 +02:00
Bram van den Heuvel 61dad6c5e8 Add Matrix Room to README 2024-06-10 10:07:44 +02:00
Bram 693124aa15 Add documentation for StrippedEvent 2024-06-08 15:32:17 +02:00
Bram 6783186c18 Add nextBatch value in Vault 2024-06-08 15:25:49 +02:00
Bram 0ded7ab6bd Add ephemeral events to Room 2024-06-08 15:19:55 +02:00
Bram f6a6bb535e Add StrippedEvent module 2024-06-08 15:10:58 +02:00
Bram 76cc6d46b9 Prepare develop for master
No elm-test for this patch update. The update does not concern written Elm tests, and it has been tested on the Elm SDK demo code
2024-06-05 17:41:11 +02:00
BramvdnHeuvel 425d964af5
Merge pull request #28 from noordstar/patch-no-baseurl-found
Default to original server name if no well-known found
2024-06-05 12:16:53 +02:00
Bram 21ae0ea376 Default to original server name if no well-known found 2024-06-04 15:50:08 +02:00
Bram 7b00a46ffa Add object1 2024-06-03 15:02:35 +02:00
Bram f714438dd4 Add logs function for better runtime documentation 2024-06-03 11:05:06 +02:00
Bram a514497406 Improve documentation of sendMessageEvent 2024-06-03 11:04:34 +02:00
BramvdnHeuvel 306d8e2f93
Publish beta 3.3.0
Merge pull request #26 from noordstar/develop
2024-05-30 23:19:38 +02:00
Bram f7837a91c8 Prepare develop for master
elm-test --fuzz 1000 --seed 373594127264638
2024-05-30 23:15:40 +02:00
Bram d360c561f9 Hide custom Elm configurations 2024-05-30 16:46:44 +02:00
BramvdnHeuvel acd4a07d5e
Merge pull request #25 from noordstar/4-transfer-api
Add password
2024-05-30 14:07:52 +02:00
Bram 1de9566e1d SECURITY: Remove Elm output
Yes, this index.html file contains credentials. For this reason, the password has been reset and the software should no longer work.
2024-05-30 14:02:20 +02:00
Bram 85d767414d Make username optional 2024-05-30 13:54:30 +02:00
Bram 994c99af15 Add RemovePasswordOnLogin feature 2024-05-30 13:53:56 +02:00
Bram b465ad1f47 Remove password after login, if necessary 2024-05-30 10:52:48 +02:00
Bram e8c0df004e Add removePasswordOnLogin setting 2024-05-30 10:48:20 +02:00
BramvdnHeuvel c5e546b25c
Merge pull request #24 from noordstar/4-transfer-api
Add MVP for API interaction
2024-05-30 10:20:48 +02:00
Bram bec1ae4a3b Fix merge conflict bug 2024-05-28 18:29:26 +02:00
BramvdnHeuvel daf4bcb1b1
Merge branch 'develop' into 4-transfer-api 2024-05-28 18:25:16 +02:00
Bram b0026617cf Add JSON fields to Text module 2024-05-28 18:20:01 +02:00
Bram 7fcef60ec6 Move logs to Text module 2024-05-28 16:46:33 +02:00
Bram 2b9370f0c2 Fix bugs for MVP
This version now officially works. I have tested it and I will publish an example soon.
2024-05-28 10:32:17 +02:00
Bram 12c919b071 Finish addAccessToken function 2024-05-27 23:47:37 +02:00
Bram 567ac5596a Merge branch '4-compiler-bug' into 4-transfer-api 2024-05-27 16:44:57 +02:00
Bram b32e0ef123 Fix test errors 2024-05-27 16:39:50 +02:00
Bram 9e761db4f9 Fix (most) warnings 2024-05-26 19:24:31 +02:00
Bram e335c150f0 Fix compiler bugs 2024-05-26 18:53:31 +02:00
Bram 4349a14a87 BREAKING: Fix bug breaking Elm compiler 2024-05-26 18:12:37 +02:00
Bram 487c872d43 Add method to create a Vault 2024-05-26 13:12:03 +02:00
Bram 42ca8f6c9c Add Elm SDK logo 2024-05-25 19:48:29 +02:00
Bram e6257d8e38 Change VaultUpdate to API Backpack 2024-05-25 19:47:15 +02:00
Bram 7a75bffbfb Add send message event as Task 2024-05-25 17:03:42 +02:00
Bram 4f08dd1176 Add send message event API endpoint 2024-05-25 16:15:27 +02:00
Bram 50b10c64ca Add makeVBA TaskChain 2024-05-24 16:19:13 +02:00
Bram 3b0b3264de Finish /login API endpoint 2024-05-24 15:15:44 +02:00
Bram c84bb2a1ef Extract access token value on r0.0.0 login endpoint 2024-05-23 18:57:55 +02:00
Bram 6e89371845 Add /_matrix/client/r0/login on r0.0.0 2024-05-22 20:52:35 +02:00
Bram 77387ab492 Add makeVB TaskChain 2024-05-22 20:52:07 +02:00
Bram 83043e73f4 Add /.well-known/matrix.client endpoint 2024-05-22 20:51:36 +02:00
Bram becd3bcdb1 Update GetEvent + Invite endpoint to new Enveloped Http Log type 2024-05-22 19:17:21 +02:00
Bram e786bebeb2 Add /_matrix/client/versions endpoint 2024-05-22 19:13:20 +02:00
Bram 3ee6debf44 Refactor Context 2024-05-22 19:12:34 +02:00
Bram b6e4396138 Update existing types & modules 2024-05-22 19:11:39 +02:00
Bram 568afed458 Add Invite API endpoint 2024-05-19 00:22:51 +02:00
Bram 2714b53a2d Add GetEvent API endpoint 2024-05-19 00:22:36 +02:00
Bram 3fdd25d6d6 Add spec version control for API endpoints 2024-05-19 00:22:12 +02:00
Bram e49a0e3dc3 Add documentation 2024-05-17 18:00:33 +02:00
Bram 2e8185841a Add HTTP module for Matrix API requests 2024-05-17 14:28:06 +02:00
BramvdnHeuvel 9a6fcc5ad4
Publish beta 3.2.0
Merge pull request #23 from noordstar/develop
2024-05-10 15:50:29 +02:00
Bram ff8b6c043a Prepare develop for master
elm-test --fuzz 1000 --seed 70276890098989
2024-05-10 15:41:27 +02:00
Bram 7935e112ed Add Task Chain + API setup 2024-05-10 15:26:18 +02:00
BramvdnHeuvel 2baf012345
Merge pull request #22 from noordstar/3-vault
Add Vault as data type
2024-05-10 15:24:10 +02:00
Bram 107233fbad Remove fixed TODO 2024-05-10 15:21:31 +02:00
Bram 41d8503d7e Update library description 2024-05-09 20:53:57 +02:00
Bram e3e765503f Add initial VaultUpdate design 2024-05-09 18:39:17 +02:00
Bram 5cf6b59602 Add initial Vault design 2024-05-08 07:57:08 +02:00
62 changed files with 9634 additions and 722 deletions

7
.gitignore vendored
View File

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

View File

@ -18,8 +18,9 @@ supported for which spec versions.
- ✅ **One way to do things** instead of having multiple functions that are
considered deprecated.
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) at
@elm_matrix_sdk@social.noordstar.me to stay up-to-date on the latest changes.
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) or join the
conversation on [Matrix](https://matrix.to/#/#elm-sdk:matrix.org) to stay
up-to-date on the latest changes.
## How to install

BIN
docs/logo.png Normal file

Binary file not shown.

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>

After

Width:  |  Height:  |  Size: 1.2 KiB

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.1.0",
"version": "3.5.0",
"exposed-modules": [
"Matrix",
"Matrix.Event",
@ -14,11 +14,14 @@
"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"
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0",
"noordstar/elm-iddict": "1.0.1 <= v < 2.0.0"
},
"test-dependencies": {
"elm-explorations/test": "2.1.2 <= v < 3.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)

View File

@ -0,0 +1,116 @@
module Internal.Api.BanUser.Api exposing (Phantom, banUser)
{-|
# Ban user
This module helps to ban users from a room.
@docs Phantom, banUser
-}
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 R
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
banUser : BanUserInput -> A.TaskChain (Phantom a) (Phantom a)
banUser =
A.startWithVersion "r0.0.0" banUserV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.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" banUserV2
|> 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
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias BanUserInput =
{ reason : Maybe String
, roomId : String
, user : User
}
type alias BanUserInputV1 a =
{ a | reason : Maybe String, roomId : String, user : User }
type alias BanUserOutputV1 =
()
banUserV1 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
banUserV1 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV1
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "ban" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
banUserV2 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
banUserV2 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV1
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "ban" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
coderV1 : Json.Coder BanUserOutputV1
coderV1 =
Json.unit

View File

@ -0,0 +1,134 @@
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.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.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = HomeserverInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover homeserver information."
]
}
)
(Json.field.optional.value
{ fieldName = "m.identity_server"
, toField = .identityServer
, coder =
Json.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = IdentityServerInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, 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
}
)

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 users 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, membership = Nothing, 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
}
)
}
)

View File

@ -0,0 +1,128 @@
module Internal.Api.InviteUser.Api exposing (InviteInput, Phantom, inviteUser)
{-|
# 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, inviteUser
-}
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.
-}
inviteUser : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
inviteUser =
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.accessToken
, 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
)
}

View File

@ -0,0 +1,178 @@
module Internal.Api.KickUser.Api exposing (Phantom, kickUser)
{-|
# Kick user
This module helps to kick users from a room.
@docs Phantom, kickUser
-}
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 R
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
kickUser : KickUserInput -> A.TaskChain (Phantom a) (Phantom a)
kickUser =
A.startWithVersion "r0.0.0" kickUserV1
|> A.sameForVersion "r0.0.1"
-- NOTE: Kicking a user was first added in r0.1.0
|> A.forVersion "r0.1.0" kickUserV2
|> A.sameForVersion "r0.2.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" kickUserV3
|> 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
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias KickUserInput =
{ avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
type alias KickUserInputV1 a =
{ a
| avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
type alias KickUserInputV2 a =
{ a | reason : Maybe String, roomId : String, user : User }
type alias KickUserOutputV1 =
{ eventId : Maybe String }
type alias KickUserOutputV2 =
()
kickUserV1 : KickUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
kickUserV1 { avatarUrl, displayname, reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyString "membership" "kick"
, R.bodyOpString "avatar_url" avatarUrl
, R.bodyOpString "displayname" displayname
, R.bodyOpString "reason" reason
]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", "m.room.member", User.toString user ]
, toUpdate =
\out ->
( E.More []
, [ "The kick API endpoint does not exist before spec version r0.1.0 - falling back to sending state event directly."
|> log.debug
, out.eventId
|> Text.logs.sendEvent
|> log.debug
]
)
}
kickUserV2 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
kickUserV2 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV2
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "kick" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
kickUserV3 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
kickUserV3 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV2
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "kick" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
coderV1 : Json.Coder KickUserOutputV1
coderV1 =
Json.object1
{ name = "EventResponse"
, description =
[ "This object is returned after a state event has been sent."
]
, init = KickUserOutputV1
}
(Json.field.optional.value
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)
coderV2 : Json.Coder KickUserOutputV2
coderV2 =
Json.unit

View File

@ -0,0 +1,935 @@
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.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 E.SetUser
|> 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 E.SetUser
|> 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 E.SetUser
|> 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 E.SetUser
|> 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 E.SetUser
|> 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 E.SetUser
|> 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.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.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = HomeserverInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover homeserver information."
]
}
)
(Json.field.optional.value
{ fieldName = "m.identity_server"
, toField = .identityServer
, coder =
Json.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = HomeserverInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover identity server information."
]
}
)

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

@ -0,0 +1,236 @@
module Internal.Api.Main exposing
( Msg
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
)
{-|
# Main API module
This module is used as reference for getting
## VaultUpdate
@docs Msg
## Actions
@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
-}
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
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
{-| Update message type that is being returned.
-}
type alias Msg =
Backpack
{-| Ban a user from a room.
-}
banUser :
E.Envelope a
->
{ reason : Maybe String
, roomId : String
, toMsg : Msg -> msg
, user : User
}
-> Cmd msg
banUser env data =
ITask.run
data.toMsg
(ITask.banUser
{ reason = data.reason
, roomId = data.roomId
, user = data.user
}
)
(Context.apiFormat env.context)
{-| Invite a user to a room.
-}
inviteUser :
E.Envelope a
->
{ reason : Maybe String
, roomId : String
, toMsg : Msg -> msg
, user : User
}
-> Cmd msg
inviteUser env data =
ITask.run
data.toMsg
(ITask.inviteUser
{ reason = data.reason
, roomId = data.roomId
, user = data.user
}
)
(Context.apiFormat env.context)
{-| Kick a user from a room.
-}
kickUser :
E.Envelope a
->
{ reason : Maybe String
, roomId : String
, toMsg : Msg -> msg
, user : User
}
-> Cmd msg
kickUser env data =
ITask.run
data.toMsg
(ITask.kickUser
{ avatarUrl = Nothing
, displayname = Nothing
, reason = data.reason
, roomId = data.roomId
, user = data.user
}
)
(Context.apiFormat env.context)
{-| 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)
{-| Send a state event to a room.
-}
sendStateEvent :
E.Envelope a
->
{ content : Json.Value
, eventType : String
, roomId : String
, stateKey : String
, toMsg : Msg -> msg
}
-> Cmd msg
sendStateEvent env data =
ITask.run
data.toMsg
(ITask.sendStateEvent
{ content = data.content
, eventType = data.eventType
, roomId = data.roomId
, stateKey = data.stateKey
}
)
(Context.apiFormat env.context)
{-| Set global account data.
-}
setAccountData :
E.Envelope a
->
{ content : Json.Value
, eventType : String
, toMsg : Msg -> msg
}
-> Cmd msg
setAccountData env data =
case env.context.user of
Just u ->
ITask.run
data.toMsg
(ITask.setAccountData
{ content = data.content
, eventType = data.eventType
, userId = User.toString u
}
)
(Context.apiFormat env.context)
Nothing ->
Cmd.none
{-| Set the account data for a Matrix room.
-}
setRoomAccountData :
E.Envelope a
->
{ content : Json.Value
, eventType : String
, roomId : String
, toMsg : Msg -> msg
}
-> Cmd msg
setRoomAccountData env data =
case env.context.user of
Just u ->
ITask.run
data.toMsg
(ITask.setRoomAccountData
{ content = data.content
, eventType = data.eventType
, roomId = data.roomId
, userId = User.toString u
}
)
(Context.apiFormat env.context)
Nothing ->
Cmd.none
-- TODO: Return error about lacking user capabilities
{-| Sync with the Matrix API to stay up-to-date.
-}
sync :
E.Envelope a
-> { toMsg : Msg -> msg }
-> Cmd msg
sync env data =
ITask.run
data.toMsg
(ITask.sync
{ fullState = Nothing
, presence = env.settings.presence
, since = env.context.nextBatch
, timeout = Just env.settings.syncTime
}
)
(Context.apiFormat env.context)

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

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

View File

@ -0,0 +1,180 @@
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.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.object1
{ 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 = SendMessageEventOutputV1
}
(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.object1
{ 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 = SendMessageEventOutputV2
}
(Json.field.required
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)

View File

@ -0,0 +1,176 @@
module Internal.Api.SendStateEvent.Api exposing (..)
{-|
# Send state event
This module sends state events to Matrix rooms.
@docs Phantom, sendStateEvent
-}
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
{-| Send a state event to a Matrix room.
-}
sendStateEvent : SendStateEventInput -> A.TaskChain (Phantom a) (Phantom a)
sendStateEvent =
A.startWithVersion "r0.0.0" sendStateEventV1
|> 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" sendStateEventV2
|> A.forVersion "v1.1" sendStateEventV3
|> 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 state event
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SendStateEventInput =
{ content : Json.Value
, eventType : String
, roomId : String
, stateKey : String
}
type alias SendStateEventInputV1 a =
{ a
| content : Json.Value
, eventType : String
, roomId : String
, stateKey : String
}
type alias SendStateEventOutputV1 =
{ eventId : Maybe String }
type alias SendStateEventOutputV2 =
{ eventId : String }
sendStateEventV1 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendStateEventV1 { content, eventType, roomId, stateKey } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
sendStateEventV2 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendStateEventV2 { content, eventType, roomId, stateKey } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
sendStateEventV3 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendStateEventV3 { content, eventType, roomId, stateKey } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "state", eventType, stateKey ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
coderV1 : Json.Coder SendStateEventOutputV1
coderV1 =
Json.object1
{ name = "EventResponse"
, description =
[ "This object is returned after a state event has been sent."
]
, init = SendStateEventOutputV1
}
(Json.field.optional.value
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)
coderV2 : Json.Coder SendStateEventOutputV2
coderV2 =
Json.object1
{ name = "EventResponse"
, description =
[ "This object is returned after a state event has been sent."
]
, init = SendStateEventOutputV2
}
(Json.field.required
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)

View File

@ -0,0 +1,107 @@
module Internal.Api.SetAccountData.Api exposing (Phantom, setAccountData)
{-|
# Set Account Data
This module allows the developer to set global account data.
@docs Phantom, setAccountData
-}
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 R
import Internal.Values.Vault as V
setAccountData : SetAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
setAccountData =
A.startWithVersion "r0.0.0" setAccountDataV1
|> 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" setAccountDataV2
|> 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 setting global account data.
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SetAccountDataInput =
{ content : Json.Value, eventType : String, userId : String }
type alias SetAccountDataInputV1 a =
{ a | content : Json.Value, eventType : String, userId : String }
type alias SetAccountDataOutput =
()
setAccountDataV1 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setAccountDataV1 { content, eventType, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "user", userId, "account_data", eventType ]
, toUpdate =
\() ->
( V.SetAccountData eventType content
|> E.ContentUpdate
, []
)
}
setAccountDataV2 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setAccountDataV2 { content, eventType, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "user", userId, "account_data", eventType ]
, toUpdate =
\() ->
( V.SetAccountData eventType content
|> E.ContentUpdate
, []
)
}
coderV1 : Json.Coder SetAccountDataOutput
coderV1 =
Json.unit

View File

@ -0,0 +1,111 @@
module Internal.Api.SetRoomAccountData.Api exposing (..)
{-|
# Set Room Account Data
This module allows the developer to set account data to a Matrix room.
@docs Phantom, setRoomAccountData
-}
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 R
import Internal.Values.Vault as V
{-| Set account data to a Matrix room.
-}
setRoomAccountData : SetRoomAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
setRoomAccountData =
A.startWithVersion "r0.0.0" setRoomAccountDataV1
|> 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" setRoomAccountDataV2
|> 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 setting account data on a room.
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SetRoomAccountDataInput =
{ content : Json.Value, eventType : String, roomId : String, userId : String }
type alias SetRoomAccountDataInputV1 a =
{ a | content : Json.Value, eventType : String, roomId : String, userId : String }
type alias SetRoomAccountDataOutputV1 =
()
setRoomAccountDataV1 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setRoomAccountDataV1 { content, eventType, roomId, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "user", userId, "rooms", roomId, "account_data", eventType ]
, toUpdate =
\() ->
( R.SetAccountData eventType content
|> V.MapRoom roomId
|> E.ContentUpdate
, []
)
}
setRoomAccountDataV2 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setRoomAccountDataV2 { content, eventType, roomId, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "user", userId, "rooms", roomId, "account_data", eventType ]
, toUpdate =
\() ->
( R.SetAccountData eventType content
|> V.MapRoom roomId
|> E.ContentUpdate
, []
)
}
coderV1 : Json.Coder SetRoomAccountDataOutputV1
coderV1 =
Json.unit

View File

@ -0,0 +1,176 @@
module Internal.Api.Sync.Api exposing (sync, Phantom)
{-|
# Sync
The sync module might be one of the most crucial parts of the Elm SDK. It offers
users the guarantee that the `Vault` type remains up-to-date, and it helps
communicate with the Matrix server about the Vault's needs.
@docs sync, Phantom
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Api.Sync.V1 as V1
import Internal.Api.Sync.V2 as V2
import Internal.Api.Sync.V3 as V3
import Internal.Api.Sync.V4 as V4
import Internal.Filter.Timeline as Filter
{-| Sync with the Matrix API.
-}
sync : SyncInput -> A.TaskChain (Phantom a) (Phantom a)
sync =
A.startWithVersion "v1.1" syncV1
|> A.forVersion "v1.2" syncV2
|> A.sameForVersion "v1.3"
|> A.forVersion "v1.4" syncV3
|> 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.forVersion "v1.11" syncV4
|> A.versionChain
-- For simplicity, we will not use a filter for now
-- and assume that every client always wants to receive all events.
-- type FilterV1
-- = FilterV1 Filter
-- | FilterIdV1 String Filter
-- | NoFilter
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SyncInput =
{ -- filter : FilterV1,
fullState : Maybe Bool
, presence : Maybe String
, since : Maybe String
, timeout : Maybe Int
}
type alias SyncInputV1 a =
{ a
| -- filter : FilterV1 ,
since : Maybe String
, fullState : Maybe Bool
, presence : Maybe String
, timeout : Maybe Int
}
presenceFromOptions : List String -> Maybe String -> Maybe String
presenceFromOptions options =
Maybe.andThen
(\v ->
if List.member v options then
Just v
else
Nothing
)
syncV1 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
syncV1 data =
A.request
{ attributes =
[ R.accessToken
, R.queryOpString "filter" Nothing -- FILTER HERE
, R.queryOpBool "full_state" data.fullState
, data.presence
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|> R.queryOpString "set_presence"
, R.queryOpString "since" data.since
, R.queryOpInt "timeout" data.timeout
]
, coder = V1.coderSyncResponse
, contextChange = always identity
, method = "GET"
, path = [ "_matrix", "client", "v3", "sync" ]
, toUpdate =
V1.updateSyncResponse { filter = Filter.pass, since = data.since }
}
syncV2 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
syncV2 data =
A.request
{ attributes =
[ R.accessToken
, R.queryOpString "filter" Nothing
, R.queryOpBool "full_state" data.fullState
, data.presence
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|> R.queryOpString "set_presence"
, R.queryOpString "since" data.since
, R.queryOpInt "timeout" data.timeout
]
, coder = V2.coderSyncResponse
, contextChange = always identity
, method = "GET"
, path = [ "_matrix", "client", "v3", "sync" ]
, toUpdate =
V2.updateSyncResponse { filter = Filter.pass, since = data.since }
}
syncV3 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
syncV3 data =
A.request
{ attributes =
[ R.accessToken
, R.queryOpString "filter" Nothing
, R.queryOpBool "full_state" data.fullState
, data.presence
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|> R.queryOpString "set_presence"
, R.queryOpString "since" data.since
, R.queryOpInt "timeout" data.timeout
]
, coder = V3.coderSyncResponse
, contextChange = always identity
, method = "GET"
, path = [ "_matrix", "client", "v3", "sync" ]
, toUpdate =
V3.updateSyncResponse { filter = Filter.pass, since = data.since }
}
syncV4 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
syncV4 data =
A.request
{ attributes =
[ R.accessToken
, R.queryOpString "filter" Nothing
, R.queryOpBool "full_state" data.fullState
, data.presence
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|> R.queryOpString "set_presence"
, R.queryOpString "since" data.since
, R.queryOpInt "timeout" data.timeout
]
, coder = V4.coderSyncResponse
, contextChange = always identity
, method = "GET"
, path = [ "_matrix", "client", "v3", "sync" ]
, toUpdate =
V4.updateSyncResponse { filter = Filter.pass, since = data.since }
}

1012
src/Internal/Api/Sync/V1.elm Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,797 @@
module Internal.Api.Sync.V2 exposing (..)
{-|
# Sync response
This API module represents the /sync endpoint on Matrix spec version v1.2 and
v1.3.
<https://spec.matrix.org/v1.2/client-server-api/#syncing>
<https://spec.matrix.org/v1.3/client-server-api/#syncing>
-}
import FastDict as Dict exposing (Dict)
import Internal.Api.Sync.V1 as PV
import Internal.Config.Log exposing (Log, log)
import Internal.Config.Text as Text
import Internal.Filter.Timeline exposing (Filter)
import Internal.Tools.Json as Json
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
import Internal.Values.Envelope as E
import Internal.Values.Event as Event
import Internal.Values.Room as R
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
import Recursion
type alias SyncResponse =
{ accountData : Maybe AccountData
, deviceLists : Maybe DeviceLists
, deviceOneTimeKeysCount : Maybe (Dict String Int)
, deviceUnusedFallbackKeyTypes : List String
, nextBatch : String
, presence : Maybe Presence
, rooms : Maybe Rooms
, toDevice : Maybe ToDevice
}
type alias AccountData =
{ events : Maybe (List Event) }
type alias Event =
{ content : Json.Value
, eventType : String
}
type alias Presence =
{ events : Maybe (List Event) }
type alias Rooms =
{ invite : Maybe (Dict String InvitedRoom)
, join : Maybe (Dict String JoinedRoom)
, knock : Maybe (Dict String KnockedRoom)
, leave : Maybe (Dict String LeftRoom)
}
type alias InvitedRoom =
{ inviteState : Maybe InviteState }
type alias InviteState =
{ events : Maybe (List StrippedStateEvent) }
type alias StrippedStateEvent =
{ content : Json.Value
, sender : User
, stateKey : String
, eventType : String
}
type alias JoinedRoom =
{ accountData : Maybe AccountData
, ephemeral : Maybe Ephemeral
, state : Maybe State
, summary : Maybe RoomSummary
, timeline : Maybe Timeline
, unreadNotifications : Maybe UnreadNotificationCounts
}
type alias Ephemeral =
{ events : Maybe (List Event) }
type alias State =
{ events : Maybe (List ClientEventWithoutRoomID) }
type alias ClientEventWithoutRoomID =
{ content : Json.Value
, eventId : String
, originServerTs : Timestamp
, sender : User
, stateKey : Maybe String
, eventType : String
, unsigned : Maybe UnsignedData
}
type UnsignedData
= UnsignedData
{ age : Maybe Int
, prevContent : Maybe Json.Value
, redactedBecause : Maybe ClientEventWithoutRoomID
, transactionId : Maybe String
}
type alias RoomSummary =
{ mHeroes : Maybe (List String)
, mInvitedMemberCount : Maybe Int
, mJoinedMemberCount : Maybe Int
}
type alias Timeline =
{ events : List ClientEventWithoutRoomID
, limited : Maybe Bool
, prevBatch : Maybe String
}
type alias UnreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
type alias KnockedRoom =
{ knockState : Maybe KnockState }
type alias KnockState =
{ events : Maybe (List StrippedStateEvent) }
type alias LeftRoom =
{ accountData : Maybe AccountData
, state : Maybe State
, timeline : Maybe Timeline
}
type alias DeviceLists =
{ changed : Maybe (List String)
, left : Maybe (List String)
}
type alias ToDevice =
{ events : Maybe (List ToDeviceEvent) }
type alias ToDeviceEvent =
{ content : Maybe Json.Value
, sender : Maybe User
, eventType : Maybe String
}
coderSyncResponse : Json.Coder SyncResponse
coderSyncResponse =
Json.object8
{ name = "SyncResponse"
, description = [ "An event that is part of a response." ]
, init = SyncResponse
}
(Json.field.optional.value
{ fieldName = "account_data"
, toField = .accountData
, description = [ "The global private data created by this user." ]
, coder = coderAccountData
}
)
(Json.field.optional.value
{ fieldName = "device_lists"
, toField = .deviceLists
, description = [ "Information on end-to-end device updates, as specified in End-to-end encryption." ]
, coder = coderDeviceLists
}
)
(Json.field.optional.value
{ fieldName = "device_one_time_keys_count"
, toField = .deviceOneTimeKeysCount
, description = [ "Information on end-to-end encryption keys, as specified in End-to-end encryption." ]
, coder = Json.fastDict Json.int
}
)
(Json.field.required
{ fieldName = "device_unused_fallback_key_types"
, toField = .deviceUnusedFallbackKeyTypes
, description = [ "The unused fallback key algorithms." ]
, coder = Json.list Json.string
}
)
(Json.field.required
{ fieldName = "next_batch"
, toField = .nextBatch
, description = [ "Required: The batch token to supply in the since param of the next /sync request." ]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "presence"
, toField = .presence
, description = [ "The updates to the presence status of other users." ]
, coder = coderPresence
}
)
(Json.field.optional.value
{ fieldName = "rooms"
, toField = .rooms
, description = [ "Updates to rooms." ]
, coder = coderRooms
}
)
(Json.field.optional.value
{ fieldName = "to_device"
, toField = .toDevice
, description = [ "Information on the send-to-device messages for the client device, as defined in Send-to-Device messaging." ]
, coder = coderToDevice
}
)
coderAccountData : Json.Coder AccountData
coderAccountData =
PV.coderAccountData
coderEvent : Json.Coder Event
coderEvent =
PV.coderEvent
coderPresence : Json.Coder Presence
coderPresence =
PV.coderPresence
coderRooms : Json.Coder Rooms
coderRooms =
Json.object4
{ name = "Rooms"
, description = [ "Updates to rooms." ]
, init = Rooms
}
(Json.field.optional.value
{ fieldName = "invite"
, toField = .invite
, description = [ "The rooms that the user has been invited to, mapped as room ID to room information." ]
, coder = Json.fastDict coderInvitedRoom
}
)
(Json.field.optional.value
{ fieldName = "join"
, toField = .join
, description = [ "The rooms that the user has joined, mapped as room ID to room information." ]
, coder = Json.fastDict coderJoinedRoom
}
)
(Json.field.optional.value
{ fieldName = "knock"
, toField = .knock
, description = [ "The rooms that the user has knocked upon, mapped as room ID to room information." ]
, coder = Json.fastDict coderKnockedRoom
}
)
(Json.field.optional.value
{ fieldName = "leave"
, toField = .leave
, description = [ "The rooms that the user has left or been banned from, mapped as room ID to room information." ]
, coder = Json.fastDict coderLeftRoom
}
)
coderInvitedRoom : Json.Coder InvitedRoom
coderInvitedRoom =
PV.coderInvitedRoom
coderInviteState : Json.Coder InviteState
coderInviteState =
PV.coderInviteState
coderStrippedStateEvent : Json.Coder StrippedStateEvent
coderStrippedStateEvent =
PV.coderStrippedState
coderJoinedRoom : Json.Coder JoinedRoom
coderJoinedRoom =
Json.object6
{ name = "JoinedRoom"
, description = [ "The rooms that the user has joined." ]
, init = JoinedRoom
}
(Json.field.optional.value
{ fieldName = "account_data"
, toField = .accountData
, description = [ "The private data that this user has attached to this room." ]
, coder = coderAccountData
}
)
(Json.field.optional.value
{ fieldName = "ephemeral"
, toField = .ephemeral
, description = [ "The ephemeral events in the room that arent recorded in the timeline or state of the room. e.g. typing." ]
, coder = coderEphemeral
}
)
(Json.field.optional.value
{ fieldName = "state"
, toField = .state
, description = [ "Updates to the state, between the time indicated by the since parameter, and the start of the timeline (or all state up to the start of the timeline, if since is not given, or full_state is true).", "N.B. state updates for m.room.member events will be incomplete if lazy_load_members is enabled in the /sync filter, and only return the member events required to display the senders of the timeline events in this response." ]
, coder = coderState
}
)
(Json.field.optional.value
{ fieldName = "summary"
, toField = .summary
, description = [ "Information about the room which clients may need to correctly render it to users." ]
, coder = coderRoomSummary
}
)
(Json.field.optional.value
{ fieldName = "timeline"
, toField = .timeline
, description = [ "The timeline of messages and state changes in the room." ]
, coder = coderTimeline
}
)
(Json.field.optional.value
{ fieldName = "unread_notifications"
, toField = .unreadNotifications
, description = [ "Counts of unread notifications for this room. See the Receiving notifications section for more information on how these are calculated." ]
, coder = coderUnreadNotificationCounts
}
)
coderEphemeral : Json.Coder Ephemeral
coderEphemeral =
PV.coderEphemeral
coderState : Json.Coder State
coderState =
Json.object1
{ name = "State"
, description = [ "Updates to the state." ]
, init = State
}
(Json.field.optional.value
{ fieldName = "events"
, toField = .events
, description = [ "List of events." ]
, coder = Json.list coderClientEventWithoutRoomID
}
)
coderClientEventWithoutRoomID : Json.Coder ClientEventWithoutRoomID
coderClientEventWithoutRoomID =
Json.object7
{ name = "ClientEventWithoutRoomID"
, description = [ "An event without a room ID." ]
, init = ClientEventWithoutRoomID
}
(Json.field.required
{ fieldName = "content"
, toField = .content
, description = [ "Required: 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 = [ "Required: The globally unique identifier for this event." ]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "origin_server_ts"
, toField = .originServerTs
, description = [ "Required: Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent." ]
, coder = Timestamp.coder
}
)
(Json.field.required
{ fieldName = "sender"
, toField = .sender
, description = [ "Required: 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." ]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "type"
, toField = .eventType
, description = [ "Required: 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 = coderUnsignedData
}
)
coderUnsignedData : Json.Coder UnsignedData
coderUnsignedData =
Json.object4
{ name = "UnsignedData"
, description = [ "Contains optional extra information about the event." ]
, init =
\a b c d ->
UnsignedData
{ age = a
, prevContent = b
, redactedBecause = c
, transactionId = d
}
}
(Json.field.optional.value
{ fieldName = "age"
, toField = \(UnsignedData u) -> u.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 = \(UnsignedData u) -> u.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 = \(UnsignedData u) -> u.redactedBecause
, description = [ "The event that redacted this event, if any." ]
, coder = Json.lazy (\_ -> coderClientEventWithoutRoomID)
}
)
(Json.field.optional.value
{ fieldName = "transaction_id"
, toField = \(UnsignedData u) -> u.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
}
)
coderRoomSummary : Json.Coder RoomSummary
coderRoomSummary =
PV.coderRoomSummary
coderTimeline : Json.Coder Timeline
coderTimeline =
Json.object3
{ name = "Timeline"
, description = [ "The timeline of messages and state changes in the room." ]
, init = Timeline
}
(Json.field.required
{ fieldName = "events"
, toField = .events
, description = [ "Required: List of events." ]
, coder = Json.list coderClientEventWithoutRoomID
}
)
(Json.field.optional.value
{ fieldName = "limited"
, toField = .limited
, description = [ "True if the number of events returned was limited by the limit on the filter." ]
, coder = Json.bool
}
)
(Json.field.optional.value
{ fieldName = "prev_batch"
, toField = .prevBatch
, description = [ "A token that can be supplied to the from parameter of the /rooms/<room_id>/messages endpoint in order to retrieve earlier events. If no earlier events are available, this property may be omitted from the response." ]
, coder = Json.string
}
)
coderUnreadNotificationCounts : Json.Coder UnreadNotificationCounts
coderUnreadNotificationCounts =
PV.coderUnreadNotificationCounts
coderKnockedRoom : Json.Coder KnockedRoom
coderKnockedRoom =
PV.coderKnockedRoom
coderKnockState : Json.Coder KnockState
coderKnockState =
PV.coderKnockState
coderLeftRoom : Json.Coder LeftRoom
coderLeftRoom =
Json.object3
{ name = "LeftRoom"
, description = [ "The rooms that the user has left or been banned from." ]
, init = LeftRoom
}
(Json.field.optional.value
{ fieldName = "account_data"
, toField = .accountData
, description = [ "The private data that this user has attached to this room." ]
, coder = coderAccountData
}
)
(Json.field.optional.value
{ fieldName = "state"
, toField = .state
, description = [ "The state updates for the room up to the start of the timeline." ]
, coder = coderState
}
)
(Json.field.optional.value
{ fieldName = "timeline"
, toField = .timeline
, description = [ "The timeline of messages and state changes in the room up to the point when the user left." ]
, coder = coderTimeline
}
)
coderDeviceLists : Json.Coder DeviceLists
coderDeviceLists =
PV.coderDeviceLists
coderToDevice : Json.Coder ToDevice
coderToDevice =
PV.coderToDevice
coderToDeviceEvent : Json.Coder ToDeviceEvent
coderToDeviceEvent =
PV.coderToDeviceEvent
updateSyncResponse : { filter : Filter, since : Maybe String } -> SyncResponse -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
updateSyncResponse { filter, since } response =
-- Account data
[ response.accountData
|> Maybe.andThen .events
|> Maybe.map (List.map (\e -> V.SetAccountData e.eventType e.content))
|> Maybe.map
(\x ->
( E.ContentUpdate <| V.More x
, if List.length x > 0 then
List.length x
|> Text.logs.syncAccountDataFound
|> log.debug
|> List.singleton
else
[]
)
)
-- TODO: Add device lists
-- Next batch
, Just ( E.SetNextBatch response.nextBatch, [] )
-- TODO: Add presence
-- Rooms
, Maybe.map
(updateRooms { filter = filter, nextBatch = response.nextBatch, since = since }
>> Tuple.mapFirst E.ContentUpdate
)
response.rooms
-- TODO: Add to_device
]
|> List.filterMap identity
|> List.unzip
|> Tuple.mapFirst E.More
|> Tuple.mapSecond List.concat
updateRooms : { filter : Filter, nextBatch : String, since : Maybe String } -> Rooms -> ( V.VaultUpdate, List Log )
updateRooms { filter, nextBatch, since } rooms =
let
( roomUpdate, roomLogs ) =
rooms.join
|> Maybe.withDefault Dict.empty
|> Dict.toList
|> List.map
(\( roomId, room ) ->
let
( u, l ) =
updateJoinedRoom
{ filter = filter
, nextBatch = nextBatch
, roomId = roomId
, since = since
}
room
in
( V.MapRoom roomId u, l )
)
|> List.unzip
|> Tuple.mapBoth V.More List.concat
in
( V.More
-- Add rooms
[ rooms.join
|> Maybe.withDefault Dict.empty
|> Dict.keys
|> List.map V.CreateRoomIfNotExists
|> V.More
-- Update rooms
, roomUpdate
-- TODO: Add invited rooms
-- TODO: Add knocked rooms
-- TODO: Add left rooms
]
, roomLogs
)
updateJoinedRoom : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> JoinedRoom -> ( R.RoomUpdate, List Log )
updateJoinedRoom data room =
( R.More
[ room.accountData
|> Maybe.andThen .events
|> Maybe.map
(\events ->
events
|> List.map (\e -> R.SetAccountData e.eventType e.content)
|> R.More
)
|> R.Optional
, room.ephemeral
|> Maybe.andThen .events
|> Maybe.map R.SetEphemeral
|> R.Optional
-- TODO: Add state
-- TODO: Add RoomSummary
, room.timeline
|> Maybe.map (updateTimeline data)
|> R.Optional
-- TODO: Add unread notifications
]
, []
)
updateTimeline : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> Timeline -> R.RoomUpdate
updateTimeline { filter, nextBatch, roomId, since } timeline =
let
limited : Bool
limited =
Maybe.withDefault False timeline.limited
newEvents : List Event.Event
newEvents =
List.map (toEvent roomId) timeline.events
in
case ( limited, timeline.prevBatch ) of
( False, Just p ) ->
if timeline.prevBatch == since then
R.AddSync
{ events = newEvents
, filter = filter
, start = Just p
, end = nextBatch
}
else
R.More
[ R.AddSync
{ events = []
, filter = filter
, start = since
, end = p
}
, R.AddSync
{ events = newEvents
, filter = filter
, start = Just p
, end = nextBatch
}
]
( False, Nothing ) ->
R.AddSync
{ events = newEvents
, filter = filter
, start = since
, end = nextBatch
}
( True, _ ) ->
R.AddSync
{ events = newEvents
, filter = filter
, start = timeline.prevBatch
, end = nextBatch
}
toEvent : String -> ClientEventWithoutRoomID -> Event.Event
toEvent roomId event =
Recursion.runRecursion
(\ev ->
case Maybe.andThen (\(UnsignedData u) -> u.redactedBecause) ev.unsigned of
Just e ->
Recursion.recurseThen e
(\eo ->
Recursion.base
{ content = ev.content
, eventId = ev.eventId
, originServerTs = ev.originServerTs
, roomId = roomId
, sender = ev.sender
, stateKey = ev.stateKey
, eventType = ev.eventType
, unsigned = toUnsigned (Just eo) ev.unsigned
}
)
Nothing ->
Recursion.base
{ content = ev.content
, eventId = ev.eventId
, originServerTs = ev.originServerTs
, roomId = roomId
, sender = ev.sender
, stateKey = ev.stateKey
, eventType = ev.eventType
, unsigned = toUnsigned Nothing ev.unsigned
}
)
event
toUnsigned : Maybe Event.Event -> Maybe UnsignedData -> Maybe Event.UnsignedData
toUnsigned ev unsigned =
case ( ev, unsigned ) of
( Nothing, Nothing ) ->
Nothing
( Just e, Nothing ) ->
{ age = Nothing
, membership = Nothing
, prevContent = Nothing
, redactedBecause = Just e
, transactionId = Nothing
}
|> Event.UnsignedData
|> Just
( _, Just (UnsignedData u) ) ->
{ age = u.age
, membership = Nothing
, prevContent = u.prevContent
, redactedBecause = ev
, transactionId = u.transactionId
}
|> Event.UnsignedData
|> Just

View File

@ -0,0 +1,580 @@
module Internal.Api.Sync.V3 exposing (..)
{-|
# Sync response
This API module represents the /sync endpoint on the following Matrix spec
versions:
<https://spec.matrix.org/v1.4/client-server-api/#syncing>
<https://spec.matrix.org/v1.5/client-server-api/#syncing>
<https://spec.matrix.org/v1.6/client-server-api/#syncing>
<https://spec.matrix.org/v1.7/client-server-api/#syncing>
<https://spec.matrix.org/v1.8/client-server-api/#syncing>
<https://spec.matrix.org/v1.9/client-server-api/#syncing>
<https://spec.matrix.org/v1.10/client-server-api/#syncing>
-}
import FastDict as Dict exposing (Dict)
import Internal.Api.Sync.V2 as PV
import Internal.Config.Log exposing (Log, log)
import Internal.Config.Text as Text
import Internal.Filter.Timeline exposing (Filter)
import Internal.Tools.Json as Json
import Internal.Tools.Timestamp exposing (Timestamp)
import Internal.Values.Envelope as E
import Internal.Values.Event as Event
import Internal.Values.Room as R
import Internal.Values.User exposing (User)
import Internal.Values.Vault as V
type alias SyncResponse =
{ accountData : Maybe AccountData
, deviceLists : Maybe DeviceLists
, deviceOneTimeKeysCount : Maybe (Dict String Int)
, deviceUnusedFallbackKeyTypes : List String
, nextBatch : String
, presence : Maybe Presence
, rooms : Maybe Rooms
, toDevice : Maybe ToDevice
}
type alias AccountData =
{ events : Maybe (List Event) }
type alias Event =
{ content : Json.Value
, eventType : String
}
type alias Presence =
{ events : Maybe (List Event) }
type alias Rooms =
{ invite : Maybe (Dict String InvitedRoom)
, join : Maybe (Dict String JoinedRoom)
, knock : Maybe (Dict String KnockedRoom)
, leave : Maybe (Dict String LeftRoom)
}
type alias InvitedRoom =
{ inviteState : Maybe InviteState }
type alias InviteState =
{ events : Maybe (List StrippedStateEvent) }
type alias StrippedStateEvent =
{ content : Json.Value
, sender : User
, stateKey : String
, eventType : String
}
type alias JoinedRoom =
{ accountData : Maybe AccountData
, ephemeral : Maybe Ephemeral
, state : Maybe State
, summary : Maybe RoomSummary
, timeline : Maybe Timeline
, unreadNotifications : Maybe UnreadNotificationCounts
, unreadThreadNotifications : Maybe (Dict String ThreadNotificationCounts)
}
type alias Ephemeral =
{ events : Maybe (List Event) }
type alias State =
{ events : Maybe (List ClientEventWithoutRoomID) }
type alias ClientEventWithoutRoomID =
{ content : Json.Value
, eventId : String
, originServerTs : Timestamp
, sender : User
, stateKey : Maybe String
, eventType : String
, unsigned : Maybe UnsignedData
}
type alias UnsignedData =
PV.UnsignedData
type alias RoomSummary =
{ mHeroes : Maybe (List String)
, mInvitedMemberCount : Maybe Int
, mJoinedMemberCount : Maybe Int
}
type alias Timeline =
{ events : List ClientEventWithoutRoomID
, limited : Maybe Bool
, prevBatch : Maybe String
}
type alias UnreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
type alias ThreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
type alias KnockedRoom =
{ knockState : Maybe KnockState }
type alias KnockState =
{ events : Maybe (List StrippedStateEvent) }
type alias LeftRoom =
{ accountData : Maybe AccountData
, state : Maybe State
, timeline : Maybe Timeline
}
type alias DeviceLists =
{ changed : Maybe (List String)
, left : Maybe (List String)
}
type alias ToDevice =
{ events : Maybe (List ToDeviceEvent) }
type alias ToDeviceEvent =
{ content : Maybe Json.Value
, sender : Maybe User
, eventType : Maybe String
}
coderSyncResponse : Json.Coder SyncResponse
coderSyncResponse =
Json.object8
{ name = "SyncResponse"
, description = [ "The response for a sync request." ]
, init = SyncResponse
}
(Json.field.optional.value
{ fieldName = "account_data"
, toField = .accountData
, description = [ "The global private data created by this user." ]
, coder = coderAccountData
}
)
(Json.field.optional.value
{ fieldName = "device_lists"
, toField = .deviceLists
, description = [ "Information on end-to-end device updates, as specified in End-to-end encryption." ]
, coder = coderDeviceLists
}
)
(Json.field.optional.value
{ fieldName = "device_one_time_keys_count"
, toField = .deviceOneTimeKeysCount
, description = [ "Information on end-to-end encryption keys, as specified in End-to-end encryption." ]
, coder = Json.fastDict Json.int
}
)
(Json.field.required
{ fieldName = "device_unused_fallback_key_types"
, toField = .deviceUnusedFallbackKeyTypes
, description = [ "The unused fallback key algorithms." ]
, coder = Json.list Json.string
}
)
(Json.field.required
{ fieldName = "next_batch"
, toField = .nextBatch
, description = [ "The batch token to supply in the since param of the next /sync request." ]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "presence"
, toField = .presence
, description = [ "The updates to the presence status of other users." ]
, coder = coderPresence
}
)
(Json.field.optional.value
{ fieldName = "rooms"
, toField = .rooms
, description = [ "Updates to rooms." ]
, coder = coderRooms
}
)
(Json.field.optional.value
{ fieldName = "to_device"
, toField = .toDevice
, description = [ "Information on the send-to-device messages for the client device, as defined in Send-to-Device messaging." ]
, coder = coderToDevice
}
)
coderAccountData : Json.Coder AccountData
coderAccountData =
PV.coderAccountData
coderEvent : Json.Coder Event
coderEvent =
PV.coderEvent
coderPresence : Json.Coder Presence
coderPresence =
PV.coderPresence
coderRooms : Json.Coder Rooms
coderRooms =
Json.object4
{ name = "Rooms"
, description = [ "Updates to rooms." ]
, init = Rooms
}
(Json.field.optional.value
{ fieldName = "invite"
, toField = .invite
, description = [ "The rooms that the user has been invited to, mapped as room ID to room information." ]
, coder = Json.fastDict coderInvitedRoom
}
)
(Json.field.optional.value
{ fieldName = "join"
, toField = .join
, description = [ "The rooms that the user has joined, mapped as room ID to room information." ]
, coder = Json.fastDict coderJoinedRoom
}
)
(Json.field.optional.value
{ fieldName = "knock"
, toField = .knock
, description = [ "The rooms that the user has knocked upon, mapped as room ID to room information." ]
, coder = Json.fastDict coderKnockedRoom
}
)
(Json.field.optional.value
{ fieldName = "leave"
, toField = .leave
, description = [ "The rooms that the user has left or been banned from, mapped as room ID to room information." ]
, coder = Json.fastDict coderLeftRoom
}
)
coderInvitedRoom : Json.Coder InvitedRoom
coderInvitedRoom =
PV.coderInvitedRoom
coderInviteState : Json.Coder InviteState
coderInviteState =
PV.coderInviteState
coderStrippedStateEvent : Json.Coder StrippedStateEvent
coderStrippedStateEvent =
PV.coderStrippedStateEvent
coderJoinedRoom : Json.Coder JoinedRoom
coderJoinedRoom =
Json.object7
{ name = "JoinedRoom"
, description = [ "Information about a room the user has joined." ]
, init = JoinedRoom
}
(Json.field.optional.value
{ fieldName = "account_data"
, toField = .accountData
, description = [ "The private data that this user has attached to this room." ]
, coder = coderAccountData
}
)
(Json.field.optional.value
{ fieldName = "ephemeral"
, toField = .ephemeral
, description = [ "The ephemeral events in the room that arent recorded in the timeline or state of the room. e.g. typing." ]
, coder = coderEphemeral
}
)
(Json.field.optional.value
{ fieldName = "state"
, toField = .state
, description = [ "Updates to the state, between the time indicated by the since parameter, and the start of the timeline (or all state up to the start of the timeline, if since is not given, or full_state is true).", "N.B. state updates for m.room.member events will be incomplete if lazy_load_members is enabled in the /sync filter, and only return the member events required to display the senders of the timeline events in this response." ]
, coder = coderState
}
)
(Json.field.optional.value
{ fieldName = "summary"
, toField = .summary
, description = [ "Information about the room which clients may need to correctly render it to users." ]
, coder = coderRoomSummary
}
)
(Json.field.optional.value
{ fieldName = "timeline"
, toField = .timeline
, description = [ "The timeline of messages and state changes in the room." ]
, coder = coderTimeline
}
)
(Json.field.optional.value
{ fieldName = "unread_notifications"
, toField = .unreadNotifications
, description = [ "Counts of unread notifications for this room. See the Receiving notifications section for more information on how these are calculated.", "If unread_thread_notifications was specified as true on the RoomEventFilter, these counts will only be for the main timeline rather than all events in the room. See the threading module for more information.", "Changed in v1.4: Updated to reflect behaviour of having unread_thread_notifications as true in the RoomEventFilter for /sync." ]
, coder = coderUnreadNotificationCounts
}
)
(Json.field.optional.value
{ fieldName = "unread_thread_notifications"
, toField = .unreadThreadNotifications
, description = [ "If unread_thread_notifications was specified as true on the RoomEventFilter, the notification counts for each thread in this room. The object is keyed by thread root ID, with values matching unread_notifications.", "If a thread does not have any notifications it can be omitted from this object. If no threads have notification counts, this whole object can be omitted.", "Added in v1.4" ]
, coder = Json.fastDict coderThreadNotificationCounts
}
)
coderEphemeral : Json.Coder Ephemeral
coderEphemeral =
PV.coderEphemeral
coderState : Json.Coder State
coderState =
PV.coderState
coderClientEventWithoutRoomID : Json.Coder ClientEventWithoutRoomID
coderClientEventWithoutRoomID =
PV.coderClientEventWithoutRoomID
coderUnsignedData : Json.Coder UnsignedData
coderUnsignedData =
PV.coderUnsignedData
coderRoomSummary : Json.Coder RoomSummary
coderRoomSummary =
PV.coderRoomSummary
coderTimeline : Json.Coder Timeline
coderTimeline =
PV.coderTimeline
coderUnreadNotificationCounts : Json.Coder UnreadNotificationCounts
coderUnreadNotificationCounts =
PV.coderUnreadNotificationCounts
coderThreadNotificationCounts : Json.Coder ThreadNotificationCounts
coderThreadNotificationCounts =
Json.object2
{ name = "ThreadNotificationCounts"
, description = [ "The notification counts for each thread in this room." ]
, init = ThreadNotificationCounts
}
(Json.field.optional.value
{ fieldName = "highlight_count"
, toField = .highlightCount
, description = [ "The number of unread notifications for this thread with the highlight flag set." ]
, coder = Json.int
}
)
(Json.field.optional.value
{ fieldName = "notification_count"
, toField = .notificationCount
, description = [ "The total number of unread notifications for this thread." ]
, coder = Json.int
}
)
coderKnockedRoom : Json.Coder KnockedRoom
coderKnockedRoom =
PV.coderKnockedRoom
coderKnockState : Json.Coder KnockState
coderKnockState =
PV.coderKnockState
coderLeftRoom : Json.Coder LeftRoom
coderLeftRoom =
PV.coderLeftRoom
coderDeviceLists : Json.Coder DeviceLists
coderDeviceLists =
PV.coderDeviceLists
coderToDevice : Json.Coder ToDevice
coderToDevice =
PV.coderToDevice
coderToDeviceEvent : Json.Coder ToDeviceEvent
coderToDeviceEvent =
PV.coderToDeviceEvent
updateSyncResponse : { filter : Filter, since : Maybe String } -> SyncResponse -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
updateSyncResponse { filter, since } response =
-- Account data
[ response.accountData
|> Maybe.andThen .events
|> Maybe.map (List.map (\e -> V.SetAccountData e.eventType e.content))
|> Maybe.map
(\x ->
( E.ContentUpdate <| V.More x
, if List.length x > 0 then
List.length x
|> Text.logs.syncAccountDataFound
|> log.debug
|> List.singleton
else
[]
)
)
-- TODO: Add device lists
-- Next batch
, Just ( E.SetNextBatch response.nextBatch, [] )
-- TODO: Add presence
-- Rooms
, Maybe.map
(updateRooms { filter = filter, nextBatch = response.nextBatch, since = since }
>> Tuple.mapFirst E.ContentUpdate
)
response.rooms
-- TODO: Add to_device
]
|> List.filterMap identity
|> List.unzip
|> Tuple.mapFirst E.More
|> Tuple.mapSecond List.concat
updateRooms : { filter : Filter, nextBatch : String, since : Maybe String } -> Rooms -> ( V.VaultUpdate, List Log )
updateRooms { filter, nextBatch, since } rooms =
let
( roomUpdate, roomLogs ) =
rooms.join
|> Maybe.withDefault Dict.empty
|> Dict.toList
|> List.map
(\( roomId, room ) ->
let
( u, l ) =
updateJoinedRoom
{ filter = filter
, nextBatch = nextBatch
, roomId = roomId
, since = since
}
room
in
( V.MapRoom roomId u, l )
)
|> List.unzip
|> Tuple.mapBoth V.More List.concat
in
( V.More
-- Add rooms
[ rooms.join
|> Maybe.withDefault Dict.empty
|> Dict.keys
|> List.map V.CreateRoomIfNotExists
|> V.More
-- Update rooms
, roomUpdate
-- TODO: Add invited rooms
-- TODO: Add knocked rooms
-- TODO: Add left rooms
]
, roomLogs
)
updateJoinedRoom : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> JoinedRoom -> ( R.RoomUpdate, List Log )
updateJoinedRoom data room =
( R.More
[ room.accountData
|> Maybe.andThen .events
|> Maybe.map
(\events ->
events
|> List.map (\e -> R.SetAccountData e.eventType e.content)
|> R.More
)
|> R.Optional
, room.ephemeral
|> Maybe.andThen .events
|> Maybe.map R.SetEphemeral
|> R.Optional
-- TODO: Add state
-- TODO: Add RoomSummary
, room.timeline
|> Maybe.map (updateTimeline data)
|> R.Optional
-- TODO: Add unread notifications
-- TODO: Add unread thread notifications
]
, []
)
updateTimeline : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> Timeline -> R.RoomUpdate
updateTimeline =
PV.updateTimeline
toEvent : String -> ClientEventWithoutRoomID -> Event.Event
toEvent =
PV.toEvent
toUnsigned : Maybe Event.Event -> Maybe UnsignedData -> Maybe Event.UnsignedData
toUnsigned =
PV.toUnsigned

1065
src/Internal/Api/Sync/V4.elm Normal file

File diff suppressed because it is too large Load Diff

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

@ -0,0 +1,318 @@
module Internal.Api.Task exposing
( Task, run, Backpack
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
)
{-|
# 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 banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
-}
import Internal.Api.BanUser.Api
import Internal.Api.BaseUrl.Api
import Internal.Api.Chain as C
import Internal.Api.InviteUser.Api
import Internal.Api.KickUser.Api
import Internal.Api.LoginWithUsernameAndPassword.Api
import Internal.Api.Now.Api
import Internal.Api.Request as Request
import Internal.Api.SendMessageEvent.Api
import Internal.Api.SendStateEvent.Api
import Internal.Api.SetAccountData.Api
import Internal.Api.SetRoomAccountData.Api
import Internal.Api.Sync.Api
import Internal.Api.Versions.Api
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 Internal.Values.Envelope as E exposing (EnvelopeUpdate(..))
import Internal.Values.Room exposing (RoomUpdate(..))
import Internal.Values.User exposing (User)
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
{-| Ban a user from a room.
-}
banUser : { reason : Maybe String, roomId : String, user : User } -> Task
banUser input =
makeVBA
|> C.andThen (Internal.Api.BanUser.Api.banUser input)
|> finishTask
{-| 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.catchWith
(\_ ->
let
url : String
url =
Context.fromApiFormat c
|> .serverName
in
{ contextChange = Context.setBaseUrl url
, logs = [ log.warn (Text.logs.baseUrlFailed url) ]
, messages = [ E.SetBaseUrl url ]
}
)
|> (|>) 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
}
)
{-| Invite a user to a room.
-}
inviteUser : { reason : Maybe String, roomId : String, user : User } -> Task
inviteUser input =
makeVBA
|> C.andThen (Internal.Api.InviteUser.Api.inviteUser input)
|> finishTask
{-| Kick a user from a room.
-}
kickUser :
{ avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
-> Task
kickUser input =
makeVBA
|> C.andThen (Internal.Api.KickUser.Api.kickUser input)
|> finishTask
{-| 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
{-| Send a state event to a room.
-}
sendStateEvent : { content : Json.Value, eventType : String, roomId : String, stateKey : String } -> Task
sendStateEvent input =
makeVBA
|> C.andThen (Internal.Api.SendStateEvent.Api.sendStateEvent input)
|> finishTask
{-| Set global account data.
-}
setAccountData : { content : Json.Value, eventType : String, userId : String } -> Task
setAccountData input =
makeVBA
|> C.andThen (Internal.Api.SetAccountData.Api.setAccountData input)
|> finishTask
{-| Set account data for a Matrix room.
-}
setRoomAccountData : { content : Json.Value, eventType : String, roomId : String, userId : String } -> Task
setRoomAccountData input =
makeVBA
|> C.andThen (Internal.Api.SetRoomAccountData.Api.setRoomAccountData input)
|> finishTask
{-| Sync with the Matrix API to stay up-to-date.
-}
sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task
sync input =
makeVBA
|> C.andThen (Internal.Api.Sync.Api.sync 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

View File

@ -0,0 +1,90 @@
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 theyve 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, [] )
}
)

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.1.0"
"beta 3.5.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

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

View File

@ -112,23 +112,32 @@ 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
, ibatch : TypeDocs
, iddict : TypeDocs
, itoken : TypeDocs
, mashdict : TypeDocs
, room : TypeDocs
, settings : TypeDocs
, stateManager : TypeDocs
, strippedEvent : TypeDocs
, timeline : TypeDocs
, 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."
@ -160,12 +169,6 @@ docs =
[ "The internal batch tracks a patch of events on the Matrix timeline."
]
}
, iddict =
{ name = "Iddict"
, description =
[ "An iddict automatically handles creating appropriate keys by incrementally assiging a new key to new values."
]
}
, itoken =
{ name = "IToken"
, description =
@ -197,6 +200,12 @@ docs =
, "Instead of making the user loop through the room's timeline of events, the StateManager offers the user a dictionary-like experience to navigate through the Matrix room state."
]
}
, strippedEvent =
{ name = "StrippedEvent"
, description =
[ "The StrippedEvent is a simplified Matrix event that contains no metadata."
]
}
, timeline =
{ name = "Timeline"
, description =
@ -216,6 +225,18 @@ docs =
, "This information is often supportive but not necessary to the context."
]
}
, vault =
{ name = "Vault"
, description =
[ "Main type storing all relevant information from the Matrix API."
]
}
, versions =
{ name = "Versions"
, description =
[ "Versions type describing the supported spec versions and MSC properties."
]
}
}
@ -237,13 +258,27 @@ 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
, nextBatch : Desc
, now : Desc
, password : Desc
, refreshToken : Desc
, username : Desc
, serverName : Desc
, suggestedAccessToken : Desc
, transaction : Desc
, user : Desc
, versions : Desc
}
, envelope :
@ -280,6 +315,7 @@ fields :
}
, room :
{ accountData : Desc
, ephemeral : Desc
, events : Desc
, roomId : Desc
, state : Desc
@ -288,6 +324,8 @@ fields :
, settings :
{ currentVersion : Desc
, deviceName : Desc
, presence : Desc
, removePasswordOnLogin : Desc
, syncTime : Desc
}
, timeline :
@ -305,31 +343,76 @@ fields :
}
, unsigned :
{ age : Desc
, membership : Desc
, prevContent : Desc
, redactedBecause : Desc
, transactionId : Desc
}
, vault :
{ accountData : Desc
, nextBatch : 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."
]
, nextBatch =
[ "The batch token to supply in the since param of the next /sync request."
]
, 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."
]
, user =
[ "The Matrix user the Vault is representing."
]
, versions =
[ "The versions of the Matrix protocol that are supported by the server."
]
@ -415,6 +498,9 @@ fields =
, room =
{ accountData =
[ "Room account data tracking the user's private storage about this room." ]
, ephemeral =
[ "Ephemeral events that were sent recently in this room."
]
, events =
[ "Database containing events that were sent in this room." ]
, roomId =
@ -431,6 +517,12 @@ fields =
, deviceName =
[ "Indicates the device name that is communicated to the Matrix API."
]
, presence =
[ "Controls whether the client is automatically marked as online. The value is passed on 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."
]
@ -473,6 +565,9 @@ fields =
{ age =
[ "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."
]
, membership =
[ "The room membership of the user making the request, at the time of the event."
]
, prevContent =
[ "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."
]
@ -483,6 +578,27 @@ fields =
[ "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."
]
}
, vault =
{ accountData =
[ "The account's global private data."
]
, nextBatch =
[ "The next batch that can be used to sync with the Matrix API."
]
, 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." ]
}
}
@ -516,15 +632,60 @@ 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 :
{ baseUrlFailed : String -> String
, 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
, syncAccountDataFound : Int -> String
}
logs =
{ keyIsNotAnInt =
{ baseUrlFailed =
(++) "Failed to find .well-known, using default server address: "
, 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: "
, syncAccountDataFound =
\n -> String.concat [ "Found ", String.fromInt n, " account data updates" ]
}

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)
@ -185,7 +183,6 @@ coder =
, description = Text.fields.timelineFilter.senders
, coder = Json.set Json.string
, default = ( Set.empty, [] )
, defaultToString = always "[]"
}
)
(Json.field.required
@ -201,7 +198,6 @@ coder =
, description = Text.fields.timelineFilter.types
, coder = Json.set Json.string
, default = ( Set.empty, [] )
, defaultToString = always "[]"
}
)
(Json.field.required

View File

@ -189,21 +189,20 @@ ipv6RightParser n =
|. P.symbol ":"
{-| Convert an IPv6 address to a readable string format
-}
ipv6ToString : IPv6Address -> String
ipv6ToString { front, back } =
(if List.length front == 8 then
front
else if List.length back == 8 then
back
else
List.concat [ front, [ "" ], back ]
)
|> List.intersperse ":"
|> String.concat
-- {-| Convert an IPv6 address to a readable string format
-- -}
-- ipv6ToString : IPv6Address -> String
-- ipv6ToString { front, back } =
-- (if List.length front == 8 then
-- front
-- else if List.length back == 8 then
-- back
-- else
-- List.concat [ front, [ "" ], back ]
-- )
-- |> List.intersperse ":"
-- |> String.concat
portParser : Parser Int

View File

@ -1,6 +1,6 @@
module Internal.Tools.DecodeExtra exposing
( opField, opFieldWithDefault
, map9, map10, map11
, map9, map10, map11, map12, map13
)
{-|
@ -18,7 +18,7 @@ This module contains helper functions that help decode JSON.
## Extended map functions
@docs map9, map10, map11
@docs map9, map10, map11, map12, map13
-}
@ -153,3 +153,68 @@ map11 func da db dc dd de df dg dh di dj dk =
(D.map2 Tuple.pair df dg)
(D.map2 Tuple.pair dh di)
(D.map2 Tuple.pair dj dk)
{-| Try 12 decoders and combine the result.
-}
map12 :
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> value)
-> D.Decoder a
-> D.Decoder b
-> D.Decoder c
-> D.Decoder d
-> D.Decoder e
-> D.Decoder f
-> D.Decoder g
-> D.Decoder h
-> D.Decoder i
-> D.Decoder j
-> D.Decoder k
-> D.Decoder l
-> D.Decoder value
map12 func da db dc dd de df dg dh di dj dk dl =
D.map8
(\a b c d ( e, f ) ( g, h ) ( i, j ) ( k, l ) ->
func a b c d e f g h i j k l
)
da
db
dc
dd
(D.map2 Tuple.pair de df)
(D.map2 Tuple.pair dg dh)
(D.map2 Tuple.pair di dj)
(D.map2 Tuple.pair dk dl)
{-| Try 12 decoders and combine the result.
-}
map13 :
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> value)
-> D.Decoder a
-> D.Decoder b
-> D.Decoder c
-> D.Decoder d
-> D.Decoder e
-> D.Decoder f
-> D.Decoder g
-> D.Decoder h
-> D.Decoder i
-> D.Decoder j
-> D.Decoder k
-> D.Decoder l
-> D.Decoder m
-> D.Decoder value
map13 func da db dc dd de df dg dh di dj dk dl dm =
D.map8
(\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) ->
func a b c d e f g h i j k l m
)
da
db
dc
(D.map2 Tuple.pair dd de)
(D.map2 Tuple.pair df dg)
(D.map2 Tuple.pair dh di)
(D.map2 Tuple.pair dj dk)
(D.map2 Tuple.pair dl dm)

View File

@ -3,7 +3,7 @@ module Internal.Tools.Hashdict exposing
, empty, singleton, insert, remove, removeKey
, isEmpty, member, memberKey, get, size, isEqual
, keys, values, toList, fromList
, rehash, union, map
, rehash, union, map, update
, coder, encode, decoder, softDecoder
)
@ -35,7 +35,7 @@ This allows you to store values based on an externally defined identifier.
## Transform
@docs rehash, union, map
@docs rehash, union, map, update
## JSON coders
@ -321,6 +321,23 @@ union (Hashdict h1) hd2 =
}
{-| Update a dict to maybe contain a value (or not). If the output does not
have the originally expected key, it is not updated.
-}
update : String -> (Maybe a -> Maybe a) -> Hashdict a -> Hashdict a
update key f ((Hashdict h) as hd) =
case f (get key hd) of
Just v ->
if h.hash v == key then
insert v hd
else
hd
Nothing ->
removeKey key hd
{-| Get all values stored in the hashdict, in the order of their keys.
-}
values : Hashdict a -> List a

View File

@ -1,198 +0,0 @@
module Internal.Tools.Iddict exposing
( Iddict
, empty, singleton, insert, map, remove
, isEmpty, member, get, size
, keys, values
, coder, encode, decoder
)
{-| The id-dict is a data type that lets us store values in a dictionary using
unique identifiers. This can be used as a dictionary where the keys do not
matter.
The benefit of the iddict is that it generates the keys FOR you. This way, you
do not need to generate identifiers yourself.
## Id-dict
@docs Iddict
## Build
@docs empty, singleton, insert, map, remove
## Query
@docs isEmpty, member, get, size
## Lists
@docs keys, values
## JSON coders
@docs coder, encode, decoder
-}
import FastDict as Dict exposing (Dict)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
{-| The Iddict data type.
-}
type Iddict a
= Iddict
{ cursor : Int
, dict : Dict Int a
}
{-| Define how an Iddict can be encoded and decoded to and from a JSON value.
-}
coder : Json.Coder a -> Json.Coder (Iddict a)
coder x =
Json.object2
{ name = Text.docs.iddict.name
, description = Text.docs.iddict.description
, init =
\c d ->
Iddict
{ cursor =
Dict.keys d
|> List.maximum
|> Maybe.map ((+) 1)
|> Maybe.withDefault 0
|> max (Dict.size d)
|> max c
, dict = d
}
}
(Json.field.optional.withDefault
{ fieldName = "cursor"
, toField = \(Iddict i) -> i.cursor
, description = Text.fields.iddict.cursor
, coder = Json.int
, default = ( 0, [] )
, defaultToString = String.fromInt
}
)
(Json.field.required
{ fieldName = "dict"
, toField = \(Iddict i) -> i.dict
, description = Text.fields.iddict.dict
, coder = Json.fastIntDict x
}
)
{-| Decode an id-dict from a JSON value.
-}
decoder : Json.Coder a -> Json.Decoder (Iddict a)
decoder x =
Json.decode (coder x)
{-| Create an empty id-dict.
-}
empty : Iddict a
empty =
Iddict
{ cursor = 0
, dict = Dict.empty
}
{-| Encode an id-dict to a JSON value.
-}
encode : Json.Coder a -> Json.Encoder (Iddict a)
encode x =
Json.encode (coder x)
{-| Get a value from the id-dict using its key.
-}
get : Int -> Iddict a -> Maybe a
get k (Iddict { dict }) =
Dict.get k dict
{-| Insert a new value into the id-dict. Given that the id-dict generates its
key, the function returns both the updated id-dict as the newly generated key.
x = empty |> insert "hello" -- ( 0, <Iddict with value "hello"> )
case x of
( _, iddict ) ->
get 0 iddict -- Just "hello"
-}
insert : a -> Iddict a -> ( Int, Iddict a )
insert v (Iddict d) =
( d.cursor
, Iddict { cursor = d.cursor + 1, dict = Dict.insert d.cursor v d.dict }
)
{-| Determine if an id-dict is empty.
-}
isEmpty : Iddict a -> Bool
isEmpty (Iddict d) =
Dict.isEmpty d.dict
{-| Get all of the keys from the id-dict, sorted from lowest to highest.
-}
keys : Iddict a -> List Int
keys (Iddict { dict }) =
Dict.keys dict
{-| Map an existing value at a given key, if it exists. If it does not exist,
the operation does nothing.
-}
map : Int -> (a -> a) -> Iddict a -> Iddict a
map k f (Iddict d) =
Iddict { d | dict = Dict.update k (Maybe.map f) d.dict }
{-| Determine if a key is in an id-dict.
-}
member : Int -> Iddict a -> Bool
member k (Iddict d) =
k < d.cursor && Dict.member k d.dict
{-| Remove a key-value pair from the id-dict. If the key is not found, no
changes are made.
-}
remove : Int -> Iddict a -> Iddict a
remove k (Iddict d) =
Iddict { d | dict = Dict.remove k d.dict }
{-| Create an id-dict with a single value.
-}
singleton : a -> ( Int, Iddict a )
singleton v =
insert v empty
{-| Determine the number of key-value pairs in the id-dict.
-}
size : Iddict a -> Int
size (Iddict d) =
Dict.size d.dict
{-| Get all of the values from an id-dict, in the order of their keys.
-}
values : Iddict a -> List a
values (Iddict { dict }) =
Dict.values dict

View File

@ -1,11 +1,11 @@
module Internal.Tools.Json exposing
( Coder, string, bool, int, float, value
( Coder, string, bool, int, float, value, unit
, Encoder, encode, Decoder, decode, Value
, succeed, fail, andThen, lazy, map
, Docs(..), RequiredField(..), toDocs
, list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe
, list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
, Field, field, parser
, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
, object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
)
{-|
@ -29,7 +29,7 @@ data types. Because this module uses dynamic builder types, this also means it
is relatively easy to write documentation for any data type that uses this
module to build its encoders and decoders.
@docs Coder, string, bool, int, float, value
@docs Coder, string, bool, int, float, value, unit
## JSON Coding
@ -49,7 +49,7 @@ module to build its encoders and decoders.
## Data types
@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe
@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
## Objects
@ -62,12 +62,13 @@ first.
Once all fields are constructed, the user can create JSON objects.
@docs object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
-}
import Dict as SlowDict
import FastDict
import Iddict exposing (Iddict)
import Internal.Config.Log as Log exposing (Log)
import Internal.Config.Text as Text
import Internal.Tools.DecodeExtra as D
@ -141,6 +142,7 @@ type Docs
= DocsBool
| DocsDict Docs
| DocsFloat
| DocsIddict Docs
| DocsInt
| DocsIntDict Docs
| DocsLazy (() -> Docs)
@ -163,6 +165,7 @@ type Docs
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
| DocsSet Docs
| DocsString
| DocsUnit
| DocsValue
@ -362,7 +365,7 @@ then the following field type would be used:
, coder = string
}
Suppose the JSO isn't obligated to provide a list of hobbies, and the list would
Suppose the JSON isn't obligated to provide a list of hobbies, and the list would
by default be overriden with an empty list, then we would use the following
field type:
@ -373,8 +376,7 @@ field type:
[ "The hobbies of the person. Can be omitted."
]
, coder = list string
, default = ( [], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default
, defaultToString = always "[]" -- Default converted to a string
, default = ( [ "football" ], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default
}
-}
@ -382,7 +384,7 @@ field :
{ required : { fieldName : String, toField : object -> a, description : List String, coder : Coder a } -> Field a object
, optional :
{ value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : Coder a } -> Field (Maybe a) object
, withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object
, withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ) } -> Field a object
}
}
field =
@ -425,7 +427,7 @@ field =
, requiredness = OptionalField
}
, withDefault =
\{ fieldName, toField, description, coder, default, defaultToString } ->
\{ fieldName, toField, description, coder, default } ->
case coder of
Coder { encoder, decoder, docs } ->
Field
@ -449,7 +451,8 @@ field =
, requiredness =
default
|> Tuple.first
|> defaultToString
|> encoder
|> E.encode 0
|> OptionalFieldWithDefault
}
}
@ -467,6 +470,26 @@ float =
}
{-| Define an Iddict as defined in
[noordstar/elm-iddict](https://package.elm-lang.org/packages/noordstar/elm-iddict/latest/).
-}
iddict : Coder a -> Coder (Iddict a)
iddict (Coder old) =
Coder
{ encoder = Iddict.encode old.encoder
, decoder =
Iddict.decoder old.decoder
|> D.map
(\out ->
( Iddict.map (always Tuple.first) out
, Iddict.values out
|> List.concatMap Tuple.second
)
)
, docs = DocsIddict old.docs
}
{-| Define an int value.
-}
int : Coder Int
@ -596,6 +619,23 @@ objectEncoder items object =
|> E.maybeObject
object1 :
Descriptive { init : a -> object }
-> Field a object
-> Coder object
object1 { name, description, init } fa =
Coder
{ encoder = objectEncoder [ toEncodeField fa ]
, decoder = D.map (Tuple.mapFirst init) (toDecoderField fa)
, docs =
DocsObject
{ name = name
, description = description
, keys = [ toDocsField fa ]
}
}
{-| Define an object with 2 keys
type alias Human =
@ -1158,6 +1198,160 @@ object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk =
}
{-| Define an object with 12 keys
-}
object12 :
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> object }
-> Field a object
-> Field b object
-> Field c object
-> Field d object
-> Field e object
-> Field f object
-> Field g object
-> Field h object
-> Field i object
-> Field j object
-> Field k object
-> Field l object
-> Coder object
object12 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl =
Coder
{ encoder =
objectEncoder
[ toEncodeField fa
, toEncodeField fb
, toEncodeField fc
, toEncodeField fd
, toEncodeField fe
, toEncodeField ff
, toEncodeField fg
, toEncodeField fh
, toEncodeField fi
, toEncodeField fj
, toEncodeField fk
, toEncodeField fl
]
, decoder =
D.map12
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ->
( init a b c d e f g h i j k l
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll ]
)
)
(toDecoderField fa)
(toDecoderField fb)
(toDecoderField fc)
(toDecoderField fd)
(toDecoderField fe)
(toDecoderField ff)
(toDecoderField fg)
(toDecoderField fh)
(toDecoderField fi)
(toDecoderField fj)
(toDecoderField fk)
(toDecoderField fl)
, docs =
DocsObject
{ name = name
, description = description
, keys =
[ toDocsField fa
, toDocsField fb
, toDocsField fc
, toDocsField fd
, toDocsField fe
, toDocsField ff
, toDocsField fg
, toDocsField fh
, toDocsField fi
, toDocsField fj
, toDocsField fk
, toDocsField fl
]
}
}
{-| Define an object with 13 keys
-}
object13 :
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> object }
-> Field a object
-> Field b object
-> Field c object
-> Field d object
-> Field e object
-> Field f object
-> Field g object
-> Field h object
-> Field i object
-> Field j object
-> Field k object
-> Field l object
-> Field m object
-> Coder object
object13 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl fm =
Coder
{ encoder =
objectEncoder
[ toEncodeField fa
, toEncodeField fb
, toEncodeField fc
, toEncodeField fd
, toEncodeField fe
, toEncodeField ff
, toEncodeField fg
, toEncodeField fh
, toEncodeField fi
, toEncodeField fj
, toEncodeField fk
, toEncodeField fl
, toEncodeField fm
]
, decoder =
D.map13
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ( m, lm ) ->
( init a b c d e f g h i j k l m
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll, lm ]
)
)
(toDecoderField fa)
(toDecoderField fb)
(toDecoderField fc)
(toDecoderField fd)
(toDecoderField fe)
(toDecoderField ff)
(toDecoderField fg)
(toDecoderField fh)
(toDecoderField fi)
(toDecoderField fj)
(toDecoderField fk)
(toDecoderField fl)
(toDecoderField fm)
, docs =
DocsObject
{ name = name
, description = description
, keys =
[ toDocsField fa
, toDocsField fb
, toDocsField fc
, toDocsField fd
, toDocsField fe
, toDocsField ff
, toDocsField fg
, toDocsField fh
, toDocsField fi
, toDocsField fj
, toDocsField fk
, toDocsField fl
, toDocsField fm
]
}
}
{-| Define a parser that converts a string into a custom Elm type.
-}
parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a
@ -1269,6 +1463,18 @@ toEncodeField (Field data) =
( data.fieldName, data.toField >> data.encoder )
{-| Completely ignore whatever needs to be encoded, and simply return a unit
value.
-}
unit : Coder ()
unit =
Coder
{ encoder = \() -> E.object []
, decoder = D.succeed ( (), [] )
, docs = DocsUnit
}
{-| Do not do anything useful with a JSON value, just bring it to Elm as a
JavaScript value.
-}

View File

@ -1,8 +1,21 @@
module Internal.Tools.ParserExtra exposing (..)
module Internal.Tools.ParserExtra exposing (zeroOrMore, oneOrMore, exactly, atLeast, atMost, times, maxLength)
{-|
# Extra parsers
To help the Elm SDK with parsing complex text values, this modules offers a few functions.
@docs zeroOrMore, oneOrMore, exactly, atLeast, atMost, times, maxLength
-}
import Parser as P exposing ((|.), (|=), Parser)
{-| Parses an item zero or more times. The result is combined into a list.
-}
zeroOrMore : Parser a -> Parser (List a)
zeroOrMore parser =
P.loop []
@ -15,6 +28,9 @@ zeroOrMore parser =
)
{-| Parses an item at least once, but up to any number of times.
The result is combined into a list.
-}
oneOrMore : Parser a -> Parser (List a)
oneOrMore parser =
P.succeed (::)
@ -22,6 +38,9 @@ oneOrMore parser =
|= zeroOrMore parser
{-| Parses an item at least a given number of times, but up to any number.
The result is combined into a list.
-}
atLeast : Int -> Parser a -> Parser (List a)
atLeast n parser =
P.loop []
@ -39,6 +58,10 @@ atLeast n parser =
)
{-| Parses an item any number of times (can be zero), but does not exceed a
given number of times.
The result is combined into a list.
-}
atMost : Int -> Parser a -> Parser (List a)
atMost n parser =
P.loop []
@ -55,6 +78,10 @@ atMost n parser =
)
{-| Parses an item a given number of times, ranging from the given minimum up
to the given maximum.
The result is combined into a list.
-}
times : Int -> Int -> Parser a -> Parser (List a)
times inf sup parser =
let
@ -84,11 +111,21 @@ times inf sup parser =
)
{-| Repeat pasing an item an exact number of times.
The result is combined into a list.
-}
exactly : Int -> Parser a -> Parser (List a)
exactly n =
times n n
{-| After having parsed the item, make sure that the parsed text has not
exceeded a given length. If so, the parser fails.
This modification can be useful if a text has a maximum length requirement -
for example, usernames on Matrix cannot have a length of over 255 characters.
-}
maxLength : Int -> Parser a -> Parser a
maxLength n parser =
P.succeed

View File

@ -0,0 +1,51 @@
module Internal.Tools.StrippedEvent exposing (StrippedEvent, coder, strip)
{-|
# Stripped event
The stripped event is a simple Matrix event that does not contain any metadata.
@docs StrippedEvent, coder, strip
-}
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
type alias StrippedEvent =
{ content : Json.Value, eventType : String }
coder : Json.Coder StrippedEvent
coder =
Json.object2
{ name = Text.docs.strippedEvent.name
, description = Text.docs.strippedEvent.description
, init = StrippedEvent
}
(Json.field.required
{ fieldName = "content"
, toField = .content
, description =
[ "Event content"
]
, coder = Json.value
}
)
(Json.field.required
{ fieldName = "type"
, toField = .eventType
, description =
[ "Event type, generally namespaced using the Java package naming convention."
]
, coder = Json.string
}
)
strip : { a | content : Json.Value, eventType : String } -> StrippedEvent
strip { content, eventType } =
{ content = content, eventType = eventType }

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

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,54 @@ 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 Internal.Values.User as User exposing (User)
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
, nextBatch : 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)
, user : Maybe User
, username : Maybe String
, versions : Maybe Versions
}
@ -77,38 +117,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.object13
{ 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 +173,27 @@ 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 = "nextBatch"
, toField = .nextBatch
, description = Text.fields.context.nextBatch
, 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 +208,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 +229,71 @@ coder =
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "user"
, toField = .user
, description = Text.fields.context.user
, coder = User.coder
}
)
(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 +314,59 @@ encode =
{-| A basic, untouched version of the Context, containing no information.
-}
init : Context
init =
{ accessToken = Nothing
init : String -> Maybe User -> Context
init sn mu =
{ accessTokens = Hashdict.empty .value
, baseUrl = Nothing
, deviceId = Nothing
, nextBatch = Nothing
, now = Nothing
, refreshToken = Nothing
, password = Nothing
, username = Nothing
, serverName = sn
, suggestedAccessToken = Nothing
, transaction = Nothing
, user = mu
, 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 +395,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 +425,37 @@ 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, [] )
}
)

View File

@ -4,6 +4,7 @@ module Internal.Values.Envelope exposing
, Settings, mapSettings, extractSettings
, mapContext
, getContent, extract
, EnvelopeUpdate(..), update
, coder, encode, decoder
)
@ -36,16 +37,28 @@ settings that can be adjusted manually.
@docs getContent, extract
## Update
@docs EnvelopeUpdate, update
## JSON coders
@docs coder, encode, decoder
-}
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
import Internal.Values.User exposing (User)
import Recursion
import Recursion.Fold
{-| There are lots of different data types in the Elm SDK, and many of them
@ -60,6 +73,25 @@ type alias Envelope a =
}
{-| The Envelope update type helps update either the envelope or a content type.
-}
type EnvelopeUpdate a
= ContentUpdate a
| HttpRequest (Request.Request ( Request.Error, List Log ) ( EnvelopeUpdate a, List Log ))
| More (List (EnvelopeUpdate a))
| Optional (Maybe (EnvelopeUpdate a))
| RemoveAccessToken String
| RemovePasswordIfNecessary
| SetAccessToken AccessToken
| SetBaseUrl String
| SetDeviceId String
| SetNextBatch String
| SetNow Timestamp
| SetRefreshToken String
| SetUser User
| SetVersions Versions
{-| Settings value from
[Internal.Values.Settings](Internal-Values-Settings#Settings). Can be used to
manipulate the Matrix Vault.
@ -97,7 +129,6 @@ coder c1 =
, description = Text.fields.envelope.settings
, coder = Settings.coder
, default = Tuple.pair Settings.init []
, defaultToString = always "<Default settings>"
}
)
@ -159,10 +190,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 : { content : a, serverName : String, user : Maybe User } -> Envelope a
init data =
{ content = data.content
, context = Context.init data.serverName data.user
, settings = Settings.init
}
@ -260,3 +291,102 @@ toMaybe data =
Maybe.map
(\content -> map (always content) data)
data.content
{-| Updates the Envelope with a given EnvelopeUpdate value.
-}
update : (au -> a -> a) -> EnvelopeUpdate au -> Envelope a -> Envelope a
update updateContent eu startData =
Recursion.runRecursion
(\updt ->
case updt of
ContentUpdate v ->
Recursion.base
(\data ->
{ data | content = updateContent v data.content }
)
HttpRequest _ ->
Recursion.base identity
More items ->
Recursion.Fold.foldList (<<) identity items
Optional (Just u) ->
Recursion.recurse u
Optional Nothing ->
Recursion.base identity
RemoveAccessToken token ->
Recursion.base
(\({ context } as data) ->
{ data
| context =
{ context
| accessTokens =
Hashdict.removeKey token context.accessTokens
}
}
)
RemovePasswordIfNecessary ->
Recursion.base
(\({ context } as data) ->
if data.settings.removePasswordOnLogin then
{ data | context = { context | password = Nothing } }
else
data
)
SetAccessToken a ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | accessTokens = Hashdict.insert a context.accessTokens } }
)
SetBaseUrl b ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | baseUrl = Just b } }
)
SetDeviceId d ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | deviceId = Just d } }
)
SetNextBatch nextBatch ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | nextBatch = Just nextBatch } }
)
SetNow n ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | now = Just n } }
)
SetRefreshToken r ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | refreshToken = Just r } }
)
SetUser u ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | user = Just u } }
)
SetVersions vs ->
Recursion.base
(\({ context } as data) ->
{ data | context = { context | versions = Just vs } }
)
)
eu
startData

View File

@ -59,6 +59,7 @@ helper functions.
type UnsignedData
= UnsignedData
{ age : Maybe Int
, membership : Maybe String
, prevContent : Maybe Json.Value
, redactedBecause : Maybe Event
, transactionId : Maybe String
@ -242,10 +243,10 @@ transactionId event =
unsignedCoder : Json.Coder UnsignedData
unsignedCoder =
Json.object4
Json.object5
{ name = Text.docs.unsigned.name
, description = Text.docs.unsigned.description
, init = \a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }
, init = \a b c d e -> UnsignedData { age = a, membership = b, prevContent = c, redactedBecause = d, transactionId = e }
}
(Json.field.optional.value
{ fieldName = "age"
@ -254,6 +255,13 @@ unsignedCoder =
, coder = Json.int
}
)
(Json.field.optional.value
{ fieldName = "membership"
, toField = \(UnsignedData data) -> data.membership
, description = Text.fields.unsigned.membership
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "prevContent"
, toField = \(UnsignedData data) -> data.prevContent

View File

@ -1,5 +1,6 @@
module Internal.Values.Room exposing
( Room, init
, RoomUpdate(..), update
, Batch, addBatch, addSync, addEvents, mostRecentEvents
, getAccountData, setAccountData
, coder, encode, decode
@ -25,6 +26,11 @@ room state reflect the homeserver state of the room.
@docs Room, init
## Update
@docs RoomUpdate, update
## Timeline
@docs Batch, addBatch, addSync, addEvents, mostRecentEvents
@ -47,10 +53,13 @@ import Internal.Config.Text as Text
import Internal.Filter.Timeline as Filter exposing (Filter)
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Tools.Json as Json
import Internal.Tools.StrippedEvent as StrippedEvent exposing (StrippedEvent)
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 Json.Encode as E
import Internal.Values.User exposing (User)
import Recursion
import Recursion.Fold
{-| The Batch is a group of new events from somewhere in the timeline.
@ -64,6 +73,7 @@ homeserver.
-}
type alias Room =
{ accountData : Dict String Json.Value
, ephemeral : List StrippedEvent
, events : Hashdict Event
, roomId : String
, state : StateManager
@ -71,6 +81,19 @@ type alias Room =
}
{-| The RoomUpdate type explains how to update a room based on new information
from the Matrix API.
-}
type RoomUpdate
= AddEvent Event
| AddSync Batch
| Invite User
| More (List RoomUpdate)
| Optional (Maybe RoomUpdate)
| SetAccountData String Json.Value
| SetEphemeral (List { eventType : String, content : Json.Value })
{-| Add new events to the Room's event directory + Room's timeline.
-}
addEventsToTimeline : (Timeline.Batch -> Timeline -> Timeline) -> Batch -> Room -> Room
@ -122,7 +145,7 @@ addSync =
-}
coder : Json.Coder Room
coder =
Json.object5
Json.object6
{ name = Text.docs.room.name
, description = Text.docs.room.description
, init = Room
@ -133,7 +156,14 @@ coder =
, description = Text.fields.room.accountData
, coder = Json.fastDict Json.value
, default = ( Dict.empty, [] )
, defaultToString = Json.encode (Json.fastDict Json.value) >> E.encode 0
}
)
(Json.field.optional.withDefault
{ fieldName = "ephemeral"
, toField = .ephemeral
, description = Text.fields.room.ephemeral
, coder = Json.list StrippedEvent.coder
, default = ( [], [] )
}
)
(Json.field.optional.withDefault
@ -142,7 +172,6 @@ coder =
, description = Text.fields.room.events
, coder = Hashdict.coder .eventId Event.coder
, default = ( Hashdict.empty .eventId, [ log.warn "Found a room with no known events! Is it empty?" ] )
, defaultToString = Json.encode (Hashdict.coder .eventId Event.coder) >> E.encode 0
}
)
(Json.field.required
@ -158,7 +187,6 @@ coder =
, description = Text.fields.room.state
, coder = StateManager.coder
, default = ( StateManager.empty, [] )
, defaultToString = Json.encode StateManager.coder >> E.encode 0
}
)
(Json.field.optional.withDefault
@ -167,7 +195,6 @@ coder =
, description = Text.fields.room.timeline
, coder = Timeline.coder
, default = ( Timeline.empty, [] )
, defaultToString = Json.encode Timeline.coder >> E.encode 0
}
)
@ -198,6 +225,7 @@ getAccountData key room =
init : String -> Room
init roomId =
{ accountData = Dict.empty
, ephemeral = []
, events = Hashdict.empty .eventId
, roomId = roomId
, state = StateManager.empty
@ -223,3 +251,40 @@ mostRecentEvents room =
setAccountData : String -> Json.Value -> Room -> Room
setAccountData key value room =
{ room | accountData = Dict.insert key value room.accountData }
{-| Update the Room based on given instructions.
-}
update : RoomUpdate -> Room -> Room
update roomUpdate startRoom =
Recursion.runRecursion
(\ru ->
case ru of
AddEvent _ ->
-- TODO: Add event
Recursion.base identity
AddSync batch ->
Recursion.base (addSync batch)
Invite _ ->
-- TODO: Invite user
Recursion.base identity
More items ->
Recursion.Fold.foldList (<<) identity items
Optional (Just u) ->
Recursion.recurse u
Optional Nothing ->
Recursion.base identity
SetAccountData key value ->
Recursion.base (setAccountData key value)
SetEphemeral eph ->
Recursion.base (\room -> { room | ephemeral = eph })
)
roomUpdate
startRoom

View File

@ -35,6 +35,8 @@ behave under the user's preferred settings.
type alias Settings =
{ currentVersion : String
, deviceName : String
, presence : Maybe String
, removePasswordOnLogin : Bool
, syncTime : Int
}
@ -43,7 +45,7 @@ type alias Settings =
-}
coder : Json.Coder Settings
coder =
Json.object3
Json.object5
{ name = Text.docs.settings.name
, description = Text.docs.settings.description
, init = Settings
@ -54,7 +56,6 @@ coder =
, description = Text.fields.settings.currentVersion
, coder = Json.string
, default = Tuple.pair Default.currentVersion []
, defaultToString = identity
}
)
(Json.field.optional.withDefault
@ -63,7 +64,21 @@ coder =
, description = Text.fields.settings.deviceName
, coder = Json.string
, default = Tuple.pair Default.deviceName []
, defaultToString = identity
}
)
(Json.field.optional.value
{ fieldName = "presence"
, toField = .presence
, description = Text.fields.settings.presence
, coder = Json.string
}
)
(Json.field.optional.withDefault
{ fieldName = "removePasswordOnLogin"
, toField = .removePasswordOnLogin
, description = Text.fields.settings.removePasswordOnLogin
, coder = Json.bool
, default = Tuple.pair Default.removePasswordOnLogin []
}
)
(Json.field.optional.withDefault
@ -72,7 +87,6 @@ coder =
, description = Text.fields.settings.syncTime
, coder = Json.int
, default = Tuple.pair Default.syncTime []
, defaultToString = String.fromInt
}
)
@ -97,5 +111,7 @@ init : Settings
init =
{ currentVersion = Default.currentVersion
, deviceName = Default.deviceName
, presence = Nothing
, removePasswordOnLogin = Default.removePasswordOnLogin
, syncTime = Default.syncTime
}

View File

@ -67,10 +67,10 @@ events!
-}
import FastDict as Dict exposing (Dict)
import Iddict exposing (Iddict)
import Internal.Config.Text as Text
import Internal.Filter.Timeline as Filter exposing (Filter)
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Tools.Iddict as Iddict exposing (Iddict)
import Internal.Tools.Json as Json
import Recursion
import Recursion.Traverse
@ -210,7 +210,7 @@ coder =
{ fieldName = "batches"
, toField = \(Timeline t) -> t.batches
, description = Text.fields.timeline.batches
, coder = Iddict.coder coderIBatch
, coder = Json.iddict coderIBatch
}
)
(Json.field.required
@ -226,7 +226,6 @@ coder =
, description = Text.fields.timeline.filledBatches
, coder = Json.int
, default = ( 0, [] )
, defaultToString = String.fromInt
}
)
(Json.field.required
@ -326,7 +325,6 @@ coderIToken =
, description = Text.fields.itoken.starts
, coder = Json.set coderIBatchPTRValue
, default = ( Set.empty, [] )
, defaultToString = always "[]"
}
)
(Json.field.optional.withDefault
@ -335,7 +333,6 @@ coderIToken =
, description = Text.fields.itoken.ends
, coder = Json.set coderIBatchPTRValue
, default = ( Set.empty, [] )
, defaultToString = always "[]"
}
)
(Json.field.optional.withDefault
@ -344,7 +341,6 @@ coderIToken =
, description = Text.fields.itoken.inFrontOf
, coder = Json.set coderITokenPTRValue
, default = ( Set.empty, [] )
, defaultToString = always "[]"
}
)
(Json.field.optional.withDefault
@ -353,7 +349,6 @@ coderIToken =
, description = Text.fields.itoken.behind
, coder = Json.set coderITokenPTRValue
, default = ( Set.empty, [] )
, defaultToString = always "[]"
}
)
@ -411,8 +406,8 @@ connectIBatchToIToken (IBatchPTR bptr) pointer (Timeline tl) =
Timeline
{ tl
| batches =
Iddict.map bptr
(\batch -> { batch | end = pointer })
Iddict.update bptr
(Maybe.map (\batch -> { batch | end = pointer }))
tl.batches
, tokens =
Hashdict.map tptr
@ -437,8 +432,8 @@ connectITokenToIBatch pointer (IBatchPTR bptr) (Timeline tl) =
(\token -> { token | starts = Set.insert bptr token.starts })
tl.tokens
, batches =
Iddict.map bptr
(\batch -> { batch | start = pointer })
Iddict.update bptr
(Maybe.map (\batch -> { batch | start = pointer }))
tl.batches
}
@ -683,20 +678,21 @@ mostRecentFrom filter timeline ptr =
{ ptr = ptr, visited = Set.empty }
{-| Recount the Timeline's amount of filled batches. Since the Timeline
automatically tracks the count on itself, this is generally exclusively used in
specific scenarios like decoding JSON values.
-}
recountFilledBatches : Timeline -> Timeline
recountFilledBatches (Timeline tl) =
Timeline
{ tl
| filledBatches =
tl.batches
|> Iddict.values
|> List.filter (\v -> v.events /= [])
|> List.length
}
-- {-| Recount the Timeline's amount of filled batches. Since the Timeline
-- automatically tracks the count on itself, this is generally exclusively used in
-- specific scenarios like decoding JSON values.
-- -}
-- recountFilledBatches : Timeline -> Timeline
-- recountFilledBatches (Timeline tl) =
-- Timeline
-- { tl
-- | filledBatches =
-- tl.batches
-- |> Iddict.values
-- |> List.filter (\v -> v.events /= [])
-- |> List.length
-- }
{-| Create a timeline with a single batch inserted. This batch is considered the

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

View File

@ -1,13 +1,191 @@
module Internal.Values.Vault exposing (Vault)
module Internal.Values.Vault exposing
( Vault, init
, VaultUpdate(..), update
, rooms, fromRoomId, mapRoom, updateRoom
, getAccountData, setAccountData
, coder
)
{-| This module hosts the Vault module.
{-| This module hosts the Vault module. The Vault is the data type storing all
credentials, all user information and all other information that the user
can receive from the Matrix API.
@docs Vault
## Vault type
@docs Vault, init
To update the Vault, one uses VaultUpdate types.
@docs VaultUpdate, update
## Rooms
Rooms are environments where people can have a conversation with each other.
@docs rooms, fromRoomId, mapRoom, updateRoom
## Account data
@docs getAccountData, setAccountData
## JSON
@docs coder
-}
import FastDict as Dict exposing (Dict)
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)
import Recursion
import Recursion.Fold
{-| This is the Vault type.
-}
type alias Vault =
()
{ accountData : Dict String Json.Value
, nextBatch : Maybe String
, rooms : Hashdict Room
}
{-| The VaultUpdate type is a type that instructs the Vault to update itself
based on new information provided by the Matrix API.
-}
type VaultUpdate
= CreateRoomIfNotExists String
| MapRoom String Room.RoomUpdate
| More (List VaultUpdate)
| Optional (Maybe VaultUpdate)
| SetAccountData String Json.Value
| SetNextBatch String
{-| Convert a Vault to and from a JSON object.
-}
coder : Json.Coder Vault
coder =
Json.object3
{ name = Text.docs.vault.name
, description = Text.docs.vault.description
, init = Vault
}
(Json.field.required
{ fieldName = "accountData"
, toField = .accountData
, description = Text.fields.vault.accountData
, coder = Json.fastDict Json.value
}
)
(Json.field.optional.value
{ fieldName = "nextBatch"
, toField = .nextBatch
, description = Text.fields.vault.nextBatch
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "rooms"
, toField = .rooms
, description = Text.fields.vault.rooms
, coder = Hashdict.coder .roomId Room.coder
}
)
{-| Get a given room by its room id.
-}
fromRoomId : String -> Vault -> Maybe Room
fromRoomId roomId vault =
Hashdict.get roomId vault.rooms
{-| Get a piece of account data as information from the room.
-}
getAccountData : String -> Vault -> Maybe Json.Value
getAccountData key vault =
Dict.get key vault.accountData
{-| Initiate a new Vault type.
-}
init : Vault
init =
{ accountData = Dict.empty
, nextBatch = Nothing
, rooms = Hashdict.empty .roomId
}
{-| Update a room, if it exists. If the room isn´t known, this operation is
ignored.
-}
mapRoom : String -> (Room -> Room) -> Vault -> Vault
mapRoom roomId f vault =
{ vault | rooms = Hashdict.map roomId f vault.rooms }
{-| Get a list of all joined rooms present in the vault.
-}
rooms : Vault -> List Room
rooms vault =
Hashdict.values vault.rooms
{-| Set a piece of account data as information in the global vault data.
-}
setAccountData : String -> Json.Value -> Vault -> Vault
setAccountData key value vault =
{ vault | accountData = Dict.insert key value vault.accountData }
{-| Update a Room based on whether it exists or not.
-}
updateRoom : String -> (Maybe Room -> Maybe Room) -> Vault -> Vault
updateRoom roomId f vault =
{ vault | rooms = Hashdict.update roomId f vault.rooms }
{-| Update the Vault using a VaultUpdate type.
-}
update : VaultUpdate -> Vault -> Vault
update vaultUpdate startVault =
Recursion.runRecursion
(\vu ->
case vu of
CreateRoomIfNotExists roomId ->
(Maybe.withDefault (Room.init roomId) >> Maybe.Just)
|> updateRoom roomId
|> Recursion.base
MapRoom roomId ru ->
Recursion.base (mapRoom roomId (Room.update ru))
More items ->
Recursion.Fold.foldList (<<) identity items
Optional (Just u) ->
Recursion.recurse u
Optional Nothing ->
Recursion.base identity
SetAccountData key value ->
Recursion.base (setAccountData key value)
SetNextBatch nb ->
Recursion.base
(\vault ->
{ vault | nextBatch = Just nb }
)
)
vaultUpdate
startVault

View File

@ -1,12 +1,18 @@
module Matrix exposing (Vault)
module Matrix exposing
( Vault, fromUserId, fromUsername
, VaultUpdate, update, sync, logs
, rooms, fromRoomId
, getAccountData, setAccountData
, addAccessToken, sendMessageEvent
)
{-|
# Matrix SDK
This first version forms a mere basis from which we will create iterative builds
that slowly improve the codebase.
This library forms a mere basis from which an entire functional SDK is
developed for the Matrix protocol.
It is generally quite unusual to regularly publish iterative beta versions on
the public registry, but it is also generally quite unusual to exclusively
@ -15,17 +21,235 @@ support a monolithic public registry. (:
## Vault
@docs Vault
@docs Vault, fromUserId, fromUsername
## Keeping the Vault up-to-date
@docs VaultUpdate, update, sync, logs
## Exploring the Vault
@docs rooms, fromRoomId
## Account data
@docs getAccountData, setAccountData
## Debugging
@docs addAccessToken, sendMessageEvent
-}
import Types
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(..))
{-| The Vault type stores all relevant information about the Matrix API.
It currently supports no functionality and it will just stay here - for fun.
If you make sure that the data type stays up-to-date, you can use it to explore
the latest information about an account.
-}
type alias Vault =
Types.Vault
{-| The VaultUpdate type is the central type that keeps the Vault up-to-date.
-}
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
{-| Get a room based on its room ID, if the user is a member of that room.
-}
fromRoomId : String -> Vault -> Maybe Types.Room
fromRoomId roomId (Vault vault) =
Envelope.mapMaybe (Internal.fromRoomId roomId) vault
|> Maybe.map Types.Room
{-| Get global account data.
-}
getAccountData : String -> Vault -> Maybe E.Value
getAccountData key (Vault vault) =
Envelope.extract (Internal.getAccountData key) 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
{ content = Internal.init
, serverName = "https://" ++ User.domain u
, user = 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_ } =
{ content = Internal.init
, serverName =
port_
|> Maybe.map String.fromInt
|> Maybe.map ((++) ":")
|> Maybe.withDefault ""
|> (++) host
, user = User.fromString username
}
|> Envelope.init
|> Envelope.mapContext (\c -> { c | username = Just username })
|> Vault
{-| Get a list of all the rooms that the user has joined.
-}
rooms : Vault -> List Types.Room
rooms (Vault vault) =
Envelope.mapList Internal.rooms vault
|> List.map Types.Room
{-| The VaultUpdate is a complex type that helps update the Vault. However,
it also contains a human output!
Using this function, you can get a human output that describes everything that
the VaultUpdate has to tell the Vault.
The `channel` field describes the context of the log, allowing you to filter
further. For example:
- `debug` is a comprehensive channel describing everything the Elm runtime has
executed.
- `warn` contains warnings that aren't breaking, but relevant.
- `securityWarn` warns about potential security issues or potential attacks.
- `error` has errors that were encountered.
- `caughtError` has errors that were dealt with successfully.
-}
logs : VaultUpdate -> List { channel : String, content : String }
logs (VaultUpdate vu) =
vu.logs
{-| 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.
The fields stand for the following:
- `content` is the JSON object that is sent to the Matrix room.
- `eventType` is the event type that is sent to the Matrix room.
- `roomId` is the Matrix room ID.
- `toMsg` is the `msg` type that is returned after the message has been sent.
- `transactionId` is a unique identifier that helps the Matrix server
distringuish messages. If you send the same message with the same transactionId,
the server promises to register it only once.
- `vault` is the Matrix Vault that contains all the latest and most relevant
information.
-}
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
}
{-| Set global account data.
-}
setAccountData :
{ content : E.Value
, eventType : String
, room : Vault
, toMsg : Types.VaultUpdate -> msg
}
-> Cmd msg
setAccountData data =
case data.room of
Vault vault ->
Api.setAccountData vault
{ content = data.content
, eventType = data.eventType
, toMsg = Types.VaultUpdate >> data.toMsg
}
{-| Synchronize the Vault with the Matrix API.
Effectively, this task asks the Matrix API to provide the latest information,
which will be returned as your VaultUpdate.
-}
sync : (VaultUpdate -> msg) -> Vault -> Cmd msg
sync toMsg (Vault vault) =
Api.sync vault { toMsg = Types.VaultUpdate >> toMsg }
{-| Using new VaultUpdate information, update the Vault accordingly.
This allows us to change our perception of the Matrix environment: has anyone
sent a new message? Did someone send us an invite for a new room?
-}
update : VaultUpdate -> Vault -> Vault
update (VaultUpdate vu) (Vault vault) =
vu.messages
|> List.foldl (Envelope.update Internal.update) vault
|> Vault

View File

@ -1,6 +1,8 @@
module Matrix.Room exposing
( Room, mostRecentEvents
, getAccountData
( Room, mostRecentEvents, roomId
, getAccountData, setAccountData
, sendMessageEvent, sendStateEvent
, invite, kick, ban
)
{-|
@ -12,7 +14,7 @@ What is usually called a chat, a channel, a conversation or a group chat on
other platforms, the term used in Matrix is a "room". A room is a conversation
where a group of users talk to each other.
@docs Room, mostRecentEvents
@docs Room, mostRecentEvents, roomId
This module exposes various functions that help you inspect various aspects of
a room.
@ -33,10 +35,26 @@ data is linked to the user account: other logged in devices can see the account
data too, as the server synchronizes it, but the server shouldn´t show it to
other users.
@docs getAccountData
@docs getAccountData, setAccountData
## Sending events
Besides reading the latest events, one can also send new events to the Matrix
room. These events are JSON objects that can be shaped in any way or form that
you like. To help other users with decoding your JSON objects, you pass an
`eventType` string which helps them figure out the nature of your JSON object.
@docs sendMessageEvent, sendStateEvent
## Moderating users
@docs invite, kick, ban
-}
import Internal.Api.Main as Api
import Internal.Values.Envelope as Envelope
import Internal.Values.Room as Internal
import Json.Encode as E
@ -49,6 +67,26 @@ type alias Room =
Types.Room
{-| Ban a user from a room.
-}
ban :
{ reason : Maybe String
, room : Room
, toMsg : Types.VaultUpdate -> msg
, user : Types.User
}
-> Cmd msg
ban data =
case ( data.room, data.user ) of
( Room room, Types.User user ) ->
Api.banUser room
{ reason = data.reason
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
, user = Envelope.getContent user
}
{-| Get a piece of account data linked to a certain string key.
-}
getAccountData : String -> Room -> Maybe E.Value
@ -56,9 +94,121 @@ getAccountData key (Room room) =
Envelope.extract (Internal.getAccountData key) room
{-| Invite a user to a room.
-}
invite :
{ reason : Maybe String
, room : Room
, toMsg : Types.VaultUpdate -> msg
, user : Types.User
}
-> Cmd msg
invite data =
case ( data.room, data.user ) of
( Room room, Types.User user ) ->
Api.inviteUser room
{ reason = data.reason
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
, user = Envelope.getContent user
}
{-| Kick a user from a room.
-}
kick :
{ reason : Maybe String
, room : Room
, toMsg : Types.VaultUpdate -> msg
, user : Types.User
}
-> Cmd msg
kick data =
case ( data.room, data.user ) of
( Room room, Types.User user ) ->
Api.kickUser room
{ reason = data.reason
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
, user = Envelope.getContent user
}
{-| Get a room's room id. This is an opaque string that distinguishes rooms from
each other.
-}
roomId : Room -> String
roomId (Room room) =
Envelope.extract .roomId room
{-| Get a list of the most recent events sent in the room.
-}
mostRecentEvents : Room -> List Types.Event
mostRecentEvents (Room room) =
Envelope.mapList Internal.mostRecentEvents room
|> List.map Types.Event
{-| Send a message event to a given room.
-}
sendMessageEvent :
{ content : E.Value
, eventType : String
, room : Room
, toMsg : Types.VaultUpdate -> msg
, transactionId : String
}
-> Cmd msg
sendMessageEvent data =
case data.room of
Room room ->
Api.sendMessageEvent room
{ content = data.content
, eventType = data.eventType
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
, transactionId = data.transactionId
}
{-| Send a state event to a given room.
-}
sendStateEvent :
{ content : E.Value
, eventType : String
, room : Room
, stateKey : String
, toMsg : Types.VaultUpdate -> msg
}
-> Cmd msg
sendStateEvent data =
case data.room of
Room room ->
Api.sendStateEvent room
{ content = data.content
, eventType = data.eventType
, roomId = roomId data.room
, stateKey = data.stateKey
, toMsg = Types.VaultUpdate >> data.toMsg
}
{-| Set account data to a Matrix room.
-}
setAccountData :
{ content : E.Value
, eventType : String
, room : Room
, toMsg : Types.VaultUpdate -> msg
}
-> Cmd msg
setAccountData data =
case data.room of
Room room ->
Api.setRoomAccountData room
{ content = data.content
, eventType = data.eventType
, roomId = roomId data.room
, toMsg = Types.VaultUpdate >> data.toMsg
}

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

View File

@ -1,4 +1,4 @@
module Types exposing (Vault(..), Event(..), Room(..), User(..))
module Types exposing (Vault(..), Event(..), Room(..), User(..), VaultUpdate(..))
{-| The Elm SDK uses a lot of records and values that are easy to manipulate.
Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret)
@ -12,10 +12,11 @@ access their content directly.
The opaque types are placed in a central module so all exposed modules can
safely access all exposed data types without risking to create circular imports.
@docs Vault, Event, Room, User
@docs Vault, Event, Room, User, VaultUpdate
-}
import Internal.Api.Main as Api
import Internal.Values.Envelope as Envelope
import Internal.Values.Event as Event
import Internal.Values.Room as Room
@ -45,3 +46,9 @@ type User
-}
type Vault
= Vault (Envelope.Envelope Vault.Vault)
{-| Opaque type for Matrix VaultUpdate
-}
type VaultUpdate
= VaultUpdate Api.Msg

View File

@ -103,7 +103,7 @@ suite =
]
, describe "singleton"
[ fuzz TestEvent.fuzzer
"singletong = empty + insert"
"singleton = empty + insert"
(\event ->
Hashdict.empty .eventId
|> Hashdict.insert event
@ -159,6 +159,26 @@ suite =
|> Expect.equal False
)
]
, describe "update"
[ fuzz2 (fuzzer identity Fuzz.string)
Fuzz.string
"add = insert"
(\hashdict value ->
Hashdict.isEqual
(Hashdict.insert value hashdict)
(Hashdict.update value (always (Just value)) hashdict)
|> Expect.equal True
)
, fuzz2 (fuzzer identity Fuzz.string)
Fuzz.string
"remove = removeKey"
(\hashdict value ->
Hashdict.isEqual
(Hashdict.removeKey value hashdict)
(Hashdict.update value (always Nothing) hashdict)
|> Expect.equal True
)
]
, describe "JSON"
[ fuzz2 eventFuzzer
(Fuzz.intRange 0 10)

View File

@ -1,280 +0,0 @@
module Test.Tools.Iddict exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Tools.Iddict as Iddict exposing (Iddict)
import Internal.Tools.Json as Json
import Json.Decode as D
import Json.Encode as E
import Test exposing (..)
fuzzer : Fuzzer a -> Fuzzer (Iddict a)
fuzzer fuz =
fuz
|> Fuzz.pair Fuzz.bool
|> Fuzz.list
|> Fuzz.map
(\items ->
List.foldl
(\( rm, item ) dict ->
case Iddict.insert item dict of
( key, d ) ->
if rm then
Iddict.remove key d
else
d
)
Iddict.empty
items
)
empty : Test
empty =
describe "empty"
[ test "isEmpty"
(Iddict.empty
|> Iddict.isEmpty
|> Expect.equal True
|> always
)
, fuzz Fuzz.int
"No members"
(\i ->
Iddict.empty
|> Iddict.member i
|> Expect.equal False
)
, fuzz Fuzz.int
"Get gets Nothing"
(\i ->
Iddict.empty
|> Iddict.get i
|> Expect.equal Nothing
)
, test "Size = 0"
(Iddict.empty
|> Iddict.size
|> Expect.equal 0
|> always
)
, test "No keys"
(Iddict.empty
|> Iddict.keys
|> Expect.equal []
|> always
)
, test "No values"
(Iddict.empty
|> Iddict.values
|> Expect.equal []
|> always
)
, test "JSON encode -> decode -> empty"
(Iddict.empty
|> Iddict.encode Json.value
|> D.decodeValue (Iddict.decoder Json.value)
|> Result.map Tuple.first
|> Expect.equal (Ok Iddict.empty)
|> always
)
, test "JSON encode"
(Iddict.empty
|> Iddict.encode Json.value
|> E.encode 0
|> Expect.equal "{\"dict\":{}}"
|> always
)
, test "JSON decode"
("{\"dict\":{}}"
|> D.decodeString (Iddict.decoder Json.value)
|> Result.map Tuple.first
|> Expect.equal (Ok Iddict.empty)
|> always
)
]
singleton : Test
singleton =
let
singleFuzzer : Fuzzer (Iddict Int)
singleFuzzer =
Fuzz.map
(\i ->
Iddict.singleton i
|> Tuple.second
)
Fuzz.int
in
describe "singleton"
[ fuzz singleFuzzer
"not isEmpty"
(\single ->
single
|> Iddict.isEmpty
|> Expect.equal False
)
, fuzz Fuzz.int
"singleton == insert empty"
(\i ->
Iddict.empty
|> Iddict.insert i
|> Expect.equal (Iddict.singleton i)
)
, fuzz Fuzz.int
"First item is key 0"
(\i ->
Iddict.singleton i
|> Tuple.first
|> Expect.equal 0
)
, fuzz singleFuzzer
"Key 0 is member"
(\single ->
single
|> Iddict.member 0
|> Expect.equal True
)
, fuzz Fuzz.int
"Key 0 get returns Just value"
(\i ->
Iddict.singleton i
|> Tuple.second
|> Iddict.get 0
|> Expect.equal (Just i)
)
, fuzz singleFuzzer
"Size == 1"
(\single ->
single
|> Iddict.size
|> Expect.equal 1
)
, fuzz Fuzz.int
"Only key 0"
(\i ->
Iddict.singleton i
|> Tuple.second
|> Iddict.keys
|> Expect.equal [ 0 ]
)
, fuzz Fuzz.int
"Only value value"
(\i ->
Iddict.singleton i
|> Tuple.second
|> Iddict.values
|> Expect.equal [ i ]
)
, fuzz singleFuzzer
"JSON encode -> decode -> singleton"
(\single ->
single
|> Iddict.encode Json.int
|> D.decodeValue (Iddict.decoder Json.int)
|> Result.map Tuple.first
|> Expect.equal (Ok single)
)
, fuzz Fuzz.int
"JSON encode"
(\i ->
Iddict.singleton i
|> Tuple.second
|> Iddict.encode Json.int
|> E.encode 0
|> Expect.equal ("{\"cursor\":1,\"dict\":{\"0\":" ++ String.fromInt i ++ "}}")
)
, fuzz Fuzz.int
"JSON decode"
(\i ->
("{\"cursor\":1,\"dict\":{\"0\":" ++ String.fromInt i ++ "}}")
|> D.decodeString (Iddict.decoder Json.int)
|> Result.map Tuple.first
|> Tuple.pair 0
|> Expect.equal (Iddict.singleton i |> Tuple.mapSecond Ok)
)
]
insert : Test
insert =
describe "insert"
[ fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"Add something"
(\d i ->
case Iddict.insert i d of
( key, dict ) ->
dict
|> Iddict.get key
|> Expect.equal (Just i)
)
, fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"Never isEmpty"
(\d i ->
Iddict.insert i d
|> Tuple.second
|> Iddict.isEmpty
|> Expect.equal False
)
, fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"New key"
(\d i ->
case Iddict.insert i d of
( key, dict ) ->
dict
|> Iddict.remove key
|> Iddict.insert i
|> (\( newKey, _ ) ->
Expect.notEqual key newKey
)
)
, fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"New dict"
(\d i ->
case Iddict.insert i d of
( key, dict ) ->
dict
|> Iddict.remove key
|> Iddict.insert i
|> (\( _, newDict ) ->
Expect.notEqual dict newDict
)
)
, fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"Inserted value is member"
(\d i ->
case Iddict.insert i d of
( key, dict ) ->
dict
|> Iddict.member key
|> Expect.equal True
)
, fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"Get inserted value"
(\d i ->
case Iddict.insert i d of
( key, dict ) ->
dict
|> Iddict.get key
|> Expect.equal (Just i)
)
, fuzz2 (fuzzer Fuzz.int)
Fuzz.int
"size = size + 1"
(\d i ->
case Iddict.insert i d of
( _, dict ) ->
Expect.equal
(Iddict.size dict)
(Iddict.size d + 1)
)
]

View File

@ -100,7 +100,6 @@ gridField =
, description = []
, coder = Json.list (Json.list Json.int)
, default = ( [], [] )
, defaultToString = always "[]"
}
@ -132,7 +131,6 @@ hobbiesField =
, description = []
, coder = Json.list Json.string
, default = ( [], [] )
, defaultToString = always "[]"
}
@ -149,13 +147,6 @@ invitedToPartyField =
, description = []
, coder = Json.bool
, default = ( False, [] )
, defaultToString =
\b ->
if b then
"True"
else
"False"
}

View File

@ -3,10 +3,12 @@ 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 Json.Decode as D
import Json.Encode as E
import Internal.Tools.Hashdict as Hashdict
import Internal.Values.Context as Context exposing (Context, Versions)
import Set
import Test exposing (..)
import Test.Tools.Timestamp as TestTimestamp
import Test.Values.User as TestUser
fuzzer : Fuzzer Context
@ -16,14 +18,37 @@ fuzzer =
maybeString =
Fuzz.maybe Fuzz.string
in
Fuzz.map7 Context
Fuzz.map8 (\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) -> Context a b c d e f g h i j k l m)
(Fuzz.constant <| Hashdict.empty .value)
maybeString
maybeString
(Fuzz.pair
maybeString
(Fuzz.maybe TestTimestamp.fuzzer)
)
(Fuzz.pair
maybeString
maybeString
)
(Fuzz.pair
Fuzz.string
maybeString
)
(Fuzz.pair
maybeString
(Fuzz.maybe <| Fuzz.list Fuzz.string)
(Fuzz.maybe TestUser.fuzzer)
)
(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 +89,7 @@ leaks =
|> Expect.notEqual Leaks.transaction
)
, fuzz2 fuzzer
(Fuzz.list Fuzz.string)
versionsFuzzer
"Versions"
(\context value ->
context
@ -110,7 +135,7 @@ apiContext =
|> Expect.equal value
)
, fuzz2 fuzzer
(Fuzz.list Fuzz.string)
versionsFuzzer
"Versions"
(\context value ->
context
@ -122,22 +147,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, [] ))
-- )
-- ]

View File

@ -3,10 +3,7 @@ module Test.Values.Envelope exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Config.Default as Default
import Internal.Tools.Json as Json
import Internal.Values.Envelope as Envelope exposing (Envelope)
import Json.Decode as D
import Json.Encode as E
import Test exposing (..)
import Test.Values.Context as TestContext
import Test.Values.Settings as TestSettings
@ -28,7 +25,7 @@ suite =
[ fuzz Fuzz.string
"currentVersion"
(\s ->
s
{ content = s, serverName = "", user = Nothing }
|> Envelope.init
|> Envelope.extractSettings .currentVersion
|> Expect.equal Default.currentVersion
@ -36,7 +33,7 @@ suite =
, fuzz Fuzz.string
"deviceName"
(\s ->
s
{ content = s, serverName = "", user = Nothing }
|> Envelope.init
|> Envelope.extractSettings .deviceName
|> Expect.equal Default.deviceName
@ -44,23 +41,24 @@ suite =
, fuzz Fuzz.string
"syncTime"
(\s ->
s
{ content = s, serverName = "", user = Nothing }
|> 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, [] ))
-- )
-- ]
]

View File

@ -41,16 +41,18 @@ fuzzerState =
unsignedDataFuzzer : Fuzzer Event.UnsignedData
unsignedDataFuzzer =
Fuzz.map4
(\age prev redact trans ->
Fuzz.map5
(\age memb prev redact trans ->
Event.UnsignedData
{ age = age
, membership = memb
, prevContent = prev
, redactedBecause = redact
, transactionId = trans
}
)
(Fuzz.maybe Fuzz.int)
(Fuzz.maybe Fuzz.string)
(Fuzz.maybe valueFuzzer)
(Fuzz.maybe <| Fuzz.lazy (\_ -> fuzzer))
(Fuzz.maybe Fuzz.string)

View File

@ -1,13 +1,9 @@
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
import Test.Values.Event as TestEvent
placeholderValue : E.Value
@ -20,23 +16,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

View File

@ -11,7 +11,7 @@ import Test exposing (..)
fuzzer : Fuzzer Settings
fuzzer =
Fuzz.map3 Settings
Fuzz.map5 Settings
(Fuzz.oneOf
[ Fuzz.constant Default.currentVersion
, Fuzz.string
@ -22,6 +22,12 @@ fuzzer =
, Fuzz.string
]
)
(Fuzz.maybe Fuzz.string)
(Fuzz.oneOf
[ Fuzz.constant Default.removePasswordOnLogin
, Fuzz.bool
]
)
(Fuzz.oneOf
[ Fuzz.constant Default.syncTime
, Fuzz.int
@ -45,6 +51,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

View File

@ -2,10 +2,11 @@ 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
import Json.Encode as E
import Test exposing (..)
import Test.Filter.Timeline as TestFilter
@ -250,7 +251,8 @@ suite =
(\timeline ->
timeline
|> Json.encode Timeline.coder
|> D.decodeValue (Json.decode Timeline.coder)
|> E.encode 0
|> D.decodeString (Json.decode Timeline.coder)
|> Result.map Tuple.first
|> Result.map (Timeline.mostRecentEvents Filter.pass)
|> Expect.equal (Ok <| Timeline.mostRecentEvents Filter.pass timeline)

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

View File

@ -1,10 +1,21 @@
module Test.Values.Vault exposing (..)
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
vault : Fuzzer Vault
vault =
Fuzz.unit
Fuzz.map3 Vault
(Fuzz.string
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|> Fuzz.list
|> Fuzz.map Dict.fromList
)
(Fuzz.maybe Fuzz.string)
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)