Compare commits
260 Commits
Author | SHA1 | Date |
---|---|---|
|
1701904144 | |
|
e42ff71809 | |
|
c6d388bff6 | |
|
a336c8b057 | |
|
8d28fe63b9 | |
|
a8d879afbb | |
|
61a8e18714 | |
|
a2582f36f9 | |
|
41bee45693 | |
|
3566d3ee7a | |
|
8b2db7bff6 | |
|
5319f47145 | |
|
87ebcbcd21 | |
|
0521ca2f3e | |
|
fee68f7e0f | |
|
7b615c6452 | |
|
07c34c3530 | |
|
1ed9fa7d22 | |
|
cacb876a95 | |
|
20504d4a8b | |
|
a401c25a47 | |
|
f3799add87 | |
|
eb8d90ab8b | |
|
1736679e0f | |
|
31817ed545 | |
|
899088d63c | |
|
48e5eae327 | |
|
90eb06f3a1 | |
|
a9e4a39e7f | |
|
d7a7fa385c | |
|
c7204c4c41 | |
|
c473d60161 | |
|
41ec76822f | |
|
458ea59425 | |
|
1eb07377fd | |
|
39f8021a8f | |
|
1aecb1116a | |
|
8a3b7efbf6 | |
|
005e103389 | |
|
4e378a5f50 | |
|
0978e43fc0 | |
|
632158f309 | |
|
c5d07f0a94 | |
|
b239eecc6b | |
|
e7d3a129b1 | |
|
e122a7b262 | |
|
29906ff976 | |
|
80bb05fd30 | |
|
1d0a9de7da | |
|
a95fbbb856 | |
|
95f0aa2934 | |
|
7ab21b4314 | |
|
0092f96a25 | |
|
6300d15edf | |
|
17a1d1af3e | |
|
61dad6c5e8 | |
|
693124aa15 | |
|
6783186c18 | |
|
0ded7ab6bd | |
|
f6a6bb535e | |
|
76cc6d46b9 | |
|
425d964af5 | |
|
21ae0ea376 | |
|
7b00a46ffa | |
|
f714438dd4 | |
|
a514497406 | |
|
306d8e2f93 | |
|
f7837a91c8 | |
|
d360c561f9 | |
|
acd4a07d5e | |
|
1de9566e1d | |
|
85d767414d | |
|
994c99af15 | |
|
b465ad1f47 | |
|
e8c0df004e | |
|
c5e546b25c | |
|
bec1ae4a3b | |
|
daf4bcb1b1 | |
|
b0026617cf | |
|
7fcef60ec6 | |
|
2b9370f0c2 | |
|
12c919b071 | |
|
567ac5596a | |
|
b32e0ef123 | |
|
9e761db4f9 | |
|
e335c150f0 | |
|
4349a14a87 | |
|
487c872d43 | |
|
42ca8f6c9c | |
|
e6257d8e38 | |
|
7a75bffbfb | |
|
4f08dd1176 | |
|
50b10c64ca | |
|
3b0b3264de | |
|
c84bb2a1ef | |
|
6e89371845 | |
|
77387ab492 | |
|
83043e73f4 | |
|
becd3bcdb1 | |
|
e786bebeb2 | |
|
3ee6debf44 | |
|
b6e4396138 | |
|
568afed458 | |
|
2714b53a2d | |
|
3fdd25d6d6 | |
|
e49a0e3dc3 | |
|
2e8185841a | |
|
9a6fcc5ad4 | |
|
ff8b6c043a | |
|
7935e112ed | |
|
2baf012345 | |
|
107233fbad | |
|
41d8503d7e | |
|
e3e765503f | |
|
5cf6b59602 | |
|
ca1695c376 | |
|
e1c7c8792e | |
|
bcdb178414 | |
|
e6a1bd13f0 | |
|
2ff381d7f5 | |
|
df71779620 | |
|
c309461602 | |
|
c7659b592b | |
|
8f83e6a41c | |
|
8c73fbf9b1 | |
|
086e491b06 | |
|
0ef298a28e | |
|
259f695b74 | |
|
ae19884a18 | |
|
b3e103a5d9 | |
|
203205f53c | |
|
c858ef151e | |
|
78794ef59b | |
|
cd0c687307 | |
|
077605bcbc | |
|
709d608056 | |
|
f1dde4874b | |
|
5856084b45 | |
|
db6573180b | |
|
3983ab0de2 | |
|
ccefa2ed9b | |
|
d41c31e8c1 | |
|
792e60761a | |
|
33d98dd6ff | |
|
ed78695213 | |
|
791ada6f64 | |
|
56c978bcf3 | |
|
d1336a0e23 | |
|
d68de7f2fb | |
|
43f0ac5ef2 | |
|
421e1f6ce7 | |
|
1940b1d51f | |
|
7acae258ed | |
|
10c7075bef | |
|
cf28a3f210 | |
|
2d26e1826d | |
|
6134702d25 | |
|
cd8163bb41 | |
|
f0933b9854 | |
|
bbe1eeef12 | |
|
016290d9e1 | |
|
16a7e7e66b | |
|
d40af28b38 | |
|
ead65c07f5 | |
|
b6e181237f | |
|
c3c08845d8 | |
|
acd13ac67a | |
|
dd5f298fd3 | |
|
d1fbc87730 | |
|
28d2a17a10 | |
|
3f08e4a3e7 | |
|
ecdc136f9e | |
|
21dfa1e77f | |
|
6f42916a19 | |
|
5aebeddd29 | |
|
ef9b007730 | |
|
311de94c1f | |
|
462aa3a2dc | |
|
cecf9c1f77 | |
|
ad3f45d035 | |
|
2f7a247dbd | |
|
394799da8b | |
|
29f6a5e754 | |
|
79aff7af3b | |
|
0ce58d6f9e | |
|
fd569aa476 | |
|
ae38fe6878 | |
|
06c048286c | |
|
2d01802b86 | |
|
81b0b1c166 | |
|
211f8f1df4 | |
|
e8ee125def | |
|
3739043f87 | |
|
2de15acc28 | |
|
2507766248 | |
|
af26e2b0a4 | |
|
138bfd5743 | |
|
70f57b1b96 | |
|
a70e1a775b | |
|
20b4ea2f5c | |
|
5cdb4fad33 | |
|
e1a4bcab9b | |
|
acfeabb39e | |
|
277c15c7e1 | |
|
c7a3fe804b | |
|
f465c9cbb1 | |
|
26ca6600d7 | |
|
cee2b3a5bb | |
|
4905b7341d | |
|
fa642b46d6 | |
|
bf64d5911f | |
|
959642499b | |
|
3e54ea9cbe | |
|
5ac3e7eb6a | |
|
1a819cbe39 | |
|
5065ed05ff | |
|
ff180ec84d | |
|
5d2d9ddb73 | |
|
0448b74609 | |
|
ce83d1260f | |
|
0bca889d41 | |
|
ac938344fd | |
|
d856974ade | |
|
978d6c6315 | |
|
88818abe20 | |
|
ca0a7b41df | |
|
16c9e0d4e1 | |
|
4e68dfbcbd | |
|
14058f4b69 | |
|
2e6d07bc42 | |
|
1d3ceb9b2d | |
|
d9d5760928 | |
|
5bd95699d2 | |
|
447a18ab04 | |
|
87a5919921 | |
|
7254fcfaa4 | |
|
b3479cf2c9 | |
|
3b927dc460 | |
|
ce0f96a74e | |
|
603057568d | |
|
2fd2eb4e5a | |
|
ee1012f783 | |
|
29f9482b74 | |
|
8b7b2aa312 | |
|
5293eb4003 | |
|
f910c0225b | |
|
848d83a18e | |
|
1b0be9bffa | |
|
70d44c2cb6 | |
|
7c7e05d42a | |
|
b7c2e28f71 | |
|
dd10d43da1 | |
|
31d176d110 | |
|
037e598b36 | |
|
a53fca3326 | |
|
da81a09eb8 | |
|
fcc7699a44 | |
|
41ede5bbff | |
|
6fa7904b8d | |
|
c5e1b756a2 |
|
@ -2,3 +2,12 @@
|
||||||
elm-stuff
|
elm-stuff
|
||||||
# elm-repl generated files
|
# elm-repl generated files
|
||||||
repl-temp-*
|
repl-temp-*
|
||||||
|
# VScode settings
|
||||||
|
.vscode/
|
||||||
|
|
||||||
|
# Elm output
|
||||||
|
index.html
|
||||||
|
elm.js
|
||||||
|
|
||||||
|
# Elm configurations
|
||||||
|
elm-*.json
|
||||||
|
|
10
README.md
10
README.md
|
@ -18,8 +18,9 @@ supported for which spec versions.
|
||||||
- ✅ **One way to do things** instead of having multiple functions that are
|
- ✅ **One way to do things** instead of having multiple functions that are
|
||||||
considered deprecated.
|
considered deprecated.
|
||||||
|
|
||||||
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) at
|
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) or join the
|
||||||
@elm_matrix_sdk@social.noordstar.me to stay up-to-date on the latest changes.
|
conversation on [Matrix](https://matrix.to/#/#elm-sdk:matrix.org) to stay
|
||||||
|
up-to-date on the latest changes.
|
||||||
|
|
||||||
## How to install
|
## How to install
|
||||||
|
|
||||||
|
@ -32,3 +33,8 @@ elm install noordstar/elm-matrix-sdk-beta
|
||||||
Keep in mind that the beta versions are intended to develop rapidly. You should
|
Keep in mind that the beta versions are intended to develop rapidly. You should
|
||||||
not expect the versions to remain reliable for years! If you need a stable
|
not expect the versions to remain reliable for years! If you need a stable
|
||||||
version, please wait around for a full version.
|
version, please wait around for a full version.
|
||||||
|
|
||||||
|
## Contribute
|
||||||
|
|
||||||
|
If you wish to contribute, please read the
|
||||||
|
[contribution guide](docs/CONTRIBUTING.md).
|
||||||
|
|
|
@ -0,0 +1,71 @@
|
||||||
|
# Contributing to elm-matrix-sdk-beta
|
||||||
|
|
||||||
|
Welcome to the elm-matrix-sdk-beta repository! We appreciate your interest in
|
||||||
|
contributing. Please take a moment to review the following guidelines.
|
||||||
|
|
||||||
|
## Table of Contents
|
||||||
|
|
||||||
|
1. [How to Contribute](#how-to-contribute)
|
||||||
|
2. [Bug Reports](#bug-reports)
|
||||||
|
3. [Code Contributions](#code-contributions)
|
||||||
|
4. [Documentation Improvements](#documentation-improvements)
|
||||||
|
5. [Feedback and Tips](#feedback-and-tips)
|
||||||
|
6. [Development Environment](#development-environment)
|
||||||
|
7. [Pull Requests](#pull-requests)
|
||||||
|
8. [Communication](#communication)
|
||||||
|
9. [License](#license)
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## How to Contribute
|
||||||
|
|
||||||
|
We welcome various forms of contributions, including bug reports, code
|
||||||
|
contributions through pull requests from forks, suggestions for documentation
|
||||||
|
improvement, and helpful tips and feedback based on user experience.
|
||||||
|
|
||||||
|
## Bug Reports
|
||||||
|
|
||||||
|
When reporting bugs, please provide as much detail as possible, including steps
|
||||||
|
to reproduce, expected behavior, actual behavior, and details about your
|
||||||
|
environment.
|
||||||
|
|
||||||
|
## Code Contributions
|
||||||
|
|
||||||
|
1. Fork the repository.
|
||||||
|
2. Create a new branch from the `develop` branch.
|
||||||
|
3. Write your code and commit changes.
|
||||||
|
4. Push your branch to your fork.
|
||||||
|
5. Submit a pull request to the `develop` branch.
|
||||||
|
|
||||||
|
## Documentation Improvements
|
||||||
|
|
||||||
|
Feel free to suggest improvements to the documentation. Ensure that your
|
||||||
|
suggestions are clear and concise.
|
||||||
|
|
||||||
|
## Feedback and Tips
|
||||||
|
|
||||||
|
We appreciate feedback, tips, and suggestions based on user experience. Share
|
||||||
|
your thoughts to help us enhance the project.
|
||||||
|
|
||||||
|
## Development Environment
|
||||||
|
|
||||||
|
To set up your development environment:
|
||||||
|
|
||||||
|
1. Install Elm.
|
||||||
|
2. Use `elm-format` to format your Elm code.
|
||||||
|
3. Run `elm make --docs=docs.json` to generate documentation.
|
||||||
|
4. View documentation using an Elm documentation viewer (e.g., [elm-doc-preview](https://elm-doc-preview.netlify.app/)).
|
||||||
|
5. Expose modules in `elm.json` for documentation.
|
||||||
|
|
||||||
|
## Pull Requests
|
||||||
|
|
||||||
|
Create a fork, write your code, and submit a pull request to the `develop` branch.
|
||||||
|
|
||||||
|
## Communication
|
||||||
|
|
||||||
|
- Mastodon: [@elm_matrix_sdk@social.noordstar.me](https://social.noordstar.me/@elm_matrix_sdk)
|
||||||
|
- Matrix: [#elm-sdk:matrix.org](https://matrix.to/#/#elm-sdk:matrix.org)
|
||||||
|
|
||||||
|
## License
|
||||||
|
|
||||||
|
This project is licensed under the [EUPL-v1.2](LICENSE). Please review the license file for more details.
|
|
@ -0,0 +1,31 @@
|
||||||
|
# Before merging to main
|
||||||
|
|
||||||
|
⚠️ **Hold up!** Before you merge that pull request, make sure to follow this checklist!
|
||||||
|
|
||||||
|
## Any branch to `develop`
|
||||||
|
|
||||||
|
If you wish to merge your branch to the `develop` branch, make sure to follow this checklist:
|
||||||
|
|
||||||
|
- [ ] Run `elm-format` to ensure the correct formatting of the Elm files.
|
||||||
|
- [ ] Use `elm-doc-preview` to verify whether the documentation is up to standards.
|
||||||
|
- [ ] Run `elm-test` to verify that all tests run successfully.
|
||||||
|
|
||||||
|
## The `develop` branch to `main`
|
||||||
|
|
||||||
|
The `develop` branch is the only branch that's allowed to merge to `main`. Once the branch merges to `main`, that indicates a new release on the Elm registry.
|
||||||
|
|
||||||
|
Before that is being done, however, the following tasks should be done:
|
||||||
|
|
||||||
|
- [ ] Run `elm-format` to ensure the correct formatting of the Elm files.
|
||||||
|
- [ ] Use `elm-doc-preview` to verify whether the documentation is up to standards.
|
||||||
|
- [ ] Run `elm-test --fuzz 1000` to verify that all tests run successfully.
|
||||||
|
- [ ] Remove exposed modules from `elm.json` that do not need to be exposed modules in the release.
|
||||||
|
- [ ] Run `elm bump` to update the library's version number
|
||||||
|
- [ ] Update the version name in the [default values config file](../src/Internal/Config/Default.elm).
|
||||||
|
|
||||||
|
## Any branch to any other branch
|
||||||
|
|
||||||
|
There are no limitations to merging other branches towards one another, although it is important to keep in mind that:
|
||||||
|
|
||||||
|
- Contributors are advised to merge the `develop` branch into their branches regularly to avoid any merge conflicts.
|
||||||
|
- Merging with branches that haven't been accepted (yet) might result in your branch ending up with code that will not be accepted.
|
Binary file not shown.
After Width: | Height: | Size: 7.7 KiB |
|
@ -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 |
|
@ -0,0 +1,138 @@
|
||||||
|
# Timeline
|
||||||
|
|
||||||
|
Given the complex nature of the Timeline design, it deserves some explanation of
|
||||||
|
the design. This document aims to describe how the Elm SDK designs the Timeline,
|
||||||
|
so that other projects may learn from it.
|
||||||
|
|
||||||
|
## API endpoint disambiguations
|
||||||
|
|
||||||
|
Generally speaking, there are a few API endpoints with similar design:
|
||||||
|
|
||||||
|
- The [`/sync` endpoint](https://spec.matrix.org/v1.9/client-server-api/#get_matrixclientv3sync),
|
||||||
|
which gets the events that the homeserver received most recently.
|
||||||
|
- The [`/messages` endpoint](https://spec.matrix.org/v1.9/client-server-api/#get_matrixclientv3roomsroomidmembers),
|
||||||
|
which gets any events in the topological order.
|
||||||
|
|
||||||
|
As noted in the Matrix spec:
|
||||||
|
|
||||||
|
> Events are ordered in this API according to the arrival time of the event on
|
||||||
|
> the homeserver. This can conflict with other APIs which order events based on
|
||||||
|
> their partial ordering in the event graph. This can result in duplicate events
|
||||||
|
> being received (once per distinct API called). Clients SHOULD de-duplicate
|
||||||
|
> events based on the event ID when this happens.
|
||||||
|
|
||||||
|
For this reason, the Elm SDK maintains **two independent timelines** that are tied
|
||||||
|
together when necessary to form a coherent timeline.
|
||||||
|
|
||||||
|
## Elm design
|
||||||
|
|
||||||
|
For those unfamiliar, the Elm Architecture breaks into three parts:
|
||||||
|
|
||||||
|
- **Model** - the state of the application
|
||||||
|
- **View** - a way to turn your state into meaningful information
|
||||||
|
- **Update** - a way to update your state based on the Matrix API
|
||||||
|
|
||||||
|
Since these concepts are compartmentalized, it is impossible to make an API call
|
||||||
|
while executing the **view** function; the Elm SDK must at all times find a way
|
||||||
|
to represent its state.
|
||||||
|
|
||||||
|
## Timeline
|
||||||
|
|
||||||
|
Concerning the Matrix timeline, it is meant to create a representation
|
||||||
|
(**Model**) of the timeline, find a way to represent (**View**) it, and find a
|
||||||
|
simple way to adjust it with every incoming Matrix API result. (**Update**)
|
||||||
|
|
||||||
|
First, we define what a timeline batch is.
|
||||||
|
|
||||||
|
### Timeline batch
|
||||||
|
|
||||||
|
A timeline batch is something that most Matrix API endpoints return. It is a
|
||||||
|
little piece of the timeline and contains the following four pieces of
|
||||||
|
information:
|
||||||
|
|
||||||
|
1. A list of events that are part of the timeline.
|
||||||
|
2. A Filter for which all provided events meet the criteria.
|
||||||
|
3. An end batch token that functions as an identifier.
|
||||||
|
4. _(Optional.)_ A start token. If not provided, it indicates the start of the
|
||||||
|
timeline.
|
||||||
|
|
||||||
|
Here's an example of such a timeline batch:
|
||||||
|
|
||||||
|
```
|
||||||
|
|-->[■]->[■]->[●]->[■]->[■]->[●]-->|
|
||||||
|
| |
|
||||||
|
|<--- filter: only ■ and ● --->|
|
||||||
|
| |
|
||||||
|
start: end:
|
||||||
|
<token_1> <token_2>
|
||||||
|
```
|
||||||
|
|
||||||
|
When the Matrix API later returns a batch token that starts with `<token_2>`,
|
||||||
|
we know that we can connect it to the batch above and make a longer list of
|
||||||
|
events!
|
||||||
|
|
||||||
|
At first, this seems quite simple to connect, but there are some difficulties
|
||||||
|
that come up along the way.
|
||||||
|
|
||||||
|
### Challenge 1: different filters, different locations
|
||||||
|
|
||||||
|
When two timeline batches have different filters, we do not know their
|
||||||
|
respective location. For example, the following two timeline batches COULD
|
||||||
|
overlap, but it is also possible they don't:
|
||||||
|
|
||||||
|
```
|
||||||
|
|-->[■]->[■]->[●]->[■]->[■]->[●]-->|
|
||||||
|
| |
|
||||||
|
|<--- filter: only ■ and ● --->|
|
||||||
|
| |
|
||||||
|
start: end:
|
||||||
|
<token_1> <token_2>
|
||||||
|
|
||||||
|
|
||||||
|
|-->[★]->[★]->[★]->[★]-->|
|
||||||
|
| |
|
||||||
|
|<-- filter: only ★ -->|
|
||||||
|
| |
|
||||||
|
start: end:
|
||||||
|
<token_3> <token_4>
|
||||||
|
```
|
||||||
|
|
||||||
|
Realistically, there is currently no way of knowing without making more API
|
||||||
|
calls. However, just making more API calls isn't a solution in Elm because of
|
||||||
|
its architecture.
|
||||||
|
|
||||||
|
> **SOLUTION:** As described in the **View** function, we may assume that
|
||||||
|
overlapping timeline batches have overlapping events. If they overlap yet have
|
||||||
|
no overlapping events, then their filters must be disjoint. If the filters are
|
||||||
|
disjoint, we do not care whether they're overlapping.
|
||||||
|
|
||||||
|
### Challenge 2: same filters, same spot
|
||||||
|
|
||||||
|
Suppose there is a known timeline batch, and we're trying to **Update** the
|
||||||
|
timeline to represent the timeline between `<token_1>` and `<token_2>` for a
|
||||||
|
different filter:
|
||||||
|
|
||||||
|
```
|
||||||
|
|-->[■]->[■]->[●]->[■]->[■]->[●]-->|
|
||||||
|
| |
|
||||||
|
|<--- filter: only ■ and ● --->|
|
||||||
|
| |
|
||||||
|
start: end:
|
||||||
|
<token_1> <token_2>
|
||||||
|
```
|
||||||
|
|
||||||
|
If we wish to know what's in there for a different filter `f`, then:
|
||||||
|
|
||||||
|
1. If `f` equals the filter from the timeline batch, we can copy the events.
|
||||||
|
2. If `f` is a subfilter of the batch filter (for example: `only ■`) then we can
|
||||||
|
copy the events from the given batch, and then locally filter the events
|
||||||
|
that do no match filter `f`.
|
||||||
|
3. If the batch filter is a subfilter of `f`, then we can use an API call
|
||||||
|
between the same batch tokens `<token_1>` and `<token_2>`. In the worst
|
||||||
|
case, we receive the exact same list of events. In another scenario, we
|
||||||
|
might discover far more events and receive some new batch value `<token_3>`
|
||||||
|
in-between `<token_1>` and `<token_2>`.
|
||||||
|
4. If neither filter is a subfilter of the other and the two are (at least
|
||||||
|
partially) disjoint, then they do not need to correlate and any other batch
|
||||||
|
values can be chosen.
|
||||||
|
|
24
elm.json
24
elm.json
|
@ -3,11 +3,27 @@
|
||||||
"name": "noordstar/elm-matrix-sdk-beta",
|
"name": "noordstar/elm-matrix-sdk-beta",
|
||||||
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
|
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
|
||||||
"license": "EUPL-1.1",
|
"license": "EUPL-1.1",
|
||||||
"version": "1.0.0",
|
"version": "3.5.0",
|
||||||
|
"exposed-modules": [
|
||||||
|
"Matrix",
|
||||||
|
"Matrix.Event",
|
||||||
|
"Matrix.Room",
|
||||||
|
"Matrix.Settings",
|
||||||
|
"Matrix.User"
|
||||||
|
],
|
||||||
"elm-version": "0.19.0 <= v < 0.20.0",
|
"elm-version": "0.19.0 <= v < 0.20.0",
|
||||||
"exposed-modules": [ "Matrix" ],
|
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"elm/core": "1.0.0 <= v < 2.0.0"
|
"elm/core": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/http": "2.0.0 <= v < 3.0.0",
|
||||||
|
"elm/json": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/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",
|
||||||
|
"noordstar/elm-iddict": "1.0.1 <= v < 2.0.0"
|
||||||
},
|
},
|
||||||
"test-dependencies": {}
|
"test-dependencies": {
|
||||||
|
"elm-explorations/test": "2.1.2 <= v < 3.0.0"
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -0,0 +1,196 @@
|
||||||
|
module Internal.Api.Api exposing
|
||||||
|
( TaskChain, request
|
||||||
|
, VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API
|
||||||
|
|
||||||
|
The API module is a front-end for implementing API endpoints according to spec.
|
||||||
|
|
||||||
|
This module is imported by various API endpoint implementations to keep the
|
||||||
|
implementation simple and understandable.
|
||||||
|
|
||||||
|
@docs TaskChain, request
|
||||||
|
|
||||||
|
|
||||||
|
## Spec versions
|
||||||
|
|
||||||
|
To respect spec versions, there is often a variety of ways to communicate with
|
||||||
|
the homeserver. For this reason, users can differentiate spec versions using
|
||||||
|
these functions.
|
||||||
|
|
||||||
|
@docs VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext, Versions)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
import Recursion
|
||||||
|
import Set
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChain helps create a chain of HTTP requests.
|
||||||
|
-}
|
||||||
|
type alias TaskChain ph1 ph2 =
|
||||||
|
C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) { ph1 | baseUrl : () } { ph2 | baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Make an HTTP request that adheres to the Matrix spec rules.
|
||||||
|
-}
|
||||||
|
request :
|
||||||
|
{ attributes : List (R.Attribute { ph1 | baseUrl : () })
|
||||||
|
, coder : Json.Coder returnValue
|
||||||
|
, contextChange : returnValue -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
|
||||||
|
, method : String
|
||||||
|
, path : List String
|
||||||
|
, toUpdate : returnValue -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
|
||||||
|
}
|
||||||
|
-> TaskChain ph1 ph2
|
||||||
|
request data =
|
||||||
|
R.toChain
|
||||||
|
{ logHttp =
|
||||||
|
\r ->
|
||||||
|
( E.HttpRequest r
|
||||||
|
, String.concat
|
||||||
|
-- TODO: Move this to Internal.Config.Text module
|
||||||
|
[ "Matrix HTTP: "
|
||||||
|
, r.method
|
||||||
|
, " "
|
||||||
|
, r.url
|
||||||
|
]
|
||||||
|
|> log.info
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
, coder = data.coder
|
||||||
|
, request =
|
||||||
|
R.callAPI
|
||||||
|
{ method = data.method
|
||||||
|
, path = data.path
|
||||||
|
}
|
||||||
|
|> R.withAttributes data.attributes
|
||||||
|
, toContextChange = data.contextChange
|
||||||
|
, toUpdate = data.toUpdate
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| This type allows different definitions for different spec versions,
|
||||||
|
allowing the Elm SDK to communicate differently to the server depending on
|
||||||
|
how up-to-date the server is.
|
||||||
|
-}
|
||||||
|
type VersionControl a ph1 ph2
|
||||||
|
= VC
|
||||||
|
{ name : VersionType
|
||||||
|
, chain : a -> TaskChain (WithV ph1) (WithV ph2)
|
||||||
|
, prev : Maybe (VersionControl a ph1 ph2)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type VersionType
|
||||||
|
= SpecVersion String
|
||||||
|
| UnstableFeature String
|
||||||
|
|
||||||
|
|
||||||
|
type alias WithV ph =
|
||||||
|
{ ph | versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Start with a given spec version supporting a given API endpoint.
|
||||||
|
-}
|
||||||
|
startWithVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
|
||||||
|
startWithVersion name chain =
|
||||||
|
VC
|
||||||
|
{ name = SpecVersion name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Start with a given unstable feature supporting a given API endpoint.
|
||||||
|
-}
|
||||||
|
startWithUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
|
||||||
|
startWithUnstableFeature name chain =
|
||||||
|
VC
|
||||||
|
{ name = UnstableFeature name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new unstable feature that supports a different version of the API endpoint.
|
||||||
|
-}
|
||||||
|
forUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
|
||||||
|
forUnstableFeature name chain prev =
|
||||||
|
VC
|
||||||
|
{ name = UnstableFeature name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Just prev
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new spec version that supports a different version of the API endpoint.
|
||||||
|
-}
|
||||||
|
forVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
|
||||||
|
forVersion name chain prev =
|
||||||
|
VC
|
||||||
|
{ name = SpecVersion name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Just prev
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add another spec version that has the API endpoint defined the same as the previous API endpoint.
|
||||||
|
-}
|
||||||
|
sameForVersion : String -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
|
||||||
|
sameForVersion name (VC data) =
|
||||||
|
VC
|
||||||
|
{ name = SpecVersion name
|
||||||
|
, chain = data.chain
|
||||||
|
, prev = Just (VC data)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
supportedVersion : Versions -> VersionType -> Bool
|
||||||
|
supportedVersion { versions, unstableFeatures } name =
|
||||||
|
case name of
|
||||||
|
SpecVersion n ->
|
||||||
|
List.member n versions
|
||||||
|
|
||||||
|
UnstableFeature n ->
|
||||||
|
Set.member n unstableFeatures
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- NOTE: Interesting detail! For some reason, I cannot add the `context`
|
||||||
|
-- NOTE: variable to the top line of the defined input values!
|
||||||
|
-- NOTE: Maybe this is a bug?
|
||||||
|
|
||||||
|
|
||||||
|
{-| Once you are done, turn a VersionControl type into a Task Chain.
|
||||||
|
-}
|
||||||
|
versionChain : VersionControl a ph1 ph2 -> a -> TaskChain (WithV ph1) (WithV ph2)
|
||||||
|
versionChain vc input =
|
||||||
|
\context ->
|
||||||
|
case Context.getVersions context of
|
||||||
|
versions ->
|
||||||
|
Recursion.runRecursion
|
||||||
|
(\mvc ->
|
||||||
|
case mvc of
|
||||||
|
Nothing ->
|
||||||
|
Recursion.base (C.fail R.NoSupportedVersion context)
|
||||||
|
|
||||||
|
Just (VC data) ->
|
||||||
|
if supportedVersion versions data.name then
|
||||||
|
Recursion.base (data.chain input context)
|
||||||
|
|
||||||
|
else
|
||||||
|
Recursion.recurse data.prev
|
||||||
|
)
|
||||||
|
(Just vc)
|
|
@ -0,0 +1,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
|
|
@ -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."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,203 @@
|
||||||
|
module Internal.Api.Chain exposing
|
||||||
|
( TaskChain, CompleteChain
|
||||||
|
, IdemChain, toTask
|
||||||
|
, fail, succeed, andThen, catchWith, maybe
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Task chains
|
||||||
|
|
||||||
|
Elm uses a `Task` type to avoid issues that JavaScript deals with, yet the same
|
||||||
|
**callback hell** issue might appear that JavaScript developers often deal with.
|
||||||
|
For this reason, this module helps chain different `Task` types together such
|
||||||
|
that all information is stored and values are dealt with appropriately.
|
||||||
|
|
||||||
|
Elm's type checking system helps making this system sufficiently rigorous to
|
||||||
|
avoid leaking values passing through the API in unexpected ways.
|
||||||
|
|
||||||
|
@docs TaskChain, CompleteChain
|
||||||
|
|
||||||
|
|
||||||
|
## Finished chain
|
||||||
|
|
||||||
|
@docs IdemChain, toTask
|
||||||
|
|
||||||
|
|
||||||
|
## Operations
|
||||||
|
|
||||||
|
@docs fail, succeed, andThen, catchWith, maybe
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Log exposing (Log)
|
||||||
|
import Internal.Values.Context exposing (APIContext)
|
||||||
|
import Task
|
||||||
|
|
||||||
|
|
||||||
|
type alias Backpacked u a =
|
||||||
|
{ a | messages : List u, logs : List Log }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The TaskChain is a piece in the long chain of tasks that need to be completed.
|
||||||
|
The type defines four variables:
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be returned
|
||||||
|
- `a` phantom type before executing the chain's context
|
||||||
|
- `b` phantom type after executing the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChain err u a b =
|
||||||
|
APIContext a -> Task.Task (FailedChainPiece err u) (TaskChainPiece u a b)
|
||||||
|
|
||||||
|
|
||||||
|
{-| An IdemChain is a TaskChain that does not influence the chain's context
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be executed
|
||||||
|
- `a` phantom type before, during and after the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias IdemChain err u a =
|
||||||
|
TaskChain err u a a
|
||||||
|
|
||||||
|
|
||||||
|
{-| A CompleteChain is a complete task chain where all necessary information
|
||||||
|
has been defined. In simple terms, whenever a Matrix API call is made, all
|
||||||
|
necessary information for that endpoint:
|
||||||
|
|
||||||
|
1. Was previously known and has been inserted, or
|
||||||
|
2. Was acquired before actually making the API call.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias CompleteChain u =
|
||||||
|
TaskChain Never u {} {}
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChainPiece is a piece that updates the chain's context.
|
||||||
|
|
||||||
|
Once a chain is executed, the process will add the `messages` value to its list
|
||||||
|
of updates, and it will update its context according to the `contextChange`
|
||||||
|
function.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChainPiece u a b =
|
||||||
|
Backpacked u { contextChange : APIContext a -> APIContext b }
|
||||||
|
|
||||||
|
|
||||||
|
{-| A FailedChainPiece initiates an early breakdown of a chain. Unless caught,
|
||||||
|
this halts execution of the chain. The process will add the `messages` value to
|
||||||
|
its list of updates, and it will return the given `err` value for a direct
|
||||||
|
explanation of what went wrong.
|
||||||
|
-}
|
||||||
|
type alias FailedChainPiece err u =
|
||||||
|
Backpacked u { error : err }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Chain two tasks together. The second task will only run if the first one
|
||||||
|
succeeds.
|
||||||
|
-}
|
||||||
|
andThen : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
|
||||||
|
andThen f2 f1 =
|
||||||
|
\context ->
|
||||||
|
f1 context
|
||||||
|
|> Task.andThen
|
||||||
|
(\old ->
|
||||||
|
context
|
||||||
|
|> old.contextChange
|
||||||
|
|> f2
|
||||||
|
|> Task.map
|
||||||
|
(\new ->
|
||||||
|
{ contextChange = old.contextChange >> new.contextChange
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\new ->
|
||||||
|
{ error = new.error
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error has occurred, "fix" it with an artificial task chain result.
|
||||||
|
-}
|
||||||
|
catchWith : (err -> TaskChainPiece u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
catchWith onErr f =
|
||||||
|
onError (\e -> succeed <| onErr e) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always fails.
|
||||||
|
-}
|
||||||
|
fail : err -> TaskChain err u a b
|
||||||
|
fail e _ =
|
||||||
|
Task.fail { error = e, logs = [], messages = [] }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Optionally run a task that doesn't need to succeed.
|
||||||
|
|
||||||
|
If the provided chain fails, it will be ignored. This way, the chain can be
|
||||||
|
executed without breaking the whole chain if it fails. This can be useful for:
|
||||||
|
|
||||||
|
1. Sending information to the Matrix API and not caring if it actually arrives
|
||||||
|
2. Gaining optional information that might be nice to know, but not necessary
|
||||||
|
|
||||||
|
Consequently, the optional chain cannot add any information that the rest of
|
||||||
|
the chain relies on.
|
||||||
|
|
||||||
|
-}
|
||||||
|
maybe : IdemChain err u a -> IdemChain err2 u a
|
||||||
|
maybe f =
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = []
|
||||||
|
, messages = []
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> always
|
||||||
|
|> onError
|
||||||
|
|> (|>) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error occurs, this function allows the task chain to go down a
|
||||||
|
similar but different route.
|
||||||
|
-}
|
||||||
|
onError : (err -> TaskChain err2 u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
onError onErr f =
|
||||||
|
\context ->
|
||||||
|
f context
|
||||||
|
|> Task.onError
|
||||||
|
(\old ->
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = old.logs -- TODO: Log caught errors
|
||||||
|
, messages = old.messages
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> andThen (onErr old.error)
|
||||||
|
|> (|>) context
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always succeeds.
|
||||||
|
-}
|
||||||
|
succeed : TaskChainPiece u a b -> TaskChain err u a b
|
||||||
|
succeed piece _ =
|
||||||
|
Task.succeed piece
|
||||||
|
|
||||||
|
|
||||||
|
{-| Once the chain is complete, turn it into a valid task.
|
||||||
|
-}
|
||||||
|
toTask : IdemChain Never u a -> APIContext a -> Task.Task Never (Backpacked u {})
|
||||||
|
toTask chain context =
|
||||||
|
chain context
|
||||||
|
|> Task.onError (\e -> Task.succeed <| never e.error)
|
||||||
|
|> Task.map
|
||||||
|
(\backpack ->
|
||||||
|
{ messages = backpack.messages
|
||||||
|
, logs = backpack.logs
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,247 @@
|
||||||
|
module Internal.Api.GetEvent.Api exposing (GetEventInput, getEvent)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Get event
|
||||||
|
|
||||||
|
Get a single event based on `roomId/eventId`. You must have permission to
|
||||||
|
retrieve this event e.g. by being a member in the room for this event.
|
||||||
|
|
||||||
|
@docs GetEventInput, getEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
|
import Internal.Values.Room as Room
|
||||||
|
import Internal.Values.User as User
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Input for getting an event.
|
||||||
|
-}
|
||||||
|
type alias GetEventInput =
|
||||||
|
{ eventId : String, roomId : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Standard input for version 1 of the GetEvent API endpoint.
|
||||||
|
-}
|
||||||
|
type alias GetEventInputV1 a =
|
||||||
|
{ a | eventId : String, roomId : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Universal phantom type encompassing all versions of this API endpoint.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
PhantomV1 { a | versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Phantom values necessary for version 1 of the GetEvent API endpoint.
|
||||||
|
-}
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an event based on a room id and event id.
|
||||||
|
-}
|
||||||
|
getEvent : GetEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
getEvent =
|
||||||
|
A.startWithVersion "r0.5.0" getEventV1
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" getEventV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Version 1 of the GetEvent API endpoint
|
||||||
|
-}
|
||||||
|
getEventV1 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
getEventV1 { eventId, roomId } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.onStatusCode 404 "M_NOT_FOUND"
|
||||||
|
]
|
||||||
|
, coder = getEventCoderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "event", eventId ]
|
||||||
|
, toUpdate =
|
||||||
|
\event ->
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
|
||||||
|
, event.eventId
|
||||||
|
|> Text.logs.getEventId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Version 2 of the GetEvent API endpoint
|
||||||
|
-}
|
||||||
|
getEventV2 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
getEventV2 { eventId, roomId } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.onStatusCode 404 "M_NOT_FOUND"
|
||||||
|
]
|
||||||
|
, coder = getEventCoderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "event", eventId ]
|
||||||
|
, toUpdate =
|
||||||
|
\event ->
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
|
||||||
|
, event.eventId
|
||||||
|
|> Text.logs.getEventId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
getEventCoderV1 : Json.Coder Event
|
||||||
|
getEventCoderV1 =
|
||||||
|
Json.object8
|
||||||
|
{ name = "ClientEvent"
|
||||||
|
, description =
|
||||||
|
[ "ClientEvent as described by the Matrix spec"
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||||
|
]
|
||||||
|
, init = Event
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "content"
|
||||||
|
, toField = .content
|
||||||
|
, description =
|
||||||
|
[ "The body of this event, as created by the client which sent it."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description =
|
||||||
|
[ "The globally unique identifier for this event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "origin_server_ts"
|
||||||
|
, toField = .originServerTs
|
||||||
|
, description =
|
||||||
|
[ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent."
|
||||||
|
]
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "room_id"
|
||||||
|
, toField = .roomId
|
||||||
|
, description =
|
||||||
|
[ "The ID of the room associated with this event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "sender"
|
||||||
|
, toField = .sender
|
||||||
|
, description =
|
||||||
|
[ "Contains the fully-qualified ID of the user who sent this event."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state_key"
|
||||||
|
, toField = .stateKey
|
||||||
|
, description =
|
||||||
|
[ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string."
|
||||||
|
, "State keys starting with an @ are reserved for referencing user IDs, such as room members. With the exception of a few events, state events set with a given user’s ID as the state key MUST only be set by that user."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "type"
|
||||||
|
, toField = .eventType
|
||||||
|
, description =
|
||||||
|
[ "The type of the event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unsigned"
|
||||||
|
, toField = .unsigned
|
||||||
|
, description =
|
||||||
|
[ "Contains optional extra information about the event."
|
||||||
|
]
|
||||||
|
, coder =
|
||||||
|
Json.object4
|
||||||
|
{ name = "UnsignedData"
|
||||||
|
, description =
|
||||||
|
[ "UnsignedData as described by the Matrix spec"
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||||
|
]
|
||||||
|
, init = \a b c d -> Event.UnsignedData { age = a, 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
|
||||||
|
}
|
||||||
|
)
|
||||||
|
}
|
||||||
|
)
|
|
@ -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
|
||||||
|
)
|
||||||
|
}
|
|
@ -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
|
|
@ -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."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
|
@ -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)
|
|
@ -0,0 +1,40 @@
|
||||||
|
module Internal.Api.Now.Api exposing (getNow)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Now
|
||||||
|
|
||||||
|
Get the current time.
|
||||||
|
|
||||||
|
@docs getNow
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Task
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the current time and place it in the context.
|
||||||
|
-}
|
||||||
|
getNow : A.TaskChain a { a | now : () }
|
||||||
|
getNow =
|
||||||
|
\_ ->
|
||||||
|
Task.map
|
||||||
|
(\now ->
|
||||||
|
{ messages = [ E.SetNow now ]
|
||||||
|
, logs =
|
||||||
|
now
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Text.logs.getNow
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
, contextChange = Context.setNow now
|
||||||
|
}
|
||||||
|
)
|
||||||
|
Time.now
|
|
@ -0,0 +1,613 @@
|
||||||
|
module Internal.Api.Request exposing
|
||||||
|
( ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||||
|
, Request, Error(..)
|
||||||
|
, accessToken, timeout, onStatusCode
|
||||||
|
, fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
, queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API module
|
||||||
|
|
||||||
|
This module helps describe API requests.
|
||||||
|
|
||||||
|
|
||||||
|
## Plan
|
||||||
|
|
||||||
|
@docs ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||||
|
|
||||||
|
Sometimes, APIs might fail. As a result, you may receive an error.
|
||||||
|
|
||||||
|
@docs Request, Error
|
||||||
|
|
||||||
|
|
||||||
|
## API attributes
|
||||||
|
|
||||||
|
|
||||||
|
### General attributes
|
||||||
|
|
||||||
|
@docs accessToken, timeout, onStatusCode
|
||||||
|
|
||||||
|
|
||||||
|
### Body
|
||||||
|
|
||||||
|
@docs fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
|
||||||
|
|
||||||
|
### Query parameters
|
||||||
|
|
||||||
|
@docs queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Dict
|
||||||
|
import Http
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Task
|
||||||
|
import Url
|
||||||
|
import Url.Builder as UrlBuilder
|
||||||
|
|
||||||
|
|
||||||
|
{-| The API call is a plan that describes how an interaction is planned with
|
||||||
|
the Matrix API.
|
||||||
|
-}
|
||||||
|
type alias ApiCall ph =
|
||||||
|
{ attributes : List ContextAttr
|
||||||
|
, baseUrl : String
|
||||||
|
, context : APIContext ph
|
||||||
|
, method : String
|
||||||
|
, path : List String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Shortcut definition to define a function that bases an APICall on a given
|
||||||
|
APIContext.
|
||||||
|
-}
|
||||||
|
type alias ApiPlan a =
|
||||||
|
APIContext a -> ApiCall a
|
||||||
|
|
||||||
|
|
||||||
|
{-| An attribute maps a given context to an attribute for an API call.
|
||||||
|
-}
|
||||||
|
type alias Attribute a =
|
||||||
|
APIContext a -> ContextAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| A context attribute describes one aspect of the API call that is to be made.
|
||||||
|
-}
|
||||||
|
type ContextAttr
|
||||||
|
= BodyParam String Json.Value
|
||||||
|
| FullBody Json.Value
|
||||||
|
| Header Http.Header
|
||||||
|
| NoAttr
|
||||||
|
| QueryParam UrlBuilder.QueryParameter
|
||||||
|
| StatusCodeResponse Int ( Error, List Log )
|
||||||
|
| Timeout Float
|
||||||
|
|
||||||
|
|
||||||
|
{-| Error indicating that something went wrong.
|
||||||
|
-}
|
||||||
|
type Error
|
||||||
|
= InternetException Http.Error
|
||||||
|
| MissingUsername
|
||||||
|
| MissingPassword
|
||||||
|
| NoSupportedVersion
|
||||||
|
| ServerReturnsBadJSON String
|
||||||
|
| ServerReturnsError String Json.Value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Ordinary shape of an HTTP request.
|
||||||
|
-}
|
||||||
|
type alias Request x a =
|
||||||
|
{ headers : List Http.Header
|
||||||
|
, body : Http.Body
|
||||||
|
, method : String
|
||||||
|
, url : String
|
||||||
|
, resolver : Http.Resolver x a
|
||||||
|
, timeout : Maybe Float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that requires an access token to be present
|
||||||
|
-}
|
||||||
|
accessToken : Attribute { a | accessToken : () }
|
||||||
|
accessToken =
|
||||||
|
Context.getAccessToken
|
||||||
|
>> (++) "Bearer "
|
||||||
|
>> Http.header "Authorization"
|
||||||
|
>> Header
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyBool : String -> Bool -> Attribute a
|
||||||
|
bodyBool key value =
|
||||||
|
bodyValue key <| Json.encode Json.bool value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyInt : String -> Int -> Attribute a
|
||||||
|
bodyInt key value =
|
||||||
|
bodyValue key <| Json.encode Json.int value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
bodyOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
bodyOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpString : String -> Maybe String -> Attribute a
|
||||||
|
bodyOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpValue : String -> Maybe Json.Value -> Attribute a
|
||||||
|
bodyOpValue key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyValue key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyString : String -> String -> Attribute a
|
||||||
|
bodyString key value =
|
||||||
|
bodyValue key <| Json.encode Json.string value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyValue : String -> Json.Value -> Attribute a
|
||||||
|
bodyValue key value _ =
|
||||||
|
BodyParam key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a plan to create an API call.
|
||||||
|
-}
|
||||||
|
callAPI : { method : String, path : List String } -> ApiPlan { a | baseUrl : () }
|
||||||
|
callAPI { method, path } context =
|
||||||
|
{ attributes = []
|
||||||
|
, baseUrl = Context.getBaseUrl context
|
||||||
|
, context = context
|
||||||
|
, method = method
|
||||||
|
, path = path
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode the server's response into (hopefully) something meaningful.
|
||||||
|
-}
|
||||||
|
decodeServerResponse : D.Decoder ( a, List Log ) -> String -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||||
|
decodeServerResponse decoder body statusCodeError =
|
||||||
|
case D.decodeString D.value body of
|
||||||
|
Err e ->
|
||||||
|
let
|
||||||
|
description : String
|
||||||
|
description =
|
||||||
|
D.errorToString e
|
||||||
|
in
|
||||||
|
Err
|
||||||
|
( ServerReturnsBadJSON description
|
||||||
|
, description
|
||||||
|
|> Text.logs.serverReturnedInvalidJSON
|
||||||
|
|> log.error
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
|
||||||
|
Ok v ->
|
||||||
|
decodeServerValue decoder v statusCodeError
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode the server's response, assuming that it parses correctly to
|
||||||
|
a JSON value.
|
||||||
|
-}
|
||||||
|
decodeServerValue : D.Decoder ( a, List Log ) -> Json.Value -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||||
|
decodeServerValue decoder value statusCodeError =
|
||||||
|
value
|
||||||
|
|> D.decodeValue decoder
|
||||||
|
|> Result.mapError
|
||||||
|
(\err ->
|
||||||
|
let
|
||||||
|
description : String
|
||||||
|
description =
|
||||||
|
D.errorToString err
|
||||||
|
|
||||||
|
-- TODO: Parse errors returned by Matrix API
|
||||||
|
error : Maybe ( Error, List Log )
|
||||||
|
error =
|
||||||
|
Nothing
|
||||||
|
in
|
||||||
|
case ( error, statusCodeError ) of
|
||||||
|
( Just e, _ ) ->
|
||||||
|
e
|
||||||
|
|
||||||
|
( Nothing, Just e ) ->
|
||||||
|
e
|
||||||
|
|
||||||
|
( Nothing, Nothing ) ->
|
||||||
|
( ServerReturnsBadJSON description
|
||||||
|
, description
|
||||||
|
|> Text.logs.serverReturnedUnknownJSON
|
||||||
|
|> log.error
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an empty attribute that does nothing.
|
||||||
|
-}
|
||||||
|
empty : Attribute a
|
||||||
|
empty =
|
||||||
|
always NoAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| Adds a JSON value as the HTTP body.
|
||||||
|
-}
|
||||||
|
fullBody : Json.Value -> Attribute a
|
||||||
|
fullBody value _ =
|
||||||
|
FullBody value
|
||||||
|
|
||||||
|
|
||||||
|
getBody : List ContextAttr -> Maybe Json.Value
|
||||||
|
getBody attributes =
|
||||||
|
attributes
|
||||||
|
|> List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
FullBody v ->
|
||||||
|
Just v
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|> List.reverse
|
||||||
|
|> List.head
|
||||||
|
|> (\fb ->
|
||||||
|
case fb of
|
||||||
|
Just _ ->
|
||||||
|
fb
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
case
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
BodyParam key value ->
|
||||||
|
Just ( key, value )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
attributes
|
||||||
|
of
|
||||||
|
[] ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
head :: tail ->
|
||||||
|
Just <| E.object (head :: tail)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getHeaders : List ContextAttr -> List Http.Header
|
||||||
|
getHeaders =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
Header h ->
|
||||||
|
Just h
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getQueryParams : List ContextAttr -> List UrlBuilder.QueryParameter
|
||||||
|
getQueryParams =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
QueryParam q ->
|
||||||
|
Just q
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getStatusCodes : List ContextAttr -> Dict.Dict Int ( Error, List Log )
|
||||||
|
getStatusCodes =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
StatusCodeResponse code err ->
|
||||||
|
Just ( code, err )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> Dict.fromList
|
||||||
|
|
||||||
|
|
||||||
|
getTimeout : List ContextAttr -> Maybe Float
|
||||||
|
getTimeout =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
Timeout f ->
|
||||||
|
Just f
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> List.reverse
|
||||||
|
>> List.head
|
||||||
|
|
||||||
|
|
||||||
|
getUrl : ApiCall a -> String
|
||||||
|
getUrl { attributes, baseUrl, path } =
|
||||||
|
UrlBuilder.crossOrigin
|
||||||
|
baseUrl
|
||||||
|
(List.map Url.percentEncode path)
|
||||||
|
(getQueryParams attributes)
|
||||||
|
|
||||||
|
|
||||||
|
{-| When the HTTP request cannot be deciphered but the status code is known,
|
||||||
|
return with a given default error.
|
||||||
|
-}
|
||||||
|
onStatusCode : Int -> String -> Attribute a
|
||||||
|
onStatusCode code err _ =
|
||||||
|
StatusCodeResponse code
|
||||||
|
( err
|
||||||
|
|> E.string
|
||||||
|
|> Tuple.pair "errcode"
|
||||||
|
|> List.singleton
|
||||||
|
|> E.object
|
||||||
|
|> ServerReturnsError err
|
||||||
|
, String.concat
|
||||||
|
-- TODO: Move to Internal.Config.Text
|
||||||
|
[ "Received an invalid HTTP response from Matrix server "
|
||||||
|
, "but managed to decode it using the status code "
|
||||||
|
, String.fromInt code
|
||||||
|
, ": Default to errcode "
|
||||||
|
, err
|
||||||
|
]
|
||||||
|
|> log.warn
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryBool : String -> Bool -> Attribute a
|
||||||
|
queryBool key value _ =
|
||||||
|
(if value then
|
||||||
|
"true"
|
||||||
|
|
||||||
|
else
|
||||||
|
"false"
|
||||||
|
)
|
||||||
|
|> UrlBuilder.string key
|
||||||
|
|> QueryParam
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryInt : String -> Int -> Attribute a
|
||||||
|
queryInt key value _ =
|
||||||
|
QueryParam <| UrlBuilder.int key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
queryOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
queryOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpString : String -> Maybe String -> Attribute a
|
||||||
|
queryOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryString : String -> String -> Attribute a
|
||||||
|
queryString key value _ =
|
||||||
|
QueryParam <| UrlBuilder.string key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Resolve the response of a Matrix API call.
|
||||||
|
-}
|
||||||
|
rawApiCallResolver : D.Decoder ( a, List Log ) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
|
||||||
|
rawApiCallResolver decoder statusCodeErrors =
|
||||||
|
Http.stringResolver
|
||||||
|
(\response ->
|
||||||
|
case response of
|
||||||
|
Http.BadUrl_ s ->
|
||||||
|
Http.BadUrl s
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error ("Encountered bad URL " ++ s) ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.Timeout_ ->
|
||||||
|
Http.Timeout
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error "Encountered timeout - maybe the server is down?" ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.NetworkError_ ->
|
||||||
|
Http.NetworkError
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error "Encountered a network error - the user might be offline" ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.BadStatus_ metadata body ->
|
||||||
|
statusCodeErrors
|
||||||
|
|> Dict.get metadata.statusCode
|
||||||
|
|> decodeServerResponse decoder body
|
||||||
|
|
||||||
|
Http.GoodStatus_ metadata body ->
|
||||||
|
statusCodeErrors
|
||||||
|
|> Dict.get metadata.statusCode
|
||||||
|
|> decodeServerResponse decoder body
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Configure the HTTP request to time out after a given expiry time.
|
||||||
|
-}
|
||||||
|
timeout : Float -> Attribute a
|
||||||
|
timeout f _ =
|
||||||
|
Timeout f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform an APICall to a TaskChain.
|
||||||
|
-}
|
||||||
|
toChain :
|
||||||
|
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
|
||||||
|
, coder : Json.Coder httpOut
|
||||||
|
, request : ApiPlan ph1
|
||||||
|
, toContextChange : httpOut -> (APIContext ph1 -> APIContext ph2)
|
||||||
|
, toUpdate : httpOut -> ( update, List Log )
|
||||||
|
}
|
||||||
|
-> C.TaskChain Error update ph1 ph2
|
||||||
|
toChain data apiContext =
|
||||||
|
data.request apiContext
|
||||||
|
|> (\call ->
|
||||||
|
let
|
||||||
|
r : Request ( Error, List Log ) ( httpOut, List Log )
|
||||||
|
r =
|
||||||
|
{ method = call.method
|
||||||
|
, headers = getHeaders call.attributes
|
||||||
|
, url = getUrl call
|
||||||
|
, body =
|
||||||
|
getBody call.attributes
|
||||||
|
|> Maybe.map Http.jsonBody
|
||||||
|
|> Maybe.withDefault Http.emptyBody
|
||||||
|
, resolver = rawApiCallResolver (Json.decode data.coder) (getStatusCodes call.attributes)
|
||||||
|
, timeout = getTimeout call.attributes
|
||||||
|
}
|
||||||
|
|
||||||
|
logR : Request ( Error, List Log ) ( update, List Log )
|
||||||
|
logR =
|
||||||
|
{ method = call.method
|
||||||
|
, headers = getHeaders call.attributes
|
||||||
|
, url = getUrl call
|
||||||
|
, body =
|
||||||
|
getBody call.attributes
|
||||||
|
|> Maybe.map Http.jsonBody
|
||||||
|
|> Maybe.withDefault Http.emptyBody
|
||||||
|
, resolver =
|
||||||
|
rawApiCallResolver
|
||||||
|
(Json.decode data.coder
|
||||||
|
|> D.map
|
||||||
|
(\( out, logs ) ->
|
||||||
|
case data.toUpdate out of
|
||||||
|
( u, uLogs ) ->
|
||||||
|
( u, List.append logs uLogs )
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(getStatusCodes call.attributes)
|
||||||
|
, timeout = getTimeout call.attributes
|
||||||
|
}
|
||||||
|
in
|
||||||
|
case data.logHttp logR of
|
||||||
|
( httpU, httpLogs ) ->
|
||||||
|
Http.task r
|
||||||
|
|> Task.map
|
||||||
|
(\( httpO, logs ) ->
|
||||||
|
case data.toUpdate httpO of
|
||||||
|
( u, uLogs ) ->
|
||||||
|
{ contextChange = data.toContextChange httpO
|
||||||
|
, logs = List.concat [ httpLogs, logs, uLogs ]
|
||||||
|
, messages = [ httpU, u ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\( err, logs ) ->
|
||||||
|
{ error = err
|
||||||
|
, logs = List.append httpLogs logs
|
||||||
|
, messages = [ httpU ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add more attributes to the API plan.
|
||||||
|
-}
|
||||||
|
withAttributes : List (Attribute a) -> ApiPlan a -> ApiPlan a
|
||||||
|
withAttributes attrs f context =
|
||||||
|
f context
|
||||||
|
|> (\data ->
|
||||||
|
{ data
|
||||||
|
| attributes =
|
||||||
|
attrs
|
||||||
|
|> List.map (\attr -> attr data.context)
|
||||||
|
|> List.append data.attributes
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,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
|
||||||
|
}
|
||||||
|
)
|
|
@ -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
|
||||||
|
}
|
||||||
|
)
|
|
@ -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
|
|
@ -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
|
|
@ -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 }
|
||||||
|
}
|
File diff suppressed because it is too large
Load Diff
|
@ -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 aren’t 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
|
|
@ -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 aren’t 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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
|
@ -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 they’ve been released into the spec to give clients a chance to upgrade appropriately. Additionally, clients should avoid using unstable features in their stable releases."
|
||||||
|
]
|
||||||
|
, init = Versions
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "versions"
|
||||||
|
, toField = .versions
|
||||||
|
, description =
|
||||||
|
[ "The supported versions."
|
||||||
|
]
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "unstable_features"
|
||||||
|
, toField = .unstableFeatures
|
||||||
|
, description =
|
||||||
|
[ "Experimental features the server supports. Features not listed here, or the lack of this property all together, indicate that a feature is not supported."
|
||||||
|
]
|
||||||
|
, coder =
|
||||||
|
Json.bool
|
||||||
|
|> Json.slowDict
|
||||||
|
|> Json.map
|
||||||
|
{ name = "Dict to set"
|
||||||
|
, description =
|
||||||
|
[ "Turn a dictionary of supported values into a set that contains only supported values"
|
||||||
|
]
|
||||||
|
, back = Set.foldl (\k d -> Dict.insert k True d) Dict.empty
|
||||||
|
, forth =
|
||||||
|
Dict.foldl
|
||||||
|
(\k v s ->
|
||||||
|
if v then
|
||||||
|
Set.insert k s
|
||||||
|
|
||||||
|
else
|
||||||
|
s
|
||||||
|
)
|
||||||
|
Set.empty
|
||||||
|
}
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,70 @@
|
||||||
|
module Internal.Config.Default exposing
|
||||||
|
( currentVersion, deviceName
|
||||||
|
, syncTime
|
||||||
|
, removePasswordOnLogin
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| This module hosts all default settings and configurations that the Vault
|
||||||
|
will assume until overriden by the user.
|
||||||
|
|
||||||
|
|
||||||
|
## Version management
|
||||||
|
|
||||||
|
@docs currentVersion, deviceName
|
||||||
|
|
||||||
|
|
||||||
|
## Communication config
|
||||||
|
|
||||||
|
@docs syncTime
|
||||||
|
|
||||||
|
|
||||||
|
## Security
|
||||||
|
|
||||||
|
@docs removePasswordOnLogin
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The version that is being communicated to the user
|
||||||
|
-}
|
||||||
|
currentVersion : String
|
||||||
|
currentVersion =
|
||||||
|
"beta 3.5.0"
|
||||||
|
|
||||||
|
|
||||||
|
{-| The default device name that is being communicated with the Matrix API.
|
||||||
|
|
||||||
|
This is mostly useful for users who are logged in with multiple sessions.
|
||||||
|
|
||||||
|
-}
|
||||||
|
deviceName : String
|
||||||
|
deviceName =
|
||||||
|
"Elm SDK (" ++ currentVersion ++ ")"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Whenever the Matrix API has nothing new to report, the Elm SDK is kept on
|
||||||
|
hold until something new happens. The `syncTime` indicates a timeout to how long
|
||||||
|
the Elm SDK tolerates being held on hold.
|
||||||
|
|
||||||
|
- ↗️ A high value is good because it significantly reduces traffic between the
|
||||||
|
user and the homeserver.
|
||||||
|
- ↘️ A low value is good because it reduces the risk of
|
||||||
|
the connection ending abruptly or unexpectedly.
|
||||||
|
|
||||||
|
Nowadays, most libraries use 30 seconds as the standard, as does the Elm SDK.
|
||||||
|
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
|
|
@ -0,0 +1,93 @@
|
||||||
|
module Internal.Config.Leaks exposing
|
||||||
|
( accessToken, baseUrl, field, transaction, versions
|
||||||
|
, allLeaks
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Leaks module
|
||||||
|
|
||||||
|
The Elm compiler is quite picky when it comes to handling edge cases, which may
|
||||||
|
occasionally result in requiring us to insert values in impossible states.
|
||||||
|
|
||||||
|
This module offers placeholders for those times. The placeholder values are
|
||||||
|
intentionally called "leaks", because they should be used carefully: a wrongful
|
||||||
|
implementation might cause unexpected behaviour, vulnerabilities or even
|
||||||
|
security risks!
|
||||||
|
|
||||||
|
You should not use this module unless you know what you're doing. That is:
|
||||||
|
|
||||||
|
- By exclusively using leaking values in opaque types so a user cannot
|
||||||
|
accidentally reach an impossible state
|
||||||
|
- By exclusively using leaking values in cases where the compiler is the only
|
||||||
|
reason that the leaking value needs to be used
|
||||||
|
- By exclusively using leaking values if there is no way to circumvent the
|
||||||
|
compiler with a reasonable method.
|
||||||
|
|
||||||
|
One such example would be to turn an `Maybe Int` into an `Int` if you already
|
||||||
|
know 100% sure that the value isn't `Nothing`.
|
||||||
|
|
||||||
|
Just 5 |> Maybe.withDefault Leaks.number
|
||||||
|
|
||||||
|
@docs accessToken, baseUrl, field, transaction, versions
|
||||||
|
|
||||||
|
For safety purposes, all leaking values are stored in the following value:
|
||||||
|
|
||||||
|
@docs allLeaks
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Set exposing (Set)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder access token.
|
||||||
|
-}
|
||||||
|
accessToken : String
|
||||||
|
accessToken =
|
||||||
|
"elm-sdk-placeholder-access-token-leaks"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Complete set of all leaking values. Commonly using for testing purposes.
|
||||||
|
-}
|
||||||
|
allLeaks : Set String
|
||||||
|
allLeaks =
|
||||||
|
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.
|
||||||
|
-}
|
||||||
|
baseUrl : String
|
||||||
|
baseUrl =
|
||||||
|
"elm-sdk-placeholder-baseurl-leaks.example.org"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder JSON field.
|
||||||
|
-}
|
||||||
|
field : String
|
||||||
|
field =
|
||||||
|
"elm-sdk-placeholder-json-field"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder transaction id.
|
||||||
|
-}
|
||||||
|
transaction : String
|
||||||
|
transaction =
|
||||||
|
"elm-sdk-placeholder-transaction-leaks"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder versions list.
|
||||||
|
-}
|
||||||
|
versions : { versions : List String, unstableFeatures : Set String }
|
||||||
|
versions =
|
||||||
|
{ versions = [ "elm-sdk-placeholder-versions-versions-leaks" ]
|
||||||
|
, unstableFeatures = Set.singleton "elm-sdk-placeholder-versions-unstableFeatures-leaks"
|
||||||
|
}
|
|
@ -0,0 +1,105 @@
|
||||||
|
module Internal.Config.Log exposing (Log, log)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Logs
|
||||||
|
|
||||||
|
The logs module exposes various log types that can be used to indicate logs.
|
||||||
|
This helps users filter for the logs that they care about.
|
||||||
|
|
||||||
|
@docs Log, log
|
||||||
|
|
||||||
|
The logs are encoded as strings as to allow the addition of new log types
|
||||||
|
without triggering a major update.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- @docs caughtError, debug, error, info, securityWarn, warn
|
||||||
|
|
||||||
|
|
||||||
|
{-| Common pattern for a log message. The log message consists of a log channel
|
||||||
|
like `debug`, `warn`, `error`, etc. and the content of the message.
|
||||||
|
|
||||||
|
These logs are completely optional: they can be ignored, they can be sent to the
|
||||||
|
console, or a dialog may be created that presents the log messages.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Log =
|
||||||
|
{ channel : String, content : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a log message of various log types.
|
||||||
|
-}
|
||||||
|
log :
|
||||||
|
{ caughtError : String -> Log
|
||||||
|
, debug : String -> Log
|
||||||
|
, error : String -> Log
|
||||||
|
, info : String -> Log
|
||||||
|
, securityWarn : String -> Log
|
||||||
|
, warn : String -> Log
|
||||||
|
}
|
||||||
|
log =
|
||||||
|
{ caughtError = Log caughtError
|
||||||
|
, debug = Log debug
|
||||||
|
, error = Log error
|
||||||
|
, info = Log info
|
||||||
|
, securityWarn = Log securityWarn
|
||||||
|
, warn = Log warn
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| A caught error is an error that has been caught elsewhere in the code, hence
|
||||||
|
functioning as a secondary debug channel.
|
||||||
|
-}
|
||||||
|
caughtError : String
|
||||||
|
caughtError =
|
||||||
|
"caught-error"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Debug logs are logs that can be used to debug API interactions.
|
||||||
|
-}
|
||||||
|
debug : String
|
||||||
|
debug =
|
||||||
|
"debug"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Error strings indicate that something unexpected has happened. As a result,
|
||||||
|
something has stopped working.
|
||||||
|
-}
|
||||||
|
error : String
|
||||||
|
error =
|
||||||
|
"error"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Info contains relevant info for the user
|
||||||
|
-}
|
||||||
|
info : String
|
||||||
|
info =
|
||||||
|
"info"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Security warnings are warnings that contain red flags.
|
||||||
|
|
||||||
|
Of course, the Elm SDK is not aware of any security vulnerabilities that it
|
||||||
|
contains, but it can raise a user's attention to suspicious situations.
|
||||||
|
|
||||||
|
For example, if the homeserver returns room ids that do not look like usernames
|
||||||
|
at all, the homeserver can raise a security warning, which indicates that:
|
||||||
|
|
||||||
|
1. The homeserver might be bugged
|
||||||
|
2. The Elm SDK might be severaly outdated
|
||||||
|
3. The homeserver might be compromised and/or trying to attack the Elm SDK
|
||||||
|
|
||||||
|
-}
|
||||||
|
securityWarn : String
|
||||||
|
securityWarn =
|
||||||
|
"security-warn"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Warning logs are logs that are unusual, but that can be dealt with. Warnings
|
||||||
|
are debug logs that are out of the ordinary.
|
||||||
|
-}
|
||||||
|
warn : String
|
||||||
|
warn =
|
||||||
|
"warn"
|
|
@ -0,0 +1,51 @@
|
||||||
|
module Internal.Config.Phantom exposing (PString(..), PInt(..), PBool(..), PList(..))
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Phantom types
|
||||||
|
|
||||||
|
This module contains a lot of phantom types that do not necessarily do anything,
|
||||||
|
but they force the compiler to create an error whenever something illegal is
|
||||||
|
done.
|
||||||
|
|
||||||
|
Compiler errors may seem annoying, they can help you write good code. In a
|
||||||
|
functional programming language like Elm, the trick is to design your code in
|
||||||
|
such a way that if it compiles, it works. Phantom types can help you do so.
|
||||||
|
|
||||||
|
The phantom types in this module help you in the following way:
|
||||||
|
|
||||||
|
1. They can help force an compile to fault when you forget to run a function.
|
||||||
|
|
||||||
|
2. They can help track values for security.
|
||||||
|
|
||||||
|
|
||||||
|
## Standard data types
|
||||||
|
|
||||||
|
@docs PString, PInt, PBool, PList
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type that encapsulates a bool.
|
||||||
|
-}
|
||||||
|
type PBool ph
|
||||||
|
= PBool Bool
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type that encapsulates an int.
|
||||||
|
-}
|
||||||
|
type PInt ph
|
||||||
|
= PInt Int
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type that encapsulates a list.
|
||||||
|
-}
|
||||||
|
type PList ph a
|
||||||
|
= PList (List a)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type that encapsulates a string.
|
||||||
|
-}
|
||||||
|
type PString ph
|
||||||
|
= PString String
|
|
@ -0,0 +1,767 @@
|
||||||
|
module Internal.Config.Text exposing
|
||||||
|
( docs, failures, fields, mappings, logs, parses
|
||||||
|
, accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid
|
||||||
|
, versionsFoundLocally, versionsReceived, versionsFailedToDecode
|
||||||
|
, unsupportedVersionForEndpoint
|
||||||
|
, decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| Throughout the Elm SDK, there are lots of pieces of text being used for
|
||||||
|
various purposes. Some of these are:
|
||||||
|
|
||||||
|
- To log what is happening during an API call.
|
||||||
|
- To fail with custom decoder errors.
|
||||||
|
- To describe custom values in a human readable format.
|
||||||
|
|
||||||
|
All magic values of text are gathered in this module, to form a monolithic
|
||||||
|
source of text. This allows people to learn more about the Elm SDK, and it
|
||||||
|
offers room for future translations.
|
||||||
|
|
||||||
|
Optionally, developers can even consider taking the values of some of these
|
||||||
|
variables to interpret them automatically when they appear as logs on the other
|
||||||
|
side. This could be used to automatically detect when the Vault is failing to
|
||||||
|
authenticate, for example, so that a new login screen can be shown. **WARNING:**
|
||||||
|
This is a risky feature, keep in mind that even a patch update might break this!
|
||||||
|
You should only do this if you know what you're doing.
|
||||||
|
|
||||||
|
|
||||||
|
## Type documentation
|
||||||
|
|
||||||
|
@docs docs, failures, fields, mappings, logs, parses
|
||||||
|
|
||||||
|
|
||||||
|
## API Authentication
|
||||||
|
|
||||||
|
Messages sent as API logs during the authentication phase of the API
|
||||||
|
interaction.
|
||||||
|
|
||||||
|
@docs accessTokenFoundLocally, accessTokenExpired, accessTokenInvalid
|
||||||
|
|
||||||
|
offers room for translation, re-wording and refactors.
|
||||||
|
|
||||||
|
|
||||||
|
## API Versions
|
||||||
|
|
||||||
|
Messages sent as API logs while the Elm SDK is figuring out how modern the
|
||||||
|
homeserver is and how it can best communicate.
|
||||||
|
|
||||||
|
@docs versionsFoundLocally, versionsReceived, versionsFailedToDecode
|
||||||
|
|
||||||
|
|
||||||
|
## API miscellaneous messages
|
||||||
|
|
||||||
|
Messages sent as API logs during communication with the API.
|
||||||
|
|
||||||
|
@docs unsupportedVersionForEndpoint
|
||||||
|
|
||||||
|
|
||||||
|
## JSON decoder
|
||||||
|
|
||||||
|
Messages sent as API logs when a JSON value is being decoded.
|
||||||
|
|
||||||
|
@docs decodedDictSize, invalidHashInHashdict, invalidHashInMashdict, leakingValueFound
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Desc =
|
||||||
|
List String
|
||||||
|
|
||||||
|
|
||||||
|
type alias TypeDocs =
|
||||||
|
{ name : String, description : Desc }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs when the Matrix API returns that an access token is no longer valid.
|
||||||
|
-}
|
||||||
|
accessTokenExpired : String
|
||||||
|
accessTokenExpired =
|
||||||
|
"Matrix API reports access token as no longer valid"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs when the Vault has an access token that is still (locally) considered
|
||||||
|
valid.
|
||||||
|
-}
|
||||||
|
accessTokenFoundLocally : String
|
||||||
|
accessTokenFoundLocally =
|
||||||
|
"Found locally cached access token"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs when the Matrix API rejects an access token without explicitly
|
||||||
|
mentioning a reason.
|
||||||
|
-}
|
||||||
|
accessTokenInvalid : String
|
||||||
|
accessTokenInvalid =
|
||||||
|
"Matrix API rejected access token as invalid"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs when the JSON decoder detects that an imported dictionary contained
|
||||||
|
duplicate keys.
|
||||||
|
-}
|
||||||
|
decodedDictSize : Int -> Int -> String
|
||||||
|
decodedDictSize from to =
|
||||||
|
String.concat
|
||||||
|
[ "JSON dict contained duplicate keys (JSON had "
|
||||||
|
, String.fromInt from
|
||||||
|
, " keys, Elm dict has "
|
||||||
|
, String.fromInt to
|
||||||
|
, " keys)"
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Documentation used for all functions and data types in JSON coders
|
||||||
|
-}
|
||||||
|
docs :
|
||||||
|
{ accessToken : TypeDocs
|
||||||
|
, context : TypeDocs
|
||||||
|
, envelope : TypeDocs
|
||||||
|
, event : TypeDocs
|
||||||
|
, hashdict : TypeDocs
|
||||||
|
, ibatch : TypeDocs
|
||||||
|
, itoken : TypeDocs
|
||||||
|
, mashdict : TypeDocs
|
||||||
|
, room : TypeDocs
|
||||||
|
, settings : TypeDocs
|
||||||
|
, stateManager : TypeDocs
|
||||||
|
, strippedEvent : TypeDocs
|
||||||
|
, timeline : TypeDocs
|
||||||
|
, timelineFilter : TypeDocs
|
||||||
|
, unsigned : TypeDocs
|
||||||
|
, vault : TypeDocs
|
||||||
|
, versions : TypeDocs
|
||||||
|
}
|
||||||
|
docs =
|
||||||
|
{ 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."
|
||||||
|
, "The Context contains tokens, values and other bits that the Vault receives from the Matrix API."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, envelope =
|
||||||
|
{ name = "Envelope"
|
||||||
|
, description =
|
||||||
|
[ "The Envelope module wraps existing data types with lots of values and settings that can be adjusted manually."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, event =
|
||||||
|
{ name = "Event"
|
||||||
|
, description =
|
||||||
|
[ "The Event type represents a single value that contains all the information for a single event in the room."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, hashdict =
|
||||||
|
{ name = "Hashdict"
|
||||||
|
, description =
|
||||||
|
[ "This allows you to store values based on an externally defined identifier."
|
||||||
|
, "For example, the hashdict can store events and use their event id as their key."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, ibatch =
|
||||||
|
{ name = "IBatch"
|
||||||
|
, description =
|
||||||
|
[ "The internal batch tracks a patch of events on the Matrix timeline."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, itoken =
|
||||||
|
{ name = "IToken"
|
||||||
|
, description =
|
||||||
|
[ "The IToken connects batches in the timeline and maintains relative order."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, mashdict =
|
||||||
|
{ name = "Mashdict"
|
||||||
|
, description =
|
||||||
|
[ "The mashdict exclusively stores values for which the hashing algorithm returns a value, and it ignores the outcome for all other scenarios."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, room =
|
||||||
|
{ name = "Room"
|
||||||
|
, description =
|
||||||
|
[ "The Room type represents a conversation in Matrix."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, settings =
|
||||||
|
{ name = "Settings"
|
||||||
|
, description =
|
||||||
|
[ "The settings type is a data type to configure settings in the enveloped data type."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, stateManager =
|
||||||
|
{ name = "StateManager"
|
||||||
|
, description =
|
||||||
|
[ "The StateManager tracks the room state based on events, their event types and the optional state keys they provide."
|
||||||
|
, "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 =
|
||||||
|
[ "The Timeline tracks events and orders them in a simple way for the user to view them."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, timelineFilter =
|
||||||
|
{ name = "Timeline Filter"
|
||||||
|
, description =
|
||||||
|
[ "The Timeline Filter allows the user to be very specific about which events they're interested in."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, unsigned =
|
||||||
|
{ name = "Unsigned Data"
|
||||||
|
, description =
|
||||||
|
[ "Unsigned data is optional data that might come along with the event."
|
||||||
|
, "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."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Description of all edge cases where a JSON decoder can fail.
|
||||||
|
-}
|
||||||
|
failures : { hashdict : Desc, listWithOne : String, mashdict : Desc }
|
||||||
|
failures =
|
||||||
|
{ hashdict =
|
||||||
|
[ "Not all values map to their respected hash with the given hash function."
|
||||||
|
]
|
||||||
|
, listWithOne = "Expected at least one value in the list - zero found."
|
||||||
|
, mashdict =
|
||||||
|
[ "Not all values map to their respected hash with the given hash function."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Objects contain multiple fields. These fields are here described, explaining
|
||||||
|
what they do and what they are for.
|
||||||
|
-}
|
||||||
|
fields :
|
||||||
|
{ 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 :
|
||||||
|
{ content : Desc
|
||||||
|
, context : Desc
|
||||||
|
, settings : Desc
|
||||||
|
}
|
||||||
|
, event :
|
||||||
|
{ content : Desc
|
||||||
|
, eventId : Desc
|
||||||
|
, originServerTs : Desc
|
||||||
|
, roomId : Desc
|
||||||
|
, sender : Desc
|
||||||
|
, stateKey : Desc
|
||||||
|
, eventType : Desc
|
||||||
|
, unsigned : Desc
|
||||||
|
}
|
||||||
|
, ibatch :
|
||||||
|
{ end : Desc
|
||||||
|
, events : Desc
|
||||||
|
, filter : Desc
|
||||||
|
, start : Desc
|
||||||
|
}
|
||||||
|
, iddict :
|
||||||
|
{ cursor : Desc
|
||||||
|
, dict : Desc
|
||||||
|
}
|
||||||
|
, itoken :
|
||||||
|
{ behind : Desc
|
||||||
|
, ends : Desc
|
||||||
|
, inFrontOf : Desc
|
||||||
|
, name : Desc
|
||||||
|
, starts : Desc
|
||||||
|
}
|
||||||
|
, room :
|
||||||
|
{ accountData : Desc
|
||||||
|
, ephemeral : Desc
|
||||||
|
, events : Desc
|
||||||
|
, roomId : Desc
|
||||||
|
, state : Desc
|
||||||
|
, timeline : Desc
|
||||||
|
}
|
||||||
|
, settings :
|
||||||
|
{ currentVersion : Desc
|
||||||
|
, deviceName : Desc
|
||||||
|
, presence : Desc
|
||||||
|
, removePasswordOnLogin : Desc
|
||||||
|
, syncTime : Desc
|
||||||
|
}
|
||||||
|
, timeline :
|
||||||
|
{ batches : Desc
|
||||||
|
, events : Desc
|
||||||
|
, filledBatches : Desc
|
||||||
|
, mostRecentBatch : Desc
|
||||||
|
, tokens : Desc
|
||||||
|
}
|
||||||
|
, timelineFilter :
|
||||||
|
{ senders : Desc
|
||||||
|
, sendersAllowOthers : Desc
|
||||||
|
, types : Desc
|
||||||
|
, typesAllowOthers : Desc
|
||||||
|
}
|
||||||
|
, 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 =
|
||||||
|
{ 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."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, envelope =
|
||||||
|
{ content =
|
||||||
|
[ "The actual data or payload that is wrapped within the envelope."
|
||||||
|
]
|
||||||
|
, context =
|
||||||
|
[ "The context information associated with the envelope, such as environment or session details."
|
||||||
|
, "In general, this data cannot be directly configured by the user."
|
||||||
|
]
|
||||||
|
, settings =
|
||||||
|
[ "The configurable settings that affect how the enveloped data is handled or processed."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, event =
|
||||||
|
{ content =
|
||||||
|
[ "The body of this event, as created by the client which sent it."
|
||||||
|
]
|
||||||
|
, eventId =
|
||||||
|
[ "The globally unique identifier for this event."
|
||||||
|
]
|
||||||
|
, originServerTs =
|
||||||
|
[ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent."
|
||||||
|
]
|
||||||
|
, roomId =
|
||||||
|
[ "The ID of the room associated with this event."
|
||||||
|
]
|
||||||
|
, sender =
|
||||||
|
[ "Contains the fully-qualified ID of the user who sent this event."
|
||||||
|
]
|
||||||
|
, stateKey =
|
||||||
|
[ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string."
|
||||||
|
, "State keys starting with an @ are reserved for referencing user IDs, such as room members. With the exception of a few events, state events set with a given user’s ID as the state key MUST only be set by that user."
|
||||||
|
]
|
||||||
|
, eventType =
|
||||||
|
[ "The type of the event."
|
||||||
|
]
|
||||||
|
, unsigned =
|
||||||
|
[ "Contains optional extra information about the event."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, ibatch =
|
||||||
|
{ end =
|
||||||
|
[ "Pointer to the token that ends the internal batch."
|
||||||
|
]
|
||||||
|
, events =
|
||||||
|
[ "List of event IDs contained within the internal batch."
|
||||||
|
]
|
||||||
|
, filter =
|
||||||
|
[ "Filter that indicates how strictly the homeserver has selected when resulting into the given list of events."
|
||||||
|
]
|
||||||
|
, start =
|
||||||
|
[ "Pointer to the token that starts the internal batch."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, iddict =
|
||||||
|
{ cursor =
|
||||||
|
[ "To ensure uniqueness of all keys and to prevent the usage of keys that were previously assigned to older values, the iddict tracks which is the smallest non-negative integer that hasn't been used yet."
|
||||||
|
]
|
||||||
|
, dict =
|
||||||
|
[ "Dictionary that contains all values stored in the iddict."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, itoken =
|
||||||
|
{ behind =
|
||||||
|
[ "This token is behind all tokens in this field."
|
||||||
|
]
|
||||||
|
, ends =
|
||||||
|
[ "This token is in front of the batches in this field."
|
||||||
|
]
|
||||||
|
, inFrontOf =
|
||||||
|
[ "This token is ahead of all tokens in this field."
|
||||||
|
]
|
||||||
|
, name =
|
||||||
|
[ "Opaque value provided by the homeserver."
|
||||||
|
]
|
||||||
|
, starts =
|
||||||
|
[ "This token is at the start of the batches in this field."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, 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 =
|
||||||
|
[ "Unique room identifier" ]
|
||||||
|
, state =
|
||||||
|
[ "Current state of the room based on state events" ]
|
||||||
|
, timeline =
|
||||||
|
[ "Current timeline of the room" ]
|
||||||
|
}
|
||||||
|
, settings =
|
||||||
|
{ currentVersion =
|
||||||
|
[ "Indicates the current version of the Elm SDK."
|
||||||
|
]
|
||||||
|
, 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."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, timeline =
|
||||||
|
{ batches =
|
||||||
|
[ "Dictionary storing all event batches in the timeline."
|
||||||
|
]
|
||||||
|
, events =
|
||||||
|
[ "Mapping that allows us to quickly zoom in on an event."
|
||||||
|
]
|
||||||
|
, filledBatches =
|
||||||
|
[ "Counter that tracks how many batches are kept by the timeline."
|
||||||
|
, "Batches are only counted if they are filled by at least one event."
|
||||||
|
]
|
||||||
|
, mostRecentBatch =
|
||||||
|
[ "Tracks the most recent batch that was sent by the homeserver - usually through `/sync`"
|
||||||
|
]
|
||||||
|
, tokens =
|
||||||
|
[ "Index of all the tokens used to connect event batches on the timeline."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, timelineFilter =
|
||||||
|
{ senders =
|
||||||
|
[ "A list of senders that is considered an exception to the infinite pool of \"other\" users"
|
||||||
|
]
|
||||||
|
, sendersAllowOthers =
|
||||||
|
[ "Value that determines whether the infinite pool of others is included."
|
||||||
|
, "If False, only the users mentioned in `senders` are included. If True, then all users who aren't mentioned in `senders` are included."
|
||||||
|
]
|
||||||
|
, types =
|
||||||
|
[ "A list of event types that is considered an exception to the infinite pool of \"other\" event types."
|
||||||
|
]
|
||||||
|
, typesAllowOthers =
|
||||||
|
[ "Value that determines whether the infinite pool of others is included."
|
||||||
|
, "If False, only the event types mentioned in `types` are included. If True, then all users who aren't mentioned in `types` are included."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, unsigned =
|
||||||
|
{ 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."
|
||||||
|
]
|
||||||
|
, redactedBecause =
|
||||||
|
[ "The event that redacted this event, if any."
|
||||||
|
]
|
||||||
|
, transactionId =
|
||||||
|
[ "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." ]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| This message will be shown when a [Hashdict](Internal-Tools-Hashdict)
|
||||||
|
encounters a hash-value pair where the value does not hash to the provided hash.
|
||||||
|
-}
|
||||||
|
invalidHashInHashdict : String
|
||||||
|
invalidHashInHashdict =
|
||||||
|
"Invalid hash function: not all elements hash to their JSON-stored hashes"
|
||||||
|
|
||||||
|
|
||||||
|
{-| This message will be shown when a [Mashdict](Internal-Tools-Mashdict)
|
||||||
|
encounters a hash-value pair where the value does not hash to the provided hash.
|
||||||
|
-}
|
||||||
|
invalidHashInMashdict : String
|
||||||
|
invalidHashInMashdict =
|
||||||
|
"Invalid hash function: not all elements hash to their JSON-stored hashes"
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Elm SDK occassionally uses [leaking values](Internal-Config-Leaks),
|
||||||
|
which might indicate exceptional behaviour. As such, this log is sent when one
|
||||||
|
of those leaking values is found: to alert the user that something fishy might
|
||||||
|
be going on.
|
||||||
|
-}
|
||||||
|
leakingValueFound : String -> String
|
||||||
|
leakingValueFound leaking_value =
|
||||||
|
"Found leaking value : " ++ leaking_value
|
||||||
|
|
||||||
|
|
||||||
|
{-| These logs might appear during a process where something unexpected has
|
||||||
|
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 :
|
||||||
|
{ 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 =
|
||||||
|
{ 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" ]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Function descriptions
|
||||||
|
-}
|
||||||
|
mappings : { itokenPTR : TypeDocs }
|
||||||
|
mappings =
|
||||||
|
{ itokenPTR =
|
||||||
|
{ name = "ITokenPTR init"
|
||||||
|
, description =
|
||||||
|
[ "Converts an optional string to an Itoken pointer."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs for issues that might be found while parsing strings into meaningful data.
|
||||||
|
-}
|
||||||
|
parses :
|
||||||
|
{ historicalUserId : String -> String
|
||||||
|
, reservedIPs :
|
||||||
|
{ ipv6Toipv4 : String
|
||||||
|
, multicast : String
|
||||||
|
, futureUse : String
|
||||||
|
, unspecified : String
|
||||||
|
}
|
||||||
|
}
|
||||||
|
parses =
|
||||||
|
{ historicalUserId = \name -> "Found a historical username `" ++ name ++ "`."
|
||||||
|
, reservedIPs =
|
||||||
|
{ ipv6Toipv4 = "Detected a reserved ip address that is formerly used as an IPv6 to IPv4 relay. It is unlikely that this IP Address is real."
|
||||||
|
, multicast = "Detected a reserved ip address that is used for multicasting. It is unlikely that this IP Address is real."
|
||||||
|
, futureUse = "Detected a reserves ip address that is reserved for future use. It is unlikely that this IP Address is real if you're running a recent version of the Elm SDK."
|
||||||
|
, unspecified = "This is an unspecified ip address. It is unlikely that this IP Address is real and someone might try to break something."
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Matrix homeserver can specify how it wishes to communicate, and the Elm
|
||||||
|
SDK aims to communicate accordingly. This may fail in some scenarios, however,
|
||||||
|
in which case it will throw this error.
|
||||||
|
|
||||||
|
Most of the time, the error is caused by one of two options:
|
||||||
|
|
||||||
|
1. The homeserver is very archaic and does not (yet) support API endpoints that
|
||||||
|
are nowadays considered mature.
|
||||||
|
|
||||||
|
2. The homeserver is much more modern than the Elm SDK and either uses
|
||||||
|
exclusively API endpoints that the Elm SDK doesn't (yet) support, or it uses
|
||||||
|
spec versions that aren't considered "official" Matrix spec versions and
|
||||||
|
were designed by a third party.
|
||||||
|
|
||||||
|
-}
|
||||||
|
unsupportedVersionForEndpoint : String
|
||||||
|
unsupportedVersionForEndpoint =
|
||||||
|
"This Matrix homeserver and the Elm SDK do not share a common spec version for this endpoint"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Occasionally, the Matrix homeserver fails to communicate how it is best
|
||||||
|
communicated with. Most of the time, this means that the homeserver is somehow
|
||||||
|
unreachable or some gateway error has occured.
|
||||||
|
-}
|
||||||
|
versionsFailedToDecode : String
|
||||||
|
versionsFailedToDecode =
|
||||||
|
"Matrix API returned an invalid version list"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs when the Vault remembers how to communicate with the Matrix homeserver.
|
||||||
|
-}
|
||||||
|
versionsFoundLocally : String
|
||||||
|
versionsFoundLocally =
|
||||||
|
"Found locally cached version list"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Logs when the Matrix API has returned how to best communicate with them.
|
||||||
|
-}
|
||||||
|
versionsReceived : String
|
||||||
|
versionsReceived =
|
||||||
|
"Matrix API returned a version list"
|
|
@ -0,0 +1,346 @@
|
||||||
|
module Internal.Filter.Timeline exposing
|
||||||
|
( Filter
|
||||||
|
, pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail
|
||||||
|
, match, run
|
||||||
|
, and
|
||||||
|
, subsetOf
|
||||||
|
, coder, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Timeline filter
|
||||||
|
|
||||||
|
The timeline filter creates filters for looking through a timeline, as well as
|
||||||
|
for interacting with the Matrix API.
|
||||||
|
|
||||||
|
|
||||||
|
## Timeline
|
||||||
|
|
||||||
|
@docs Filter
|
||||||
|
|
||||||
|
|
||||||
|
## Create
|
||||||
|
|
||||||
|
@docs pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail
|
||||||
|
|
||||||
|
|
||||||
|
## Filter
|
||||||
|
|
||||||
|
@docs match, run
|
||||||
|
|
||||||
|
|
||||||
|
## Combine
|
||||||
|
|
||||||
|
@docs and
|
||||||
|
|
||||||
|
|
||||||
|
## Compare
|
||||||
|
|
||||||
|
@docs subsetOf
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Grammar.UserId as U
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Set exposing (Set)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder Event type so the real Event doesn't need to be imported.
|
||||||
|
-}
|
||||||
|
type alias Event a =
|
||||||
|
{ a | eventType : String, sender : U.UserID }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Timeline Filter filters events out of a timeline, guaranteeing that only
|
||||||
|
the events that meet the given criteria, meet the requirements.
|
||||||
|
-}
|
||||||
|
type Filter
|
||||||
|
= Filter
|
||||||
|
{ senders : Set String
|
||||||
|
, sendersAllowOthers : Bool
|
||||||
|
, types : Set String
|
||||||
|
, typesAllowOthers : Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Allow events from all senders, except if they are on the provided list.
|
||||||
|
|
||||||
|
If the list is empty, all events are allowed.
|
||||||
|
|
||||||
|
-}
|
||||||
|
allSendersExcept : List String -> Filter
|
||||||
|
allSendersExcept senders =
|
||||||
|
case senders of
|
||||||
|
[] ->
|
||||||
|
pass
|
||||||
|
|
||||||
|
_ :: _ ->
|
||||||
|
Filter
|
||||||
|
{ senders = Set.fromList senders
|
||||||
|
, sendersAllowOthers = True
|
||||||
|
, types = Set.empty
|
||||||
|
, typesAllowOthers = True
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Allow events of every event type, except if they are on the provided list.
|
||||||
|
|
||||||
|
If the list is empty, all events are allowed.
|
||||||
|
|
||||||
|
-}
|
||||||
|
allTypesExcept : List String -> Filter
|
||||||
|
allTypesExcept types =
|
||||||
|
case types of
|
||||||
|
[] ->
|
||||||
|
pass
|
||||||
|
|
||||||
|
_ :: _ ->
|
||||||
|
Filter
|
||||||
|
{ senders = Set.empty
|
||||||
|
, sendersAllowOthers = True
|
||||||
|
, types = Set.fromList types
|
||||||
|
, typesAllowOthers = True
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Only allow an event if it meets the criteria of two Filters.
|
||||||
|
-}
|
||||||
|
and : Filter -> Filter -> Filter
|
||||||
|
and (Filter f1) (Filter f2) =
|
||||||
|
let
|
||||||
|
stdAnd : Filter
|
||||||
|
stdAnd =
|
||||||
|
Filter
|
||||||
|
{ senders =
|
||||||
|
case ( f1.sendersAllowOthers, f2.sendersAllowOthers ) of
|
||||||
|
( True, True ) ->
|
||||||
|
Set.union f1.senders f2.senders
|
||||||
|
|
||||||
|
( True, False ) ->
|
||||||
|
Set.diff f2.senders f1.senders
|
||||||
|
|
||||||
|
( False, True ) ->
|
||||||
|
Set.diff f1.senders f2.senders
|
||||||
|
|
||||||
|
( False, False ) ->
|
||||||
|
Set.intersect f1.senders f2.senders
|
||||||
|
, sendersAllowOthers = f1.sendersAllowOthers && f2.sendersAllowOthers
|
||||||
|
, types =
|
||||||
|
case ( f1.typesAllowOthers, f2.typesAllowOthers ) of
|
||||||
|
( True, True ) ->
|
||||||
|
Set.union f1.types f2.types
|
||||||
|
|
||||||
|
( True, False ) ->
|
||||||
|
Set.diff f2.types f1.types
|
||||||
|
|
||||||
|
( False, True ) ->
|
||||||
|
Set.diff f1.types f2.types
|
||||||
|
|
||||||
|
( False, False ) ->
|
||||||
|
Set.intersect f1.types f2.types
|
||||||
|
, typesAllowOthers = f1.typesAllowOthers && f2.typesAllowOthers
|
||||||
|
}
|
||||||
|
in
|
||||||
|
case stdAnd of
|
||||||
|
Filter f ->
|
||||||
|
if Set.isEmpty f.senders && not f.sendersAllowOthers then
|
||||||
|
fail
|
||||||
|
|
||||||
|
else if Set.isEmpty f.types && not f.typesAllowOthers then
|
||||||
|
fail
|
||||||
|
|
||||||
|
else
|
||||||
|
stdAnd
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a Timeline Filter to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder Filter
|
||||||
|
coder =
|
||||||
|
Json.object4
|
||||||
|
{ name = Text.docs.timelineFilter.name
|
||||||
|
, description = Text.docs.timelineFilter.description
|
||||||
|
, init =
|
||||||
|
\a b c d ->
|
||||||
|
Filter
|
||||||
|
{ senders = a
|
||||||
|
, sendersAllowOthers = b
|
||||||
|
, types = c
|
||||||
|
, typesAllowOthers = d
|
||||||
|
}
|
||||||
|
}
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "senders"
|
||||||
|
, toField = \(Filter f) -> f.senders
|
||||||
|
, description = Text.fields.timelineFilter.senders
|
||||||
|
, coder = Json.set Json.string
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "sendersAllowOthers"
|
||||||
|
, toField = \(Filter f) -> f.sendersAllowOthers
|
||||||
|
, description = Text.fields.timelineFilter.sendersAllowOthers
|
||||||
|
, coder = Json.bool
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "types"
|
||||||
|
, toField = \(Filter f) -> f.types
|
||||||
|
, description = Text.fields.timelineFilter.types
|
||||||
|
, coder = Json.set Json.string
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "typesAllowOthers"
|
||||||
|
, toField = \(Filter f) -> f.typesAllowOthers
|
||||||
|
, description = Text.fields.timelineFilter.typesAllowOthers
|
||||||
|
, coder = Json.bool
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a Filter from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder Filter
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a Filter into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Filter
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Allow no events. This filter is likely quite useless in practice, but it is
|
||||||
|
used in the test environment for sanity checks and comparisons.
|
||||||
|
-}
|
||||||
|
fail : Filter
|
||||||
|
fail =
|
||||||
|
Filter
|
||||||
|
{ senders = Set.empty
|
||||||
|
, sendersAllowOthers = False
|
||||||
|
, types = Set.empty
|
||||||
|
, typesAllowOthers = False
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether an event passes a filter.
|
||||||
|
-}
|
||||||
|
match : Filter -> Event a -> Bool
|
||||||
|
match (Filter f) { eventType, sender } =
|
||||||
|
let
|
||||||
|
mentionedSender : Bool
|
||||||
|
mentionedSender =
|
||||||
|
Set.member (U.toString sender) f.senders
|
||||||
|
|
||||||
|
mentionedType : Bool
|
||||||
|
mentionedType =
|
||||||
|
Set.member eventType f.types
|
||||||
|
in
|
||||||
|
xor mentionedSender f.sendersAllowOthers
|
||||||
|
&& xor mentionedType f.typesAllowOthers
|
||||||
|
|
||||||
|
|
||||||
|
{-| Only allow event sent by given senders.
|
||||||
|
|
||||||
|
If an empty list is given, no events are allowed.
|
||||||
|
|
||||||
|
-}
|
||||||
|
onlySenders : List String -> Filter
|
||||||
|
onlySenders senders =
|
||||||
|
case senders of
|
||||||
|
[] ->
|
||||||
|
fail
|
||||||
|
|
||||||
|
_ :: _ ->
|
||||||
|
Filter
|
||||||
|
{ senders = Set.fromList senders
|
||||||
|
, sendersAllowOthers = False
|
||||||
|
, types = Set.empty
|
||||||
|
, typesAllowOthers = True
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Only allow events of a given event type.
|
||||||
|
|
||||||
|
If an empty list is given, no events are allowed.
|
||||||
|
|
||||||
|
-}
|
||||||
|
onlyTypes : List String -> Filter
|
||||||
|
onlyTypes types =
|
||||||
|
case types of
|
||||||
|
[] ->
|
||||||
|
fail
|
||||||
|
|
||||||
|
_ :: _ ->
|
||||||
|
Filter
|
||||||
|
{ senders = Set.empty
|
||||||
|
, sendersAllowOthers = True
|
||||||
|
, types = Set.fromList types
|
||||||
|
, typesAllowOthers = False
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a filter that allows all events. This can be useful when trying to
|
||||||
|
combine multiple filters, or when simply all events are allowed.
|
||||||
|
-}
|
||||||
|
pass : Filter
|
||||||
|
pass =
|
||||||
|
Filter
|
||||||
|
{ senders = Set.empty
|
||||||
|
, sendersAllowOthers = True
|
||||||
|
, types = Set.empty
|
||||||
|
, typesAllowOthers = True
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Use a filter on a list of events.
|
||||||
|
-}
|
||||||
|
run : Filter -> List (Event a) -> List (Event a)
|
||||||
|
run f events =
|
||||||
|
List.filter (match f) events
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether the second argument is a subset filter of the first
|
||||||
|
argument.
|
||||||
|
-}
|
||||||
|
subsetOf : Filter -> Filter -> Bool
|
||||||
|
subsetOf (Filter big) (Filter small) =
|
||||||
|
let
|
||||||
|
isSSof : Set String -> Set String -> Bool
|
||||||
|
isSSof b s =
|
||||||
|
Set.intersect b s == s
|
||||||
|
|
||||||
|
isSubsetFor : ( Bool, Set String ) -> ( Bool, Set String ) -> Bool
|
||||||
|
isSubsetFor ( bb, sb ) ( bs, ss ) =
|
||||||
|
case ( bb, bs ) of
|
||||||
|
( True, True ) ->
|
||||||
|
isSSof ss sb
|
||||||
|
|
||||||
|
( True, False ) ->
|
||||||
|
Set.isEmpty (Set.intersect sb ss)
|
||||||
|
|
||||||
|
( False, True ) ->
|
||||||
|
False
|
||||||
|
|
||||||
|
( False, False ) ->
|
||||||
|
isSSof sb ss
|
||||||
|
in
|
||||||
|
isSubsetFor
|
||||||
|
( big.sendersAllowOthers, big.senders )
|
||||||
|
( small.sendersAllowOthers, small.senders )
|
||||||
|
&& isSubsetFor
|
||||||
|
( big.typesAllowOthers, big.types )
|
||||||
|
( small.typesAllowOthers, small.types )
|
|
@ -0,0 +1,278 @@
|
||||||
|
module Internal.Grammar.ServerName exposing
|
||||||
|
( ServerName, toString, fromString
|
||||||
|
, serverNameParser
|
||||||
|
, HostName(..)
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Server name
|
||||||
|
|
||||||
|
A homeserver is uniquely identified by its server name. The server name
|
||||||
|
represents the address at which the homeserver in question can be reached by
|
||||||
|
other homeservers.
|
||||||
|
|
||||||
|
@docs ServerName, toString, fromString
|
||||||
|
|
||||||
|
|
||||||
|
## Parser
|
||||||
|
|
||||||
|
@docs serverNameParser
|
||||||
|
|
||||||
|
|
||||||
|
## Debug
|
||||||
|
|
||||||
|
@docs HostName
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Tools.ParserExtra as PE
|
||||||
|
import Parser as P exposing ((|.), (|=), Parser)
|
||||||
|
|
||||||
|
|
||||||
|
{-| The hostname is the location where the server can be found.
|
||||||
|
|
||||||
|
Notice how the Matrix spec specifies that the hostname can either be a DNS name,
|
||||||
|
an IPv4Address or an IPv6Address. Since the IPv4Address is compatible with the
|
||||||
|
specification of DNS names, however, and RFC1123 (section 2.1) does not require
|
||||||
|
a client to distinguish them, we treat IPv4Addresses like DNS names.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type HostName
|
||||||
|
= DNS String
|
||||||
|
| IPv6 IPv6Address
|
||||||
|
|
||||||
|
|
||||||
|
{-| The IPv6Address is represented by a list of items BEFORE and AFTER the
|
||||||
|
double colons (::).
|
||||||
|
-}
|
||||||
|
type alias IPv6Address =
|
||||||
|
{ front : List String, back : List String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The server name is a combination of a hostname and an optional port.
|
||||||
|
-}
|
||||||
|
type alias ServerName =
|
||||||
|
{ host : HostName, port_ : Maybe Int }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parser for the DNS name record. The Matrix spec bases its grammar on the
|
||||||
|
standard for internet host names, as specified by RFC1123, section 2.1, with an
|
||||||
|
extension IPv6 literals.
|
||||||
|
|
||||||
|
[RFC-1123 §2.2]
|
||||||
|
|
||||||
|
The syntax of a legal Internet host name was specified in RFC-952
|
||||||
|
[DNS:4]. One aspect of host name syntax is hereby changed: the
|
||||||
|
restriction on the first character is relaxed to allow either a
|
||||||
|
letter or a digit. Host software MUST support this more liberal
|
||||||
|
syntax.
|
||||||
|
|
||||||
|
Host software MUST handle host names of up to 63 characters and
|
||||||
|
SHOULD handle host names of up to 255 characters.
|
||||||
|
|
||||||
|
[RFC-952 §Assumptions-1]
|
||||||
|
|
||||||
|
A "name" (Net, Host, Gateway, or Domain name) is a text string up
|
||||||
|
to 24 characters drawn from the alphabet (A-Z), digits (0-9), minus
|
||||||
|
sign (-), and period (.). Note that periods are only allowed when
|
||||||
|
they serve to delimit components of "domain style names". (See
|
||||||
|
RFC-921, "Domain Name System Implementation Schedule", for
|
||||||
|
background).
|
||||||
|
|
||||||
|
-}
|
||||||
|
dnsNameParser : Parser String
|
||||||
|
dnsNameParser =
|
||||||
|
P.chompIf Char.isAlphaNum
|
||||||
|
|. P.chompWhile (\c -> Char.isAlphaNum c || c == '-' || c == '.')
|
||||||
|
|> P.getChompedString
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a string to a server name.
|
||||||
|
-}
|
||||||
|
fromString : String -> Maybe ServerName
|
||||||
|
fromString s =
|
||||||
|
P.run (serverNameParser |. P.end) s
|
||||||
|
|> (\out ->
|
||||||
|
case out of
|
||||||
|
Ok _ ->
|
||||||
|
out
|
||||||
|
|
||||||
|
Err e ->
|
||||||
|
Debug.log "No parse" e
|
||||||
|
|> always (Debug.log "original" s)
|
||||||
|
|> always out
|
||||||
|
)
|
||||||
|
|> Result.toMaybe
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse a Hostname.
|
||||||
|
-}
|
||||||
|
hostnameParser : Parser HostName
|
||||||
|
hostnameParser =
|
||||||
|
P.oneOf
|
||||||
|
[ P.succeed IPv6
|
||||||
|
|. P.symbol "["
|
||||||
|
|= ipv6Parser
|
||||||
|
|. P.symbol "]"
|
||||||
|
, P.succeed DNS
|
||||||
|
|= dnsNameParser
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse all values to the left of the double colon (::)
|
||||||
|
-}
|
||||||
|
ipv6LeftParser : Parser (List String)
|
||||||
|
ipv6LeftParser =
|
||||||
|
P.oneOf
|
||||||
|
[ P.succeed []
|
||||||
|
|. P.symbol ":"
|
||||||
|
, P.succeed (|>)
|
||||||
|
|= PE.times 1 7 (ipv6NumParser |. P.symbol ":")
|
||||||
|
|= P.oneOf
|
||||||
|
[ P.succeed (\bottom tail -> tail ++ [ bottom ])
|
||||||
|
|= ipv6NumParser
|
||||||
|
, P.succeed identity
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse an ordinary IPv6 number
|
||||||
|
-}
|
||||||
|
ipv6NumParser : Parser String
|
||||||
|
ipv6NumParser =
|
||||||
|
P.chompIf Char.isHexDigit
|
||||||
|
|> P.getChompedString
|
||||||
|
|> PE.times 1 4
|
||||||
|
|> P.map String.concat
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse an IPv6 Address
|
||||||
|
-}
|
||||||
|
ipv6Parser : Parser IPv6Address
|
||||||
|
ipv6Parser =
|
||||||
|
ipv6LeftParser
|
||||||
|
|> P.andThen
|
||||||
|
(\front ->
|
||||||
|
if List.length front < 8 then
|
||||||
|
P.succeed (IPv6Address front)
|
||||||
|
|= ipv6RightParser (8 - 1 - List.length front)
|
||||||
|
-- The -1 is because :: implies one or more zeroes
|
||||||
|
|
||||||
|
else
|
||||||
|
P.succeed (IPv6Address front [])
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse all values to the right of the double colon (::)
|
||||||
|
-}
|
||||||
|
ipv6RightParser : Int -> Parser (List String)
|
||||||
|
ipv6RightParser n =
|
||||||
|
if n > 0 then
|
||||||
|
P.succeed identity
|
||||||
|
|. P.symbol ":"
|
||||||
|
|= P.oneOf
|
||||||
|
[ P.succeed (::)
|
||||||
|
|= ipv6NumParser
|
||||||
|
|= PE.times 0
|
||||||
|
(n - 1)
|
||||||
|
(P.succeed identity
|
||||||
|
|. P.symbol ":"
|
||||||
|
|= ipv6NumParser
|
||||||
|
)
|
||||||
|
, P.succeed []
|
||||||
|
]
|
||||||
|
|
||||||
|
else
|
||||||
|
P.succeed []
|
||||||
|
|. 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
|
||||||
|
|
||||||
|
|
||||||
|
portParser : Parser Int
|
||||||
|
portParser =
|
||||||
|
P.chompIf Char.isDigit
|
||||||
|
|. P.chompWhile Char.isDigit
|
||||||
|
|> P.getChompedString
|
||||||
|
|> P.andThen
|
||||||
|
(\v ->
|
||||||
|
case String.toInt v of
|
||||||
|
Just i ->
|
||||||
|
if 0 <= i && i <= 2 ^ 16 - 1 then
|
||||||
|
P.succeed i
|
||||||
|
|
||||||
|
else
|
||||||
|
P.problem ("Port out of range: " ++ v)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
P.problem "Not a port number"
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse a server name. Generally used by other identifiers that have a server
|
||||||
|
name as one of its parts.
|
||||||
|
-}
|
||||||
|
serverNameParser : Parser ServerName
|
||||||
|
serverNameParser =
|
||||||
|
P.succeed ServerName
|
||||||
|
|= hostnameParser
|
||||||
|
|= P.oneOf
|
||||||
|
[ P.succeed Just
|
||||||
|
|. P.symbol ":"
|
||||||
|
|= portParser
|
||||||
|
, P.succeed Nothing
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a parsed server name back to a string.
|
||||||
|
-}
|
||||||
|
toString : ServerName -> String
|
||||||
|
toString { host, port_ } =
|
||||||
|
let
|
||||||
|
hostString : String
|
||||||
|
hostString =
|
||||||
|
case host of
|
||||||
|
DNS name ->
|
||||||
|
name
|
||||||
|
|
||||||
|
IPv6 { front, back } ->
|
||||||
|
(if List.length front == 8 then
|
||||||
|
List.intersperse ":" front
|
||||||
|
|
||||||
|
else if List.length back == 8 then
|
||||||
|
List.intersperse ":" back
|
||||||
|
|
||||||
|
else
|
||||||
|
List.concat
|
||||||
|
[ List.intersperse ":" front
|
||||||
|
, [ "::" ]
|
||||||
|
, List.intersperse ":" back
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|> String.concat
|
||||||
|
|> (\i -> "[" ++ i ++ "]")
|
||||||
|
|
||||||
|
portString : String
|
||||||
|
portString =
|
||||||
|
port_
|
||||||
|
|> Maybe.map String.fromInt
|
||||||
|
|> Maybe.map ((++) ":")
|
||||||
|
|> Maybe.withDefault ""
|
||||||
|
in
|
||||||
|
hostString ++ portString
|
|
@ -0,0 +1,128 @@
|
||||||
|
module Internal.Grammar.UserId exposing
|
||||||
|
( UserID, toString, fromString
|
||||||
|
, userIdParser, isHistorical
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# User ids
|
||||||
|
|
||||||
|
Users within Matrix are uniquely identified by their Matrix user ID. The user
|
||||||
|
ID is namespaced to the homeserver which allocated the account and has the form:
|
||||||
|
|
||||||
|
@localpart:domain
|
||||||
|
|
||||||
|
The localpart of a user ID is an opaque identifier for that user. It MUST NOT
|
||||||
|
be empty, and MUST contain only the characters a-z, 0-9, ., \_, =, -, /, and +.
|
||||||
|
|
||||||
|
The domain of a user ID is the server name of the homeserver which allocated
|
||||||
|
the account.
|
||||||
|
|
||||||
|
The length of a user ID, including the @ sigil and the domain, MUST NOT exceed
|
||||||
|
255 characters.
|
||||||
|
|
||||||
|
The complete grammar for a legal user ID is:
|
||||||
|
|
||||||
|
user_id = "@" user_id_localpart ":" server_name
|
||||||
|
user_id_localpart = 1*user_id_char
|
||||||
|
user_id_char = DIGIT
|
||||||
|
/ %x61-7A ; a-z
|
||||||
|
/ "-" / "." / "=" / "_" / "/" / "+"
|
||||||
|
|
||||||
|
Older versions of this specification were more tolerant of the characters
|
||||||
|
permitted in user ID localparts. There are currently active users whose user
|
||||||
|
IDs do not conform to the permitted character set, and a number of rooms whose
|
||||||
|
history includes events with a sender which does not conform. In order to
|
||||||
|
handle these rooms successfully, clients and servers MUST accept user IDs with
|
||||||
|
localparts from the expanded character set:
|
||||||
|
|
||||||
|
extended_user_id_char = %x21-39 / %x3B-7E ; all ASCII printing chars except :
|
||||||
|
|
||||||
|
|
||||||
|
## User ID
|
||||||
|
|
||||||
|
@docs UserID, toString, fromString
|
||||||
|
|
||||||
|
|
||||||
|
## Extra
|
||||||
|
|
||||||
|
@docs userIdParser, isHistorical
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Grammar.ServerName as ServerName exposing (ServerName)
|
||||||
|
import Internal.Tools.ParserExtra as PE
|
||||||
|
import Parser as P exposing ((|.), (|=), Parser)
|
||||||
|
|
||||||
|
|
||||||
|
{-| The User ID type defining a user.
|
||||||
|
-}
|
||||||
|
type alias UserID =
|
||||||
|
{ localpart : String, domain : ServerName }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a Matrix User ID back into its uniquely identifying string.
|
||||||
|
-}
|
||||||
|
fromString : String -> Maybe UserID
|
||||||
|
fromString =
|
||||||
|
P.run (userIdParser |. P.end) >> Result.toMaybe
|
||||||
|
|
||||||
|
|
||||||
|
{-| Return a boolean on whether a Matrix user has a historical user ID.
|
||||||
|
Since this user ID is not SUPPOSED to be legal but clients are nevertheless
|
||||||
|
forced to support them due to backwards compatibility, clients may occasionally
|
||||||
|
attempt to break the rules in an attempt to find undefined behaviour.
|
||||||
|
|
||||||
|
As a result, an explicit method to spot historical users is added to the SDK.
|
||||||
|
|
||||||
|
-}
|
||||||
|
isHistorical : UserID -> Bool
|
||||||
|
isHistorical { localpart } =
|
||||||
|
String.any
|
||||||
|
(\c ->
|
||||||
|
let
|
||||||
|
i : Int
|
||||||
|
i =
|
||||||
|
Char.toCode c
|
||||||
|
in
|
||||||
|
not ((0x61 <= i && i <= 0x7A) || Char.isAlpha c)
|
||||||
|
)
|
||||||
|
localpart
|
||||||
|
|
||||||
|
|
||||||
|
localpartParser : Parser String
|
||||||
|
localpartParser =
|
||||||
|
P.chompIf validHistoricalUsernameChar
|
||||||
|
|> P.getChompedString
|
||||||
|
|> PE.times 1 255
|
||||||
|
|> P.map String.concat
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a parsed User ID to a string.
|
||||||
|
-}
|
||||||
|
toString : UserID -> String
|
||||||
|
toString { localpart, domain } =
|
||||||
|
String.concat [ "@", localpart, ":", ServerName.toString domain ]
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse a UserID from a string.
|
||||||
|
-}
|
||||||
|
userIdParser : Parser UserID
|
||||||
|
userIdParser =
|
||||||
|
P.succeed UserID
|
||||||
|
|. P.symbol "@"
|
||||||
|
|= localpartParser
|
||||||
|
|. P.symbol ":"
|
||||||
|
|= ServerName.serverNameParser
|
||||||
|
|> PE.maxLength 255
|
||||||
|
|
||||||
|
|
||||||
|
validHistoricalUsernameChar : Char -> Bool
|
||||||
|
validHistoricalUsernameChar c =
|
||||||
|
let
|
||||||
|
i : Int
|
||||||
|
i =
|
||||||
|
Char.toCode c
|
||||||
|
in
|
||||||
|
(0x21 <= i && i <= 0x39) || (0x3B <= i && i <= 0x7E)
|
|
@ -0,0 +1,220 @@
|
||||||
|
module Internal.Tools.DecodeExtra exposing
|
||||||
|
( opField, opFieldWithDefault
|
||||||
|
, map9, map10, map11, map12, map13
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Decode module
|
||||||
|
|
||||||
|
This module contains helper functions that help decode JSON.
|
||||||
|
|
||||||
|
|
||||||
|
## Optional field decoders
|
||||||
|
|
||||||
|
@docs opField, opFieldWithDefault
|
||||||
|
|
||||||
|
|
||||||
|
## Extended map functions
|
||||||
|
|
||||||
|
@docs map9, map10, map11, map12, map13
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Json.Decode as D
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an optional field decoder. If the field exists, the decoder will fail
|
||||||
|
if the field doesn't decode properly.
|
||||||
|
|
||||||
|
This decoder standard out from `D.maybe <| D.field fieldName decoder` because
|
||||||
|
that will decode into a `Nothing` if the `decoder` fails. This function will
|
||||||
|
only decode into a `Nothing` if the field doesn't exist, and will fail if
|
||||||
|
`decoder` fails.
|
||||||
|
|
||||||
|
The function also returns Nothing if the field exists but it is null.
|
||||||
|
|
||||||
|
-}
|
||||||
|
opField : String -> D.Decoder a -> D.Decoder (Maybe a)
|
||||||
|
opField fieldName decoder =
|
||||||
|
D.value
|
||||||
|
|> D.field fieldName
|
||||||
|
|> D.maybe
|
||||||
|
|> D.andThen
|
||||||
|
(\v ->
|
||||||
|
case v of
|
||||||
|
Just _ ->
|
||||||
|
D.oneOf
|
||||||
|
[ D.null Nothing
|
||||||
|
, D.map Just decoder
|
||||||
|
]
|
||||||
|
|> D.field fieldName
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
D.succeed Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an optional field decoder. If the field is not given, the decoder will
|
||||||
|
return a default value. If the field exists, the decoder will fail if the field
|
||||||
|
doesn't decode properly.
|
||||||
|
-}
|
||||||
|
opFieldWithDefault : String -> a -> D.Decoder a -> D.Decoder a
|
||||||
|
opFieldWithDefault fieldName default decoder =
|
||||||
|
opField fieldName decoder |> D.map (Maybe.withDefault default)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Try 9 decoders and combine the result.
|
||||||
|
-}
|
||||||
|
map9 :
|
||||||
|
(a -> b -> c -> d -> e -> f -> g -> h -> i -> 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 value
|
||||||
|
map9 func da db dc dd de df dg dh di =
|
||||||
|
D.map8
|
||||||
|
(\a b c d e f g ( h, i ) ->
|
||||||
|
func a b c d e f g h i
|
||||||
|
)
|
||||||
|
da
|
||||||
|
db
|
||||||
|
dc
|
||||||
|
dd
|
||||||
|
de
|
||||||
|
df
|
||||||
|
dg
|
||||||
|
(D.map2 Tuple.pair dh di)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Try 10 decoders and combine the result.
|
||||||
|
-}
|
||||||
|
map10 :
|
||||||
|
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> 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 value
|
||||||
|
map10 func da db dc dd de df dg dh di dj =
|
||||||
|
D.map8
|
||||||
|
(\a b c d e f ( g, h ) ( i, j ) ->
|
||||||
|
func a b c d e f g h i j
|
||||||
|
)
|
||||||
|
da
|
||||||
|
db
|
||||||
|
dc
|
||||||
|
dd
|
||||||
|
de
|
||||||
|
df
|
||||||
|
(D.map2 Tuple.pair dg dh)
|
||||||
|
(D.map2 Tuple.pair di dj)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Try 11 decoders and combine the result.
|
||||||
|
-}
|
||||||
|
map11 :
|
||||||
|
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> 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 value
|
||||||
|
map11 func da db dc dd de df dg dh di dj dk =
|
||||||
|
D.map8
|
||||||
|
(\a b c d e ( f, g ) ( h, i ) ( j, k ) ->
|
||||||
|
func a b c d e f g h i j k
|
||||||
|
)
|
||||||
|
da
|
||||||
|
db
|
||||||
|
dc
|
||||||
|
dd
|
||||||
|
de
|
||||||
|
(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)
|
|
@ -0,0 +1,52 @@
|
||||||
|
module Internal.Tools.EncodeExtra exposing (maybeObject)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Encode module
|
||||||
|
|
||||||
|
This module contains helper functions that help decode JSON.
|
||||||
|
|
||||||
|
|
||||||
|
# Optional body object
|
||||||
|
|
||||||
|
@docs maybeObject
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Json.Encode as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a body object based on optionally provided values.
|
||||||
|
|
||||||
|
In other words, the following two variables create the same JSON value:
|
||||||
|
|
||||||
|
value1 : Json.Encode.Value
|
||||||
|
value1 =
|
||||||
|
maybeObject
|
||||||
|
[ ( "name", Just (Json.Encode.string "Alice") )
|
||||||
|
, ( "age", Nothing )
|
||||||
|
, ( "height", Just (Json.Encode.float 1.61) )
|
||||||
|
, ( "weight", Nothing )
|
||||||
|
]
|
||||||
|
|
||||||
|
value2 : Json.Encode.Value
|
||||||
|
value2 =
|
||||||
|
Json.Encode.object
|
||||||
|
[ ( "name", Json.Encode.string "Alice" )
|
||||||
|
, ( "height", Json.Encode.float 1.61 )
|
||||||
|
]
|
||||||
|
|
||||||
|
-}
|
||||||
|
maybeObject : List ( String, Maybe E.Value ) -> E.Value
|
||||||
|
maybeObject =
|
||||||
|
List.filterMap
|
||||||
|
(\( name, value ) ->
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
Just ( name, v )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> E.object
|
|
@ -0,0 +1,345 @@
|
||||||
|
module Internal.Tools.Hashdict exposing
|
||||||
|
( Hashdict
|
||||||
|
, empty, singleton, insert, remove, removeKey
|
||||||
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
, keys, values, toList, fromList
|
||||||
|
, rehash, union, map, update
|
||||||
|
, coder, encode, decoder, softDecoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| This module abstracts the `Dict` type with one function that assigns a
|
||||||
|
unique identifier for each value based on a function that assigns each value.
|
||||||
|
|
||||||
|
This allows you to store values based on an externally defined identifier.
|
||||||
|
|
||||||
|
|
||||||
|
## Dictionaries
|
||||||
|
|
||||||
|
@docs Hashdict
|
||||||
|
|
||||||
|
|
||||||
|
## Build
|
||||||
|
|
||||||
|
@docs empty, singleton, insert, remove, removeKey
|
||||||
|
|
||||||
|
|
||||||
|
## Query
|
||||||
|
|
||||||
|
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
|
||||||
|
|
||||||
|
## Lists
|
||||||
|
|
||||||
|
@docs keys, values, toList, fromList
|
||||||
|
|
||||||
|
|
||||||
|
## Transform
|
||||||
|
|
||||||
|
@docs rehash, union, map, update
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs coder, encode, decoder, softDecoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Config.Log as Log
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
|
||||||
|
|
||||||
|
{-| A dictionary of keys and values where each key is defined by its value. For
|
||||||
|
example, this can be useful when every user is identifiable by their username:
|
||||||
|
|
||||||
|
import Hashdict exposing (Hashdict)
|
||||||
|
|
||||||
|
users : Hashdict User
|
||||||
|
users =
|
||||||
|
Hashdict.fromList .name
|
||||||
|
[ User "Alice" 28 1.65
|
||||||
|
, User "Bob" 19 1.82
|
||||||
|
, User "Chuck" 33 1.75
|
||||||
|
]
|
||||||
|
|
||||||
|
type alias User =
|
||||||
|
{ name : String
|
||||||
|
, age : Int
|
||||||
|
, height : Float
|
||||||
|
}
|
||||||
|
|
||||||
|
In the example listed above, the users are stored by their username, which means
|
||||||
|
that all you need to know is the value "Alice" to retrieve all the information
|
||||||
|
about them. Additionally, you do not need to specify a key to insert the values.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Hashdict a
|
||||||
|
= Hashdict
|
||||||
|
{ hash : a -> String
|
||||||
|
, values : Dict String a
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how Hashdict can be encoded to and decoded from a JSON object.
|
||||||
|
-}
|
||||||
|
coder : (a -> String) -> Json.Coder a -> Json.Coder (Hashdict a)
|
||||||
|
coder f c1 =
|
||||||
|
Json.andThen
|
||||||
|
{ name = Text.docs.hashdict.name
|
||||||
|
, description = Text.docs.hashdict.description
|
||||||
|
, forth =
|
||||||
|
-- TODO: Implement fastDictWithFilter function
|
||||||
|
\items ->
|
||||||
|
case List.filter (\( k, v ) -> f v /= k) (Dict.toList items) of
|
||||||
|
[] ->
|
||||||
|
{ hash = f, values = items }
|
||||||
|
|> Hashdict
|
||||||
|
|> Json.succeed
|
||||||
|
|> (|>) []
|
||||||
|
|
||||||
|
wrongHashes ->
|
||||||
|
wrongHashes
|
||||||
|
|> List.map Tuple.first
|
||||||
|
|> List.map ((++) "Invalid hash")
|
||||||
|
|> List.map Log.log.error
|
||||||
|
|> Json.fail Text.invalidHashInHashdict
|
||||||
|
, back = \(Hashdict h) -> h.values
|
||||||
|
, failure =
|
||||||
|
Text.failures.hashdict
|
||||||
|
}
|
||||||
|
(Json.fastDict c1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a hashdict from a JSON value. To create a hashdict, you are expected
|
||||||
|
to insert a hash function. If the hash function doesn't properly hash the values
|
||||||
|
as expected, the decoder will fail to decode the hashdict.
|
||||||
|
-}
|
||||||
|
decoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a)
|
||||||
|
decoder f c1 =
|
||||||
|
Json.decode (coder f c1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an empty hashdict.
|
||||||
|
-}
|
||||||
|
empty : (a -> String) -> Hashdict a
|
||||||
|
empty hash =
|
||||||
|
Hashdict { hash = hash, values = Dict.empty }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a Hashdict into a JSON value. Keep in mind that an Elm function
|
||||||
|
cannot be universally converted to JSON, so it is up to you to preserve that
|
||||||
|
hash function!
|
||||||
|
-}
|
||||||
|
encode : Json.Coder a -> Json.Encoder (Hashdict a)
|
||||||
|
encode c1 (Hashdict h) =
|
||||||
|
Json.encode (coder h.hash c1) (Hashdict h)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert an association list into a hashdict.
|
||||||
|
-}
|
||||||
|
fromList : (a -> String) -> List a -> Hashdict a
|
||||||
|
fromList hash xs =
|
||||||
|
Hashdict
|
||||||
|
{ hash = hash
|
||||||
|
, values =
|
||||||
|
xs
|
||||||
|
|> List.map (\x -> ( hash x, x ))
|
||||||
|
|> Dict.fromList
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the value associated with a hash. If the hash is not found, return
|
||||||
|
`Nothing`. This is useful when you are not sure if a hash will be in the
|
||||||
|
hashdict.
|
||||||
|
-}
|
||||||
|
get : String -> Hashdict a -> Maybe a
|
||||||
|
get k (Hashdict h) =
|
||||||
|
Dict.get k h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a value into a hashdict. The key is automatically generated by the
|
||||||
|
hash function. If the function generates a collision, it replaces the existing
|
||||||
|
value in the hashdict.
|
||||||
|
-}
|
||||||
|
insert : a -> Hashdict a -> Hashdict a
|
||||||
|
insert v (Hashdict h) =
|
||||||
|
Hashdict { h | values = Dict.insert (h.hash v) v h.values }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Since the Hashdict contains a hash function, the == operator does not work
|
||||||
|
simply. Instead, you should use the isEqual operator.
|
||||||
|
-}
|
||||||
|
isEqual : Hashdict a -> Hashdict a -> Bool
|
||||||
|
isEqual h1 h2 =
|
||||||
|
toList h1 == toList h2
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a hashdict is empty.
|
||||||
|
-}
|
||||||
|
isEmpty : Hashdict a -> Bool
|
||||||
|
isEmpty (Hashdict h) =
|
||||||
|
Dict.isEmpty h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get all of the hashes in a hashdict, sorted from lowest to highest.
|
||||||
|
-}
|
||||||
|
keys : Hashdict a -> List String
|
||||||
|
keys (Hashdict h) =
|
||||||
|
Dict.keys h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map a value on a given key. If the outcome of the function changes the hash,
|
||||||
|
the operation does nothing.
|
||||||
|
-}
|
||||||
|
map : String -> (a -> a) -> Hashdict a -> Hashdict a
|
||||||
|
map key f (Hashdict h) =
|
||||||
|
Hashdict
|
||||||
|
{ h
|
||||||
|
| values =
|
||||||
|
Dict.update
|
||||||
|
key
|
||||||
|
(Maybe.map
|
||||||
|
(\value ->
|
||||||
|
let
|
||||||
|
newValue : a
|
||||||
|
newValue =
|
||||||
|
f value
|
||||||
|
in
|
||||||
|
if h.hash newValue == h.hash value then
|
||||||
|
newValue
|
||||||
|
|
||||||
|
else
|
||||||
|
value
|
||||||
|
)
|
||||||
|
)
|
||||||
|
h.values
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a value's hash is in a hashdict.
|
||||||
|
-}
|
||||||
|
member : a -> Hashdict a -> Bool
|
||||||
|
member value (Hashdict h) =
|
||||||
|
Dict.member (h.hash value) h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a hash is in a hashdict.
|
||||||
|
-}
|
||||||
|
memberKey : String -> Hashdict a -> Bool
|
||||||
|
memberKey key (Hashdict h) =
|
||||||
|
Dict.member key h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remap a hashdict using a new hashing algorithm.
|
||||||
|
-}
|
||||||
|
rehash : (a -> String) -> Hashdict a -> Hashdict a
|
||||||
|
rehash f (Hashdict h) =
|
||||||
|
Hashdict
|
||||||
|
{ hash = f
|
||||||
|
, values =
|
||||||
|
h.values
|
||||||
|
|> Dict.values
|
||||||
|
|> List.map (\v -> ( f v, v ))
|
||||||
|
|> Dict.fromList
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove a value from a hashdict. If the value's hash is found, the key-value
|
||||||
|
pair is removed. If the value's hash is not found, no changes are made.
|
||||||
|
|
||||||
|
hdict |> Hashdict.remove (User "Alice" 19 1.82)
|
||||||
|
|
||||||
|
-}
|
||||||
|
remove : a -> Hashdict a -> Hashdict a
|
||||||
|
remove v (Hashdict h) =
|
||||||
|
Hashdict { h | values = Dict.remove (h.hash v) h.values }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove a key from a hashdict. If the key is not found, no changes are made.
|
||||||
|
|
||||||
|
hdict |> Hashdict.removeKey "Alice"
|
||||||
|
|
||||||
|
-}
|
||||||
|
removeKey : String -> Hashdict a -> Hashdict a
|
||||||
|
removeKey k (Hashdict h) =
|
||||||
|
Hashdict { h | values = Dict.remove k h.values }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a hashdict with a single key-value pair.
|
||||||
|
-}
|
||||||
|
singleton : (a -> String) -> a -> Hashdict a
|
||||||
|
singleton f v =
|
||||||
|
empty f |> insert v
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the number of values in a hashdict.
|
||||||
|
-}
|
||||||
|
size : Hashdict a -> Int
|
||||||
|
size (Hashdict h) =
|
||||||
|
Dict.size h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a hashdict from a JSON value. If you cannot deduce the originally
|
||||||
|
used hash function, (or if you simply do not care) you can use this function to
|
||||||
|
decode and rehash the Hashdict using your new hash function.
|
||||||
|
-}
|
||||||
|
softDecoder : (a -> String) -> Json.Coder a -> Json.Decoder (Hashdict a)
|
||||||
|
softDecoder f c1 =
|
||||||
|
c1
|
||||||
|
|> Json.fastDict
|
||||||
|
|> Json.map
|
||||||
|
{ name = Text.docs.hashdict.name
|
||||||
|
, description = Text.docs.hashdict.description
|
||||||
|
, forth =
|
||||||
|
\items ->
|
||||||
|
Hashdict { hash = f, values = items }
|
||||||
|
|> rehash f
|
||||||
|
, back = \(Hashdict h) -> h.values
|
||||||
|
}
|
||||||
|
|> Json.decode
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a hashdict into an association list of key-value pairs, sorted by
|
||||||
|
keys.
|
||||||
|
-}
|
||||||
|
toList : Hashdict a -> List ( String, a )
|
||||||
|
toList (Hashdict h) =
|
||||||
|
Dict.toList h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Combine two hashdicts under the hash function of the first. If there is a
|
||||||
|
collision, preference is given to the first hashdict.
|
||||||
|
-}
|
||||||
|
union : Hashdict a -> Hashdict a -> Hashdict a
|
||||||
|
union (Hashdict h1) hd2 =
|
||||||
|
case rehash h1.hash hd2 of
|
||||||
|
Hashdict h2 ->
|
||||||
|
Hashdict
|
||||||
|
{ hash = h1.hash
|
||||||
|
, values = Dict.union h1.values h2.values
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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
|
||||||
|
values (Hashdict h) =
|
||||||
|
Dict.values h.values
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,352 @@
|
||||||
|
module Internal.Tools.Mashdict exposing
|
||||||
|
( Mashdict
|
||||||
|
, empty, singleton, insert, remove, removeKey
|
||||||
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
, keys, values, toList, fromList
|
||||||
|
, rehash, union, map
|
||||||
|
, coder, encode, decoder, softDecoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Mashdict
|
||||||
|
|
||||||
|
A **mashdict**, (short for "maybe mashdict") is a hashdict that uses a hash
|
||||||
|
function that _maybe_ returns a value. In this case, the mashdict exclusively
|
||||||
|
stores values for which the hashing algorithm returns a value, and it ignores
|
||||||
|
the outcome for all other scenarios.
|
||||||
|
|
||||||
|
In general, you are advised to learn more about the
|
||||||
|
[Hashdict](Internal-Tools-Hashdict) before delving into the Mashdict.
|
||||||
|
|
||||||
|
|
||||||
|
## Dictionaries
|
||||||
|
|
||||||
|
@docs Mashdict
|
||||||
|
|
||||||
|
|
||||||
|
## Build
|
||||||
|
|
||||||
|
@docs empty, singleton, insert, remove, removeKey
|
||||||
|
|
||||||
|
|
||||||
|
## Query
|
||||||
|
|
||||||
|
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
|
||||||
|
|
||||||
|
## Lists
|
||||||
|
|
||||||
|
@docs keys, values, toList, fromList
|
||||||
|
|
||||||
|
|
||||||
|
## Transform
|
||||||
|
|
||||||
|
@docs rehash, union, map
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs coder, encode, decoder, softDecoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Config.Log as Log
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
|
||||||
|
|
||||||
|
{-| A dictionary of keys and values where each key is defined by its value, but
|
||||||
|
a value is not always given. For example, this can be relevant when not all
|
||||||
|
inserted values are relevant:
|
||||||
|
|
||||||
|
import Mashdict exposing (Mashdict)
|
||||||
|
|
||||||
|
users : Mashdict Event
|
||||||
|
users =
|
||||||
|
Mashdict.fromList .location
|
||||||
|
[ Event "Graduation party" 8 (Just "park")
|
||||||
|
, Event "National holiday" 17 Nothing
|
||||||
|
, Event "Local fair" 11 (Just "town square")
|
||||||
|
]
|
||||||
|
|
||||||
|
-- National holiday will be ignored
|
||||||
|
-- because it does not hash
|
||||||
|
type alias Event =
|
||||||
|
{ name : String
|
||||||
|
, participants : Int
|
||||||
|
, location : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
In the example listed above, all events are stored by their specified location,
|
||||||
|
which means that all you need to know is the value "park" to retrieve all the
|
||||||
|
information about the event at the park. As a result of optimization, this means
|
||||||
|
all values without a hash, are filtered out, as we can never query them.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Mashdict a
|
||||||
|
= Mashdict
|
||||||
|
{ hash : a -> Maybe String
|
||||||
|
, values : Dict String a
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how a Mashdict can be encoded to and decoded from a JSON object.
|
||||||
|
-}
|
||||||
|
coder : (a -> Maybe String) -> Json.Coder a -> Json.Coder (Mashdict a)
|
||||||
|
coder f c1 =
|
||||||
|
Json.andThen
|
||||||
|
{ name = Text.docs.mashdict.name
|
||||||
|
, description = Text.docs.mashdict.description
|
||||||
|
, forth =
|
||||||
|
\items ->
|
||||||
|
case List.filter (\( k, v ) -> f v /= Just k) (Dict.toList items) of
|
||||||
|
[] ->
|
||||||
|
{ hash = f, values = items }
|
||||||
|
|> Mashdict
|
||||||
|
|> Json.succeed
|
||||||
|
|> (|>) []
|
||||||
|
|
||||||
|
wrongHashes ->
|
||||||
|
wrongHashes
|
||||||
|
|> List.map Tuple.first
|
||||||
|
|> List.map ((++) "Invalid hash")
|
||||||
|
|> List.map Log.log.error
|
||||||
|
|> Json.fail Text.invalidHashInMashdict
|
||||||
|
, back = \(Mashdict h) -> h.values
|
||||||
|
, failure = Text.failures.mashdict
|
||||||
|
}
|
||||||
|
(Json.fastDict c1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a mashdict from a JSON value. To create a mashdict, you are expected
|
||||||
|
to insert a hash function. If the hash function doesn't properly hash the values
|
||||||
|
as expected, the decoder will fail to decode the mashdict.
|
||||||
|
-}
|
||||||
|
decoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a)
|
||||||
|
decoder f c1 =
|
||||||
|
Json.decode (coder f c1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an empty mashdict.
|
||||||
|
-}
|
||||||
|
empty : (a -> Maybe String) -> Mashdict a
|
||||||
|
empty hash =
|
||||||
|
Mashdict { hash = hash, values = Dict.empty }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a Mashdict into a JSON value. Keep in mind that an Elm function
|
||||||
|
cannot be universally converted to JSON, so it is up to you to preserve that
|
||||||
|
hash function!
|
||||||
|
-}
|
||||||
|
encode : Json.Coder a -> Json.Encoder (Mashdict a)
|
||||||
|
encode c1 (Mashdict h) =
|
||||||
|
Json.encode (coder h.hash c1) (Mashdict h)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert an association list into a mashdict.
|
||||||
|
-}
|
||||||
|
fromList : (a -> Maybe String) -> List a -> Mashdict a
|
||||||
|
fromList hash xs =
|
||||||
|
Mashdict
|
||||||
|
{ hash = hash
|
||||||
|
, values =
|
||||||
|
xs
|
||||||
|
|> List.filterMap (\x -> hash x |> Maybe.map (\hx -> ( hx, x )))
|
||||||
|
|> Dict.fromList
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the value associated with a hash. If the hash is not found, return
|
||||||
|
`Nothing`. This is useful when you are not sure if a hash will be in the
|
||||||
|
mashdict.
|
||||||
|
-}
|
||||||
|
get : String -> Mashdict a -> Maybe a
|
||||||
|
get k (Mashdict h) =
|
||||||
|
Dict.get k h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a value into a mashdict. The key is automatically generated by the
|
||||||
|
hash function. If the function generates a collision, it replaces the existing
|
||||||
|
value in the mashdict. If the function returns `Nothing`, the value isn't
|
||||||
|
inserted and the original Mashdict is returned.
|
||||||
|
-}
|
||||||
|
insert : a -> Mashdict a -> Mashdict a
|
||||||
|
insert v (Mashdict h) =
|
||||||
|
case h.hash v of
|
||||||
|
Just hash ->
|
||||||
|
Mashdict { h | values = Dict.insert hash v h.values }
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Mashdict h
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a mashdict is empty.
|
||||||
|
-}
|
||||||
|
isEmpty : Mashdict a -> Bool
|
||||||
|
isEmpty (Mashdict h) =
|
||||||
|
Dict.isEmpty h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Since the Hashdict contains a hash function, the == operator does not work
|
||||||
|
simply. Instead, you should use the isEqual operator.
|
||||||
|
-}
|
||||||
|
isEqual : Mashdict a -> Mashdict a -> Bool
|
||||||
|
isEqual h1 h2 =
|
||||||
|
toList h1 == toList h2
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get all of the hashes in a mashdict, sorted from lowest to highest.
|
||||||
|
-}
|
||||||
|
keys : Mashdict a -> List String
|
||||||
|
keys (Mashdict h) =
|
||||||
|
Dict.keys h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map a value on a given key. If the outcome of the function changes the hash,
|
||||||
|
the operation does nothing.
|
||||||
|
-}
|
||||||
|
map : String -> (a -> a) -> Mashdict a -> Mashdict a
|
||||||
|
map key f (Mashdict h) =
|
||||||
|
Mashdict
|
||||||
|
{ h
|
||||||
|
| values =
|
||||||
|
Dict.update
|
||||||
|
key
|
||||||
|
(Maybe.map
|
||||||
|
(\value ->
|
||||||
|
case h.hash (f value) of
|
||||||
|
Just newHash ->
|
||||||
|
if newHash == key then
|
||||||
|
f value
|
||||||
|
|
||||||
|
else
|
||||||
|
value
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
value
|
||||||
|
)
|
||||||
|
)
|
||||||
|
h.values
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a value's hash is in a mashdict.
|
||||||
|
-}
|
||||||
|
member : a -> Mashdict a -> Bool
|
||||||
|
member value (Mashdict h) =
|
||||||
|
h.hash value
|
||||||
|
|> Maybe.map (\key -> Dict.member key h.values)
|
||||||
|
|> Maybe.withDefault False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a hash is in a mashdict.
|
||||||
|
-}
|
||||||
|
memberKey : String -> Mashdict a -> Bool
|
||||||
|
memberKey key (Mashdict h) =
|
||||||
|
Dict.member key h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remap a mashdict using a new hashing algorithm.
|
||||||
|
-}
|
||||||
|
rehash : (a -> Maybe String) -> Mashdict a -> Mashdict a
|
||||||
|
rehash f (Mashdict h) =
|
||||||
|
Mashdict
|
||||||
|
{ hash = f
|
||||||
|
, values =
|
||||||
|
h.values
|
||||||
|
|> Dict.values
|
||||||
|
|> List.filterMap
|
||||||
|
(\v -> Maybe.map (\hash -> ( hash, v )) (f v))
|
||||||
|
|> Dict.fromList
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove a value from a mashdict. If the value's hash is found, the key-value
|
||||||
|
pair is removed. If the value's hash is not found, no changes are made.
|
||||||
|
|
||||||
|
hdict |> Mashdict.remove (Event "Graduation party" 8 (Just "park"))
|
||||||
|
|
||||||
|
-}
|
||||||
|
remove : a -> Mashdict a -> Mashdict a
|
||||||
|
remove v (Mashdict h) =
|
||||||
|
case h.hash v of
|
||||||
|
Just hash ->
|
||||||
|
Mashdict { h | values = Dict.remove hash h.values }
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Mashdict h
|
||||||
|
|
||||||
|
|
||||||
|
{-| Remove a key from a mashdict. If the key is not found, no changes are made.
|
||||||
|
|
||||||
|
hdict |> Mashdict.removeKey "park"
|
||||||
|
|
||||||
|
-}
|
||||||
|
removeKey : String -> Mashdict a -> Mashdict a
|
||||||
|
removeKey k (Mashdict h) =
|
||||||
|
Mashdict { h | values = Dict.remove k h.values }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a mashdict with a single key-value pair.
|
||||||
|
-}
|
||||||
|
singleton : (a -> Maybe String) -> a -> Mashdict a
|
||||||
|
singleton f v =
|
||||||
|
empty f |> insert v
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the number of values in a mashdict.
|
||||||
|
-}
|
||||||
|
size : Mashdict a -> Int
|
||||||
|
size (Mashdict h) =
|
||||||
|
Dict.size h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a mashdict from a JSON value. If you cannot deduce the originally
|
||||||
|
used hash function, (or if you simply do not care) you can use this function to
|
||||||
|
decode and rehash the Mashdict using your new hash function.
|
||||||
|
-}
|
||||||
|
softDecoder : (a -> Maybe String) -> Json.Coder a -> Json.Decoder (Mashdict a)
|
||||||
|
softDecoder f c1 =
|
||||||
|
c1
|
||||||
|
|> Json.fastDict
|
||||||
|
|> Json.map
|
||||||
|
{ name = Text.docs.hashdict.name
|
||||||
|
, description = Text.docs.hashdict.description
|
||||||
|
, forth =
|
||||||
|
\items ->
|
||||||
|
Mashdict { hash = f, values = items }
|
||||||
|
|> rehash f
|
||||||
|
, back = \(Mashdict h) -> h.values
|
||||||
|
}
|
||||||
|
|> Json.decode
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a mashdict into an association list of key-value pairs, sorted by
|
||||||
|
keys.
|
||||||
|
-}
|
||||||
|
toList : Mashdict a -> List ( String, a )
|
||||||
|
toList (Mashdict h) =
|
||||||
|
Dict.toList h.values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Combine two mashdicts under the hash function of the first. If there is a
|
||||||
|
collision, preference is given to the first mashdict.
|
||||||
|
-}
|
||||||
|
union : Mashdict a -> Mashdict a -> Mashdict a
|
||||||
|
union (Mashdict h1) hd2 =
|
||||||
|
case rehash h1.hash hd2 of
|
||||||
|
Mashdict h2 ->
|
||||||
|
Mashdict
|
||||||
|
{ hash = h1.hash
|
||||||
|
, values = Dict.union h1.values h2.values
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get all values stored in the mashdict, in the order of their keys.
|
||||||
|
-}
|
||||||
|
values : Mashdict a -> List a
|
||||||
|
values (Mashdict h) =
|
||||||
|
Dict.values h.values
|
|
@ -0,0 +1,142 @@
|
||||||
|
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 []
|
||||||
|
(\tail ->
|
||||||
|
P.oneOf
|
||||||
|
[ P.succeed (\head -> P.Loop (head :: tail))
|
||||||
|
|= parser
|
||||||
|
, P.succeed (P.Done (List.reverse tail))
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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 (::)
|
||||||
|
|= 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 []
|
||||||
|
(\tail ->
|
||||||
|
if List.length tail < n then
|
||||||
|
P.succeed (\head -> P.Loop (head :: tail))
|
||||||
|
|= parser
|
||||||
|
|
||||||
|
else
|
||||||
|
P.oneOf
|
||||||
|
[ P.succeed (\head -> P.Loop (head :: tail))
|
||||||
|
|= parser
|
||||||
|
, P.succeed (P.Done (List.reverse tail))
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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 []
|
||||||
|
(\tail ->
|
||||||
|
if List.length tail < n then
|
||||||
|
P.oneOf
|
||||||
|
[ P.succeed (\head -> P.Loop (head :: tail))
|
||||||
|
|= parser
|
||||||
|
, P.succeed (P.Done (List.reverse tail))
|
||||||
|
]
|
||||||
|
|
||||||
|
else
|
||||||
|
P.succeed (P.Done (List.reverse tail))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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
|
||||||
|
low : Int
|
||||||
|
low =
|
||||||
|
max 0 (min inf sup)
|
||||||
|
|
||||||
|
high : Int
|
||||||
|
high =
|
||||||
|
max 0 sup
|
||||||
|
in
|
||||||
|
P.loop []
|
||||||
|
(\tail ->
|
||||||
|
if List.length tail < low then
|
||||||
|
P.succeed (\head -> P.Loop (head :: tail))
|
||||||
|
|= parser
|
||||||
|
|
||||||
|
else if List.length tail < high then
|
||||||
|
P.oneOf
|
||||||
|
[ P.succeed (\head -> P.Loop (head :: tail))
|
||||||
|
|= parser
|
||||||
|
, P.succeed (P.Done (List.reverse tail))
|
||||||
|
]
|
||||||
|
|
||||||
|
else
|
||||||
|
P.succeed (P.Done (List.reverse tail))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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
|
||||||
|
(\start value end ->
|
||||||
|
if abs (end - start) > n then
|
||||||
|
P.problem "Parsed too much text!"
|
||||||
|
|
||||||
|
else
|
||||||
|
P.succeed value
|
||||||
|
)
|
||||||
|
|= P.getOffset
|
||||||
|
|= parser
|
||||||
|
|= P.getOffset
|
||||||
|
|> P.andThen identity
|
|
@ -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 }
|
|
@ -0,0 +1,79 @@
|
||||||
|
module Internal.Tools.Timestamp exposing
|
||||||
|
( Timestamp
|
||||||
|
, add, toMs
|
||||||
|
, coder, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The Timestamp module is a simplification of the Timestamp as delivered by
|
||||||
|
elm/time. This module offers ways to work with the timestamp in meaningful ways.
|
||||||
|
|
||||||
|
|
||||||
|
## Timestamp
|
||||||
|
|
||||||
|
@docs Timestamp
|
||||||
|
|
||||||
|
|
||||||
|
## Calculate
|
||||||
|
|
||||||
|
@docs add, toMs
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Timestamp data type representing a moment in time.
|
||||||
|
-}
|
||||||
|
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
|
||||||
|
coder =
|
||||||
|
Json.map
|
||||||
|
{ back = Time.posixToMillis
|
||||||
|
, forth = Time.millisToPosix
|
||||||
|
, name = "Milliseconds to POSIX"
|
||||||
|
, description =
|
||||||
|
[ "Converts the timestamp from milliseconds to a POSIX timestamp."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
Json.int
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a timestamp into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Timestamp
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a timestamp from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder Timestamp
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Turn a Timestamp into a number of miliseconds
|
||||||
|
-}
|
||||||
|
toMs : Timestamp -> Int
|
||||||
|
toMs =
|
||||||
|
Time.posixToMillis
|
|
@ -0,0 +1,365 @@
|
||||||
|
module Internal.Tools.VersionControl exposing
|
||||||
|
( VersionControl, withBottomLayer
|
||||||
|
, sameForVersion, MiddleLayer, addMiddleLayer
|
||||||
|
, isSupported, toDict, fromVersion, mostRecentFromVersionList, fromVersionList
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Version Control module
|
||||||
|
|
||||||
|
This module helps you maintain different functions based on their version.
|
||||||
|
|
||||||
|
Not every Matrix homeserver is the same. Some keep up with the latest Matrix
|
||||||
|
specifications, while others stay behind because they have to support legacy
|
||||||
|
projects who do not support new API endpoints (yet). The Elm SDK aims to support
|
||||||
|
as many homeserver versions as possible - at the same time.
|
||||||
|
|
||||||
|
Support for legacy versions can be difficult! The Elm SDK expects one way of
|
||||||
|
getting information, and translating every Matrix spec(ification) version to it
|
||||||
|
can take time. But what if a new Matrix spec version adds a new feature? Do we
|
||||||
|
need to re-translate every single version to accomodate any future updates?
|
||||||
|
|
||||||
|
The VersionControl helps define different API rules for different spec versions
|
||||||
|
in an easy way. The VersionControl module puts all the versions in a linear
|
||||||
|
timeline. (Because, you know, updates are usually newer versions of older
|
||||||
|
versions.) This way, you can define different behaviour while still having only
|
||||||
|
one input, one output.
|
||||||
|
|
||||||
|
The module can be best described as a layered version type.
|
||||||
|
|
||||||
|
|----------------------------------------------|
|
||||||
|
| VersionControl |
|
||||||
|
| input output |
|
||||||
|
| | ^ |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| MiddleLayer v3 | | |
|
||||||
|
| [---> current ---] |
|
||||||
|
| | | |
|
||||||
|
| downcast upcast |
|
||||||
|
| | ^ |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| MiddleLayer v2 | | |
|
||||||
|
| [---> current ---] |
|
||||||
|
| | | |
|
||||||
|
| downcast upcast |
|
||||||
|
| | ^ |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| BottomLayer v1 | | |
|
||||||
|
| \---> current ---/ |
|
||||||
|
| |
|
||||||
|
|----------------------------------------------|
|
||||||
|
|
||||||
|
This method means you only need to write one downcast, one current and one
|
||||||
|
upcast whenever you introduce a new version. In other words, you can instantly
|
||||||
|
update all functions without having to write every version!
|
||||||
|
|
||||||
|
The VersionControl keeps tracks the version order. This way, you can either get
|
||||||
|
the VersionControl type to render the function for the most recent supported
|
||||||
|
version, or you can choose for yourself which version you prefer to use.
|
||||||
|
|
||||||
|
|
||||||
|
## Building a VersionControl
|
||||||
|
|
||||||
|
To build a VersionControl type, one must start with the bottom layer and start
|
||||||
|
building up to newer versions with middle layers.
|
||||||
|
|
||||||
|
|
||||||
|
### Create
|
||||||
|
|
||||||
|
@docs VersionControl, withBottomLayer
|
||||||
|
|
||||||
|
|
||||||
|
### Expand
|
||||||
|
|
||||||
|
@docs sameForVersion, MiddleLayer, addMiddleLayer
|
||||||
|
|
||||||
|
|
||||||
|
## Getting functions
|
||||||
|
|
||||||
|
Once you've successfully built the VersionControl type, there's a variety of
|
||||||
|
ways in which you can find an appropriate function.
|
||||||
|
|
||||||
|
@docs isSupported, toDict, fromVersion, mostRecentFromVersionList, fromVersionList
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Dict exposing (Dict)
|
||||||
|
|
||||||
|
|
||||||
|
{-| The VersionControl layer is the layer on top that keeps track of all the
|
||||||
|
available versions. It is usually defined with a bottom layer and a few layers
|
||||||
|
on top.
|
||||||
|
-}
|
||||||
|
type VersionControl input output
|
||||||
|
= VersionControl
|
||||||
|
{ latestVersion : input -> output
|
||||||
|
, order : List String
|
||||||
|
, versions : Dict String (input -> output)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The middle layer is placed between a VersionControl and a BottomLayer to
|
||||||
|
support a new function for a new version. The abbreviations stand for the
|
||||||
|
following:
|
||||||
|
|
||||||
|
- `cin` means **current in**. It is the Middle Layer's input.
|
||||||
|
|
||||||
|
- `cout` means **current out**. It is the Middle Layer's output.
|
||||||
|
|
||||||
|
- `din` means **downcast in**. It is the Bottom Layer's input.
|
||||||
|
|
||||||
|
- `dout` means **downcast out**. It is the Bottom Layer's output.
|
||||||
|
|
||||||
|
As a result, we have the following model to explain the MiddleLayer:
|
||||||
|
|
||||||
|
|----------------------------------------------|
|
||||||
|
| VersionControl |
|
||||||
|
| input output |
|
||||||
|
| | ^ |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
[cin] [cout]
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| MiddleLayer | | |
|
||||||
|
| [---> current ---] |
|
||||||
|
| | | |
|
||||||
|
| downcast upcast |
|
||||||
|
| | ^ |
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
[din] [dout]
|
||||||
|
|---------------------- | -------------- | ----|
|
||||||
|
| BottomLayer | | |
|
||||||
|
| \---> current ---/ |
|
||||||
|
| |
|
||||||
|
|----------------------------------------------|
|
||||||
|
|
||||||
|
To sew a MiddleLayer type, we need the `downcast` and `upcast` functions to
|
||||||
|
translate the `cin` and `cout` to meaningful values `din` and `dout` for the
|
||||||
|
BottomLayer function.
|
||||||
|
|
||||||
|
Usually, this means transforming the data. For example, say our BottomLayer
|
||||||
|
still has an old version where people had just one name, and our MiddleLayer
|
||||||
|
version has two fields: a first and last name.
|
||||||
|
|
||||||
|
type alias NewUser =
|
||||||
|
{ firstName : String, lastName : String, age : Int }
|
||||||
|
|
||||||
|
type alias OldUser =
|
||||||
|
{ name : String, age : Int }
|
||||||
|
|
||||||
|
An appropriate downcasting function could then something like the following:
|
||||||
|
|
||||||
|
downcast : NewUser -> OldUser
|
||||||
|
downcast user =
|
||||||
|
{ name = user.firstName ++ " " ++ user.lastName, age = user.age }
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias MiddleLayer cin cout din dout =
|
||||||
|
{ current : cin -> cout
|
||||||
|
, downcast : cin -> din
|
||||||
|
, upcast : dout -> cout
|
||||||
|
, version : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a MiddleLayer to the VersionControl, effectively updating all old
|
||||||
|
functions with a downcast and upcast to deal with the inputs and outputs of all
|
||||||
|
functions at the same time.
|
||||||
|
|
||||||
|
For example, using the `NewUser` and `OldUser` types, one could create the
|
||||||
|
following example to get the user's names:
|
||||||
|
|
||||||
|
vc : VersionControl NewUser String
|
||||||
|
vc =
|
||||||
|
withBottomLayer
|
||||||
|
{ current = .name
|
||||||
|
, version = "v1"
|
||||||
|
}
|
||||||
|
|> sameForVersion "v2"
|
||||||
|
|> sameForVersion "v3"
|
||||||
|
|> sameForVersion "v4"
|
||||||
|
|> sameForVersion "v5"
|
||||||
|
|> sameForVersion "v6"
|
||||||
|
|> addMiddleLayer
|
||||||
|
{ downcast = \user -> { name = user.firstName ++ " " ++ user.lastName, age = user.age }
|
||||||
|
, current = \user -> user.firstName ++ " " ++ user.lastName
|
||||||
|
, upcast = identity
|
||||||
|
, version = "v7"
|
||||||
|
}
|
||||||
|
|
||||||
|
Effectively, even though versions `v1` through `v6` still require an `OldUser`
|
||||||
|
type as an input, all functions have now been updated to the new standard of
|
||||||
|
getting a `NewUser` as an input thanks to the `downcast` function.
|
||||||
|
|
||||||
|
-}
|
||||||
|
addMiddleLayer : MiddleLayer cin cout din dout -> VersionControl din dout -> VersionControl cin cout
|
||||||
|
addMiddleLayer { current, downcast, upcast, version } (VersionControl d) =
|
||||||
|
VersionControl
|
||||||
|
{ latestVersion = current
|
||||||
|
, order = version :: d.order
|
||||||
|
, versions =
|
||||||
|
d.versions
|
||||||
|
|> Dict.map (\_ f -> downcast >> f >> upcast)
|
||||||
|
|> Dict.insert version current
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the function that corresponds with a given version. Returns `Nothing` if
|
||||||
|
the version has never been inserted into the VersionControl type.
|
||||||
|
-}
|
||||||
|
fromVersion : String -> VersionControl a b -> Maybe (a -> b)
|
||||||
|
fromVersion version (VersionControl { versions }) =
|
||||||
|
Dict.get version versions
|
||||||
|
|
||||||
|
|
||||||
|
{-| Provided a list of versions, this function will provide a list of compatible versions to you in your preferred order.
|
||||||
|
|
||||||
|
If you just care about getting the most recent function, you will be better off using `mostRecentFromVersionList`,
|
||||||
|
but this function can help if you care about knowing which Matrix spec version you're using.
|
||||||
|
|
||||||
|
-}
|
||||||
|
fromVersionList : List String -> VersionControl a b -> List ( String, a -> b )
|
||||||
|
fromVersionList versionList vc =
|
||||||
|
List.filterMap
|
||||||
|
(\version ->
|
||||||
|
vc
|
||||||
|
|> fromVersion version
|
||||||
|
|> Maybe.map (\f -> ( version, f ))
|
||||||
|
)
|
||||||
|
versionList
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine if a version is supported by the VersionControl.
|
||||||
|
|
||||||
|
vc : VersionControl NewUser String
|
||||||
|
vc =
|
||||||
|
withBottomLayer
|
||||||
|
{ current = .name
|
||||||
|
, version = "v1"
|
||||||
|
}
|
||||||
|
|> sameForVersion "v2"
|
||||||
|
|> sameForVersion "v3"
|
||||||
|
|> sameForVersion "v4"
|
||||||
|
|
||||||
|
isSupported "v3" vc -- True
|
||||||
|
isSupported "v9" vc -- False
|
||||||
|
|
||||||
|
-}
|
||||||
|
isSupported : String -> VersionControl a b -> Bool
|
||||||
|
isSupported version (VersionControl d) =
|
||||||
|
Dict.member version d.versions
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the most recent event based on a list of versions. Returns `Nothing` if
|
||||||
|
the list is empty, or if none of the versions are supported.
|
||||||
|
|
||||||
|
vc : VersionControl a b
|
||||||
|
vc =
|
||||||
|
withBottomLayer
|
||||||
|
{ current = foo
|
||||||
|
, version = "v1"
|
||||||
|
}
|
||||||
|
|> sameForVersion "v2"
|
||||||
|
|> sameForVersion "v3"
|
||||||
|
|> sameForVersion "v4"
|
||||||
|
|> sameForVersion "v5"
|
||||||
|
|> sameForVersion "v6"
|
||||||
|
|
||||||
|
-- This returns the function for v6 because that is the most recent version
|
||||||
|
-- in the provided version list
|
||||||
|
mostRecentFromVersionList [ "v5", "v3", "v7", "v6", "v8" ] vc
|
||||||
|
|
||||||
|
-}
|
||||||
|
mostRecentFromVersionList : List String -> VersionControl a b -> Maybe (a -> b)
|
||||||
|
mostRecentFromVersionList versionList ((VersionControl { order }) as vc) =
|
||||||
|
order
|
||||||
|
|> List.filter (\o -> List.member o versionList)
|
||||||
|
|> List.filterMap (\v -> fromVersion v vc)
|
||||||
|
|> List.head
|
||||||
|
|
||||||
|
|
||||||
|
{-| Not every version overhauls every interaction. For this reason, many version
|
||||||
|
functions are identical to their previous functions.
|
||||||
|
|
||||||
|
This function adds a new version to the VersionControl and tells it that the
|
||||||
|
version uses the same function as the previous version.
|
||||||
|
|
||||||
|
vc : VersionControl User String
|
||||||
|
vc =
|
||||||
|
withBottomLayer
|
||||||
|
{ current = .name
|
||||||
|
, version = "v1"
|
||||||
|
}
|
||||||
|
|> sameForVersion "v2"
|
||||||
|
|> sameForVersion "v3"
|
||||||
|
|> sameForVersion "v4"
|
||||||
|
|> sameForVersion "v5"
|
||||||
|
|> sameForVersion "v6"
|
||||||
|
|
||||||
|
The example above lists the function `.name` for versions `v1` through `v6`.
|
||||||
|
|
||||||
|
-}
|
||||||
|
sameForVersion : String -> VersionControl a b -> VersionControl a b
|
||||||
|
sameForVersion version (VersionControl data) =
|
||||||
|
VersionControl
|
||||||
|
{ data
|
||||||
|
| order = version :: data.order
|
||||||
|
, versions = Dict.insert version data.latestVersion data.versions
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get a dict of all available functions.
|
||||||
|
|
||||||
|
|
||||||
|
vc : VersionControl NewUser String
|
||||||
|
vc =
|
||||||
|
withBottomLayer
|
||||||
|
{ current = .name
|
||||||
|
, version = "v1"
|
||||||
|
}
|
||||||
|
|> sameForVersion "v2"
|
||||||
|
|> sameForVersion "v3"
|
||||||
|
|> sameForVersion "v4"
|
||||||
|
|> toDict
|
||||||
|
|
||||||
|
-- Dict.fromList
|
||||||
|
-- [ ( "v1", <internal> )
|
||||||
|
-- , ( "v2", <internal> )
|
||||||
|
-- , ( "v3", <internal> )
|
||||||
|
-- , ( "v4", <internal> )
|
||||||
|
-- ]
|
||||||
|
|
||||||
|
-}
|
||||||
|
toDict : VersionControl a b -> Dict String (a -> b)
|
||||||
|
toDict (VersionControl d) =
|
||||||
|
d.versions
|
||||||
|
|
||||||
|
|
||||||
|
{-| You cannot create an empty VersionControl layer, you must always start with a BottomLayer
|
||||||
|
and then stack MiddleLayer types on top until you've reached the version that you're happy with.
|
||||||
|
|
||||||
|
vc : VersionControl User String
|
||||||
|
vc =
|
||||||
|
withBottomLayer
|
||||||
|
{ current = .name
|
||||||
|
, version = "v1"
|
||||||
|
}
|
||||||
|
|
||||||
|
type alias User =
|
||||||
|
{ name : String, age : Int }
|
||||||
|
|
||||||
|
-}
|
||||||
|
withBottomLayer : { current : input -> output, version : String } -> VersionControl input output
|
||||||
|
withBottomLayer { current, version } =
|
||||||
|
VersionControl
|
||||||
|
{ latestVersion = current
|
||||||
|
, order = List.singleton version
|
||||||
|
, versions = Dict.singleton version current
|
||||||
|
}
|
|
@ -0,0 +1,461 @@
|
||||||
|
module Internal.Values.Context exposing
|
||||||
|
( Context, AccessToken, init, coder, encode, decoder
|
||||||
|
, mostPopularToken
|
||||||
|
, APIContext, apiFormat, fromApiFormat
|
||||||
|
, setAccessToken, getAccessToken
|
||||||
|
, setBaseUrl, getBaseUrl
|
||||||
|
, setNow, getNow
|
||||||
|
, setTransaction, getTransaction
|
||||||
|
, Versions, setVersions, getVersions
|
||||||
|
, reset
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The Context is the set of variables that the user (mostly) cannot control.
|
||||||
|
The Context contains tokens, values and other bits that the Vault receives from
|
||||||
|
the Matrix API.
|
||||||
|
|
||||||
|
|
||||||
|
## Context
|
||||||
|
|
||||||
|
@docs Context, AccessToken, init, coder, encode, decoder
|
||||||
|
|
||||||
|
Some functions are present to influence the general Context type itself.
|
||||||
|
|
||||||
|
@docs mostPopularToken
|
||||||
|
|
||||||
|
|
||||||
|
## APIContext
|
||||||
|
|
||||||
|
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, fromApiFormat
|
||||||
|
|
||||||
|
Once the APIContext is ready, there's helper functions for each piece of
|
||||||
|
information that can be inserted.
|
||||||
|
|
||||||
|
|
||||||
|
### Access token
|
||||||
|
|
||||||
|
@docs setAccessToken, getAccessToken
|
||||||
|
|
||||||
|
|
||||||
|
### Base URL
|
||||||
|
|
||||||
|
@docs setBaseUrl, getBaseUrl
|
||||||
|
|
||||||
|
|
||||||
|
### Timestamp
|
||||||
|
|
||||||
|
@docs setNow, getNow
|
||||||
|
|
||||||
|
|
||||||
|
### Transaction id
|
||||||
|
|
||||||
|
@docs setTransaction, getTransaction
|
||||||
|
|
||||||
|
|
||||||
|
### Versions
|
||||||
|
|
||||||
|
@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 =
|
||||||
|
{ accessTokens : Hashdict AccessToken
|
||||||
|
, baseUrl : Maybe String
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, nextBatch : Maybe String
|
||||||
|
, now : Maybe Timestamp
|
||||||
|
, password : Maybe String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, serverName : String
|
||||||
|
, suggestedAccessToken : Maybe String
|
||||||
|
, transaction : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
, username : Maybe String
|
||||||
|
, versions : Maybe Versions
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The APIContext is a separate type that uses a phantom type to trick the
|
||||||
|
compiler into requiring values to be present. This data type is used to gather
|
||||||
|
the right variables (like an access token) before accessing the Matrix API.
|
||||||
|
-}
|
||||||
|
type APIContext ph
|
||||||
|
= APIContext
|
||||||
|
{ accessToken : String
|
||||||
|
, baseUrl : String
|
||||||
|
, context : Context
|
||||||
|
, now : Timestamp
|
||||||
|
, transaction : String
|
||||||
|
, versions : Versions
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Versions =
|
||||||
|
{ versions : List String, unstableFeatures : Set String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an unformatted APIContext type.
|
||||||
|
-}
|
||||||
|
apiFormat : Context -> APIContext {}
|
||||||
|
apiFormat context =
|
||||||
|
APIContext
|
||||||
|
{ 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.object13
|
||||||
|
{ name = Text.docs.context.name
|
||||||
|
, description = Text.docs.context.description
|
||||||
|
, init = Context
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "accessTokens"
|
||||||
|
, toField = .accessTokens
|
||||||
|
, description = Text.fields.context.accessToken
|
||||||
|
, coder = Hashdict.coder .value coderAccessToken
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "baseUrl"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description = Text.fields.context.baseUrl
|
||||||
|
, 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
|
||||||
|
, description = Text.fields.context.password
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refreshToken"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description = Text.fields.context.refreshToken
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "serverName"
|
||||||
|
, toField = .serverName
|
||||||
|
, description = Text.fields.context.serverName
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "suggestedAccessToken"
|
||||||
|
, toField = always Nothing -- Do not save
|
||||||
|
, description = Text.fields.context.suggestedAccessToken
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "transaction"
|
||||||
|
, toField = .transaction
|
||||||
|
, description = Text.fields.context.transaction
|
||||||
|
, 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 = 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
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a Context type from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder Context
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a Context type into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Context
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| A basic, untouched version of the Context, containing no information.
|
||||||
|
-}
|
||||||
|
init : String -> Maybe User -> Context
|
||||||
|
init sn mu =
|
||||||
|
{ accessTokens = Hashdict.empty .value
|
||||||
|
, baseUrl = Nothing
|
||||||
|
, deviceId = Nothing
|
||||||
|
, nextBatch = Nothing
|
||||||
|
, now = Nothing
|
||||||
|
, refreshToken = Nothing
|
||||||
|
, password = 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
|
||||||
|
getAccessToken (APIContext c) =
|
||||||
|
c.accessToken
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert an access token into the APIContext.
|
||||||
|
-}
|
||||||
|
setAccessToken : String -> APIContext a -> APIContext { a | accessToken : () }
|
||||||
|
setAccessToken value (APIContext c) =
|
||||||
|
APIContext { c | accessToken = value }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an inserted base URL.
|
||||||
|
-}
|
||||||
|
getBaseUrl : APIContext { a | baseUrl : () } -> String
|
||||||
|
getBaseUrl (APIContext c) =
|
||||||
|
c.baseUrl
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a base URL into the APIContext.
|
||||||
|
-}
|
||||||
|
setBaseUrl : String -> APIContext a -> APIContext { a | baseUrl : () }
|
||||||
|
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
|
||||||
|
getTransaction (APIContext c) =
|
||||||
|
c.transaction
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a transaction id into the APIContext.
|
||||||
|
-}
|
||||||
|
setTransaction : String -> APIContext a -> APIContext { a | transaction : () }
|
||||||
|
setTransaction value (APIContext c) =
|
||||||
|
APIContext { c | transaction = value }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an inserted versions list.
|
||||||
|
-}
|
||||||
|
getVersions : APIContext { a | versions : () } -> Versions
|
||||||
|
getVersions (APIContext c) =
|
||||||
|
c.versions
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a versions list into the APIContext.
|
||||||
|
-}
|
||||||
|
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, [] )
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,392 @@
|
||||||
|
module Internal.Values.Envelope exposing
|
||||||
|
( Envelope, init
|
||||||
|
, map, mapMaybe, mapList
|
||||||
|
, Settings, mapSettings, extractSettings
|
||||||
|
, mapContext
|
||||||
|
, getContent, extract
|
||||||
|
, EnvelopeUpdate(..), update
|
||||||
|
, coder, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The Envelope module wraps existing data types with lots of values and
|
||||||
|
settings that can be adjusted manually.
|
||||||
|
|
||||||
|
|
||||||
|
## Create
|
||||||
|
|
||||||
|
@docs Envelope, init
|
||||||
|
|
||||||
|
|
||||||
|
## Manipulate
|
||||||
|
|
||||||
|
@docs map, mapMaybe, mapList
|
||||||
|
|
||||||
|
|
||||||
|
## Settings
|
||||||
|
|
||||||
|
@docs Settings, mapSettings, extractSettings
|
||||||
|
|
||||||
|
|
||||||
|
## Context
|
||||||
|
|
||||||
|
@docs mapContext
|
||||||
|
|
||||||
|
|
||||||
|
## Extract
|
||||||
|
|
||||||
|
@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.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
|
||||||
|
need the same values. The Envelope type wraps settings, tokens and values around
|
||||||
|
each data type so they can all enjoy those values without needing to explicitly
|
||||||
|
define them in their type.
|
||||||
|
-}
|
||||||
|
type alias Envelope a =
|
||||||
|
{ content : a
|
||||||
|
, context : Context
|
||||||
|
, settings : Settings
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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.
|
||||||
|
-}
|
||||||
|
type alias Settings =
|
||||||
|
Settings.Settings
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how an Envelope can be encoded to and decoded from a JSON object.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder a -> Json.Coder (Envelope a)
|
||||||
|
coder c1 =
|
||||||
|
Json.object3
|
||||||
|
{ name = Text.docs.envelope.name
|
||||||
|
, description = Text.docs.envelope.description
|
||||||
|
, init = Envelope
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "content"
|
||||||
|
, toField = .content
|
||||||
|
, description = Text.fields.envelope.content
|
||||||
|
, coder = c1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "context"
|
||||||
|
, toField = .context
|
||||||
|
, description = Text.fields.envelope.context
|
||||||
|
, coder = Context.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "settings"
|
||||||
|
, toField = .settings
|
||||||
|
, description = Text.fields.envelope.settings
|
||||||
|
, coder = Settings.coder
|
||||||
|
, default = Tuple.pair Settings.init []
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode an enveloped type from a JSON value. The decoder also imports any
|
||||||
|
potential tokens, values and settings included in the JSON.
|
||||||
|
-}
|
||||||
|
decoder : Json.Coder a -> Json.Decoder (Envelope a)
|
||||||
|
decoder c1 =
|
||||||
|
Json.decode (coder c1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode an enveloped type into a JSON value. The function encodes all
|
||||||
|
non-standard settings, tokens and values.
|
||||||
|
-}
|
||||||
|
encode : Json.Coder a -> Json.Encoder (Envelope a)
|
||||||
|
encode c1 =
|
||||||
|
Json.encode (coder c1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map a function, then get its content. This is useful for getting information
|
||||||
|
from a data type inside an Envelope.
|
||||||
|
|
||||||
|
type alias User =
|
||||||
|
{ name : String, age : Int }
|
||||||
|
|
||||||
|
getName : Envelope User -> String
|
||||||
|
getName =
|
||||||
|
Envelope.extract .name
|
||||||
|
|
||||||
|
-}
|
||||||
|
extract : (a -> b) -> Envelope a -> b
|
||||||
|
extract f data =
|
||||||
|
f data.content
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map a function on the settings, effectively getting data that way.
|
||||||
|
|
||||||
|
This can be helpful if you have a UI that displays custom settings to a user.
|
||||||
|
|
||||||
|
-}
|
||||||
|
extractSettings : (Settings -> b) -> Envelope a -> b
|
||||||
|
extractSettings f data =
|
||||||
|
f data.settings
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the original item that is stored inside an Envelope.
|
||||||
|
|
||||||
|
Make sure that you're only using this if you're interested in the actual value!
|
||||||
|
If you'd like to get the content, run a function on it, and put it back in an
|
||||||
|
Envelope, consider using [map](#map) instead.
|
||||||
|
|
||||||
|
-}
|
||||||
|
getContent : Envelope a -> a
|
||||||
|
getContent =
|
||||||
|
extract identity
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a new enveloped data type. All settings are set to default values
|
||||||
|
from the [Internal.Config.Default](Internal-Config-Default) module.
|
||||||
|
-}
|
||||||
|
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
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map a function on the content of the Envelope.
|
||||||
|
|
||||||
|
type alias User =
|
||||||
|
{ name : String, age : Int }
|
||||||
|
|
||||||
|
getName : Envelope User -> Envelope String
|
||||||
|
getName =
|
||||||
|
Envelope.map .name
|
||||||
|
|
||||||
|
-}
|
||||||
|
map : (a -> b) -> Envelope a -> Envelope b
|
||||||
|
map f data =
|
||||||
|
{ content = f data.content
|
||||||
|
, context = data.context
|
||||||
|
, settings = data.settings
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Update the Context in the Envelope.
|
||||||
|
-}
|
||||||
|
mapContext : (Context -> Context) -> Envelope a -> Envelope a
|
||||||
|
mapContext f data =
|
||||||
|
{ data | context = f data.context }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map the contents of a function, where the result is wrapped in a `List`
|
||||||
|
type. This can be useful when you are mapping to a list of individual values
|
||||||
|
that you would all like to see enveloped.
|
||||||
|
|
||||||
|
type alias User =
|
||||||
|
{ name : String, age : Int }
|
||||||
|
|
||||||
|
type alias Company =
|
||||||
|
{ name : String, employees : List User }
|
||||||
|
|
||||||
|
getEmployees : Envelope Company -> List (Envelope User)
|
||||||
|
getEmployees envelope =
|
||||||
|
mapList .employees envelope
|
||||||
|
|
||||||
|
-}
|
||||||
|
mapList : (a -> List b) -> Envelope a -> List (Envelope b)
|
||||||
|
mapList f =
|
||||||
|
map f >> toList
|
||||||
|
|
||||||
|
|
||||||
|
{-| Map the contents of a function, where the result is wrapped in a `Maybe`
|
||||||
|
type. This can be useful when you are not guaranteed to find the value you're
|
||||||
|
looking for.
|
||||||
|
|
||||||
|
type alias User =
|
||||||
|
{ name : String, age : Int }
|
||||||
|
|
||||||
|
type alias UserDatabase =
|
||||||
|
List User
|
||||||
|
|
||||||
|
getFirstUser : Envelope UserDatabase -> Maybe (Envelope User)
|
||||||
|
getFirstUser envelope =
|
||||||
|
mapMaybe List.head envelope
|
||||||
|
|
||||||
|
-}
|
||||||
|
mapMaybe : (a -> Maybe b) -> Envelope a -> Maybe (Envelope b)
|
||||||
|
mapMaybe f =
|
||||||
|
map f >> toMaybe
|
||||||
|
|
||||||
|
|
||||||
|
{-| Update the settings in the Envelope.
|
||||||
|
|
||||||
|
setDeviceName : String -> Envelope a -> Envelope a
|
||||||
|
setDeviceName name envelope =
|
||||||
|
mapSettings
|
||||||
|
(\settings ->
|
||||||
|
{ settings | deviceName = name }
|
||||||
|
)
|
||||||
|
envelope
|
||||||
|
|
||||||
|
-}
|
||||||
|
mapSettings : (Settings -> Settings) -> Envelope a -> Envelope a
|
||||||
|
mapSettings f data =
|
||||||
|
{ data | settings = f data.settings }
|
||||||
|
|
||||||
|
|
||||||
|
toList : Envelope (List a) -> List (Envelope a)
|
||||||
|
toList data =
|
||||||
|
List.map
|
||||||
|
(\content -> map (always content) data)
|
||||||
|
data.content
|
||||||
|
|
||||||
|
|
||||||
|
toMaybe : Envelope (Maybe a) -> Maybe (Envelope a)
|
||||||
|
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
|
|
@ -0,0 +1,285 @@
|
||||||
|
module Internal.Values.Event exposing
|
||||||
|
( Event
|
||||||
|
, UnsignedData(..), age, prevContent, redactedBecause, transactionId
|
||||||
|
, coder, encode, decoder
|
||||||
|
, isEqual
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Event
|
||||||
|
|
||||||
|
The `Event` module hosts all the information for a single event in the timeline
|
||||||
|
of a room.
|
||||||
|
|
||||||
|
@docs Event
|
||||||
|
|
||||||
|
|
||||||
|
## Unsigned data
|
||||||
|
|
||||||
|
@docs UnsignedData, age, prevContent, redactedBecause, transactionId
|
||||||
|
|
||||||
|
|
||||||
|
## JSON Coder
|
||||||
|
|
||||||
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
|
|
||||||
|
## Test functions
|
||||||
|
|
||||||
|
@docs isEqual
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Json.Encode as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Event type occurs everywhere on a user's timeline.
|
||||||
|
-}
|
||||||
|
type alias Event =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventId : String
|
||||||
|
, originServerTs : Timestamp
|
||||||
|
, roomId : String
|
||||||
|
, sender : User
|
||||||
|
, stateKey : Maybe String
|
||||||
|
, eventType : String
|
||||||
|
, unsigned : Maybe UnsignedData
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Unsigned Data contains a lot of extra information. You can access it through
|
||||||
|
helper functions.
|
||||||
|
-}
|
||||||
|
type UnsignedData
|
||||||
|
= UnsignedData
|
||||||
|
{ age : Maybe Int
|
||||||
|
, membership : Maybe String
|
||||||
|
, prevContent : Maybe Json.Value
|
||||||
|
, redactedBecause : Maybe Event
|
||||||
|
, transactionId : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the event's age, if at all provided by the homeserver.
|
||||||
|
-}
|
||||||
|
age : Event -> Maybe Int
|
||||||
|
age event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.age) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how an Event can be encoded to and decoded from a JSON object.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder Event
|
||||||
|
coder =
|
||||||
|
Json.object8
|
||||||
|
{ name = Text.docs.event.name
|
||||||
|
, description = Text.docs.event.description
|
||||||
|
, init = Event
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "content"
|
||||||
|
, toField = .content
|
||||||
|
, description = Text.fields.event.content
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "eventId"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = Text.fields.event.eventId
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "originServerTs"
|
||||||
|
, toField = .originServerTs
|
||||||
|
, description = Text.fields.event.originServerTs
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "roomId"
|
||||||
|
, toField = .roomId
|
||||||
|
, description = Text.fields.event.roomId
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "sender"
|
||||||
|
, toField = .sender
|
||||||
|
, description = Text.fields.event.sender
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "stateKey"
|
||||||
|
, toField = .stateKey
|
||||||
|
, description = Text.fields.event.stateKey
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
-- NOTE! | In JSON we call it `type`, not `eventType`,
|
||||||
|
-- NOTE! | so that the data is easier to read for other non-Elm
|
||||||
|
-- NOTE! | JSON parsers
|
||||||
|
{ fieldName = "type"
|
||||||
|
, toField = .eventType
|
||||||
|
, description = Text.fields.event.eventType
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unsigned"
|
||||||
|
, toField = .unsigned
|
||||||
|
, description = Text.fields.event.unsigned
|
||||||
|
, coder = unsignedCoder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode an Event from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder Event
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode an Event into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Event
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Compare two events and determine whether they're identical. Used mostly for
|
||||||
|
testing purposes.
|
||||||
|
-}
|
||||||
|
isEqual : Event -> Event -> Bool
|
||||||
|
isEqual e1 e2 =
|
||||||
|
if e1.eventId /= e2.eventId then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if e1.originServerTs /= e2.originServerTs then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if e1.roomId /= e2.roomId then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if e1.sender /= e2.sender then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if e1.stateKey /= e2.stateKey then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if e1.eventType /= e2.eventType then
|
||||||
|
False
|
||||||
|
|
||||||
|
else
|
||||||
|
case ( e1.unsigned, e2.unsigned ) of
|
||||||
|
( Nothing, Nothing ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
( Just _, Nothing ) ->
|
||||||
|
False
|
||||||
|
|
||||||
|
( Nothing, Just _ ) ->
|
||||||
|
False
|
||||||
|
|
||||||
|
( Just (UnsignedData d1), Just (UnsignedData d2) ) ->
|
||||||
|
if d1.age /= d2.age then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if d1.transactionId /= d2.transactionId then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if Maybe.map (E.encode 0) d1.prevContent /= Maybe.map (E.encode 0) d2.prevContent then
|
||||||
|
False
|
||||||
|
|
||||||
|
else
|
||||||
|
case ( d1.redactedBecause, d2.redactedBecause ) of
|
||||||
|
( Nothing, Nothing ) ->
|
||||||
|
True
|
||||||
|
|
||||||
|
( Nothing, Just _ ) ->
|
||||||
|
False
|
||||||
|
|
||||||
|
( Just _, Nothing ) ->
|
||||||
|
False
|
||||||
|
|
||||||
|
( Just se1, Just se2 ) ->
|
||||||
|
isEqual se1 se2
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the previous `content` value for this event. This field is only a
|
||||||
|
`Just value` if the event is a state event, and the Matrix Vault has permission
|
||||||
|
to see the previous content.
|
||||||
|
-}
|
||||||
|
prevContent : Event -> Maybe Json.Value
|
||||||
|
prevContent event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.prevContent) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
{-| If the event has been redacted, the homeserver can display the event that
|
||||||
|
redacted it here.
|
||||||
|
-}
|
||||||
|
redactedBecause : Event -> Maybe Event
|
||||||
|
redactedBecause event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.redactedBecause) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
{-| If the user has sent this event to the homeserver, then the homeserver might
|
||||||
|
display the original transaction id used for the event.
|
||||||
|
-}
|
||||||
|
transactionId : Event -> Maybe String
|
||||||
|
transactionId event =
|
||||||
|
Maybe.andThen (\(UnsignedData data) -> data.transactionId) event.unsigned
|
||||||
|
|
||||||
|
|
||||||
|
unsignedCoder : Json.Coder UnsignedData
|
||||||
|
unsignedCoder =
|
||||||
|
Json.object5
|
||||||
|
{ name = Text.docs.unsigned.name
|
||||||
|
, description = Text.docs.unsigned.description
|
||||||
|
, init = \a b c d e -> UnsignedData { age = a, membership = b, prevContent = c, redactedBecause = d, transactionId = e }
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "age"
|
||||||
|
, toField = \(UnsignedData data) -> data.age
|
||||||
|
, description = Text.fields.unsigned.age
|
||||||
|
, 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
|
||||||
|
, description = Text.fields.unsigned.prevContent
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "redactedBecause"
|
||||||
|
, toField = \(UnsignedData data) -> data.redactedBecause
|
||||||
|
, description = Text.fields.unsigned.redactedBecause
|
||||||
|
, coder = Json.lazy (\_ -> coder)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "transactionId"
|
||||||
|
, toField = \(UnsignedData data) -> data.transactionId
|
||||||
|
, description = Text.fields.unsigned.transactionId
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,290 @@
|
||||||
|
module Internal.Values.Room exposing
|
||||||
|
( Room, init
|
||||||
|
, RoomUpdate(..), update
|
||||||
|
, Batch, addBatch, addSync, addEvents, mostRecentEvents
|
||||||
|
, getAccountData, setAccountData
|
||||||
|
, coder, encode, decode
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Room
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
This module is the internal module of a room. Its functions serve the update
|
||||||
|
the local room state. Its changes do **NOT** reflect the actual room state on
|
||||||
|
the homeserver: as a matter of fact, these functions are meant to help the local
|
||||||
|
room state reflect the homeserver state of the room.
|
||||||
|
|
||||||
|
|
||||||
|
## Room
|
||||||
|
|
||||||
|
@docs Room, init
|
||||||
|
|
||||||
|
|
||||||
|
## Update
|
||||||
|
|
||||||
|
@docs RoomUpdate, update
|
||||||
|
|
||||||
|
|
||||||
|
## Timeline
|
||||||
|
|
||||||
|
@docs Batch, addBatch, addSync, addEvents, mostRecentEvents
|
||||||
|
|
||||||
|
|
||||||
|
## Account data
|
||||||
|
|
||||||
|
@docs getAccountData, setAccountData
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coding
|
||||||
|
|
||||||
|
@docs coder, encode, decode
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
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 Internal.Values.User exposing (User)
|
||||||
|
import Recursion
|
||||||
|
import Recursion.Fold
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Batch is a group of new events from somewhere in the timeline.
|
||||||
|
-}
|
||||||
|
type alias Batch =
|
||||||
|
{ events : List Event, filter : Filter, start : Maybe String, end : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Matrix Room is a representation of a Matrix Room as portrayed by the
|
||||||
|
homeserver.
|
||||||
|
-}
|
||||||
|
type alias Room =
|
||||||
|
{ accountData : Dict String Json.Value
|
||||||
|
, ephemeral : List StrippedEvent
|
||||||
|
, events : Hashdict Event
|
||||||
|
, roomId : String
|
||||||
|
, state : StateManager
|
||||||
|
, timeline : Timeline
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| 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
|
||||||
|
addEventsToTimeline f { events, filter, start, end } room =
|
||||||
|
let
|
||||||
|
batch : Timeline.Batch
|
||||||
|
batch =
|
||||||
|
{ events = List.map .eventId events
|
||||||
|
, filter = filter
|
||||||
|
, start = start
|
||||||
|
, end = end
|
||||||
|
}
|
||||||
|
in
|
||||||
|
{ room
|
||||||
|
| events = List.foldl Hashdict.insert room.events events
|
||||||
|
, timeline = f batch room.timeline
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a batch of events to the Room.
|
||||||
|
-}
|
||||||
|
addBatch : Batch -> Room -> Room
|
||||||
|
addBatch =
|
||||||
|
addEventsToTimeline Timeline.insert
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add events to the room, with no particular information about their location
|
||||||
|
on the timeline. This is especially helpful for events that offer information
|
||||||
|
like the room's state, given that it is essential to know them but they have
|
||||||
|
often been sent a long time ago.
|
||||||
|
-}
|
||||||
|
addEvents : List Event -> Room -> Room
|
||||||
|
addEvents events room =
|
||||||
|
{ room
|
||||||
|
| events = List.foldl Hashdict.insert room.events events
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new sync to the Room. The difference with the
|
||||||
|
[addBatch](Internal-Values-Room#addBatch) function is that this function
|
||||||
|
explicitly tells the Timeline that it is at the front of the timeline.
|
||||||
|
-}
|
||||||
|
addSync : Batch -> Room -> Room
|
||||||
|
addSync =
|
||||||
|
addEventsToTimeline Timeline.addSync
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how a Room can be encoded and decoded to and from a JavaScript value.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder Room
|
||||||
|
coder =
|
||||||
|
Json.object6
|
||||||
|
{ name = Text.docs.room.name
|
||||||
|
, description = Text.docs.room.description
|
||||||
|
, init = Room
|
||||||
|
}
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "accountData"
|
||||||
|
, toField = .accountData
|
||||||
|
, description = Text.fields.room.accountData
|
||||||
|
, coder = Json.fastDict Json.value
|
||||||
|
, default = ( Dict.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "ephemeral"
|
||||||
|
, toField = .ephemeral
|
||||||
|
, description = Text.fields.room.ephemeral
|
||||||
|
, coder = Json.list StrippedEvent.coder
|
||||||
|
, default = ( [], [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "events"
|
||||||
|
, toField = .events
|
||||||
|
, 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?" ] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "roomId"
|
||||||
|
, toField = .roomId
|
||||||
|
, description = Text.fields.room.roomId
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "state"
|
||||||
|
, toField = .state
|
||||||
|
, description = Text.fields.room.state
|
||||||
|
, coder = StateManager.coder
|
||||||
|
, default = ( StateManager.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "timeline"
|
||||||
|
, toField = .timeline
|
||||||
|
, description = Text.fields.room.timeline
|
||||||
|
, coder = Timeline.coder
|
||||||
|
, default = ( Timeline.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a Room from JSON format.
|
||||||
|
-}
|
||||||
|
decode : Json.Decoder Room
|
||||||
|
decode =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a Room into JSON format.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Room
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get a piece of account data as information from the room.
|
||||||
|
-}
|
||||||
|
getAccountData : String -> Room -> Maybe Json.Value
|
||||||
|
getAccountData key room =
|
||||||
|
Dict.get key room.accountData
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an empty room for which nothing is known.
|
||||||
|
-}
|
||||||
|
init : String -> Room
|
||||||
|
init roomId =
|
||||||
|
{ accountData = Dict.empty
|
||||||
|
, ephemeral = []
|
||||||
|
, events = Hashdict.empty .eventId
|
||||||
|
, roomId = roomId
|
||||||
|
, state = StateManager.empty
|
||||||
|
, timeline = Timeline.empty
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the most recent events from the timeline.
|
||||||
|
-}
|
||||||
|
mostRecentEvents : Room -> List Event
|
||||||
|
mostRecentEvents room =
|
||||||
|
room.timeline
|
||||||
|
|> Timeline.mostRecentEvents Filter.pass
|
||||||
|
|> List.map (List.filterMap (\e -> Hashdict.get e room.events))
|
||||||
|
|> List.sortBy List.length
|
||||||
|
-- Get the largest list of events
|
||||||
|
|> List.head
|
||||||
|
|> Maybe.withDefault []
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set a piece of account data as information about the 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
|
|
@ -0,0 +1,117 @@
|
||||||
|
module Internal.Values.Settings exposing
|
||||||
|
( Settings, init
|
||||||
|
, coder, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Settings
|
||||||
|
|
||||||
|
The Settings module exposes a data type to configure settings in the enveloped
|
||||||
|
data types.
|
||||||
|
|
||||||
|
@docs Settings, init
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Default as Default
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
|
||||||
|
|
||||||
|
{-| Custom settings that can be manipulated by the user. These serve as a
|
||||||
|
configuration for how the Elm SDK should behave.
|
||||||
|
|
||||||
|
Custom settings are always part of the Envelope, allowing all functions to
|
||||||
|
behave under the user's preferred settings.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Settings =
|
||||||
|
{ currentVersion : String
|
||||||
|
, deviceName : String
|
||||||
|
, presence : Maybe String
|
||||||
|
, removePasswordOnLogin : Bool
|
||||||
|
, syncTime : Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how a Settings type can be encoded to and decoded from a JSON object.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder Settings
|
||||||
|
coder =
|
||||||
|
Json.object5
|
||||||
|
{ name = Text.docs.settings.name
|
||||||
|
, description = Text.docs.settings.description
|
||||||
|
, init = Settings
|
||||||
|
}
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "currentVersion"
|
||||||
|
, toField = .currentVersion
|
||||||
|
, description = Text.fields.settings.currentVersion
|
||||||
|
, coder = Json.string
|
||||||
|
, default = Tuple.pair Default.currentVersion []
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "deviceName"
|
||||||
|
, toField = .deviceName
|
||||||
|
, description = Text.fields.settings.deviceName
|
||||||
|
, coder = Json.string
|
||||||
|
, default = Tuple.pair Default.deviceName []
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(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
|
||||||
|
{ fieldName = "syncTime"
|
||||||
|
, toField = .syncTime
|
||||||
|
, description = Text.fields.settings.syncTime
|
||||||
|
, coder = Json.int
|
||||||
|
, default = Tuple.pair Default.syncTime []
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode settings from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder Settings
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode the settings into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Settings
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a new Settings module based on default values
|
||||||
|
-}
|
||||||
|
init : Settings
|
||||||
|
init =
|
||||||
|
{ currentVersion = Default.currentVersion
|
||||||
|
, deviceName = Default.deviceName
|
||||||
|
, presence = Nothing
|
||||||
|
, removePasswordOnLogin = Default.removePasswordOnLogin
|
||||||
|
, syncTime = Default.syncTime
|
||||||
|
}
|
|
@ -0,0 +1,308 @@
|
||||||
|
module Internal.Values.StateManager exposing
|
||||||
|
( StateManager
|
||||||
|
, empty, singleton, insert, insertIfNotExists, remove, append
|
||||||
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
, keys, values, fromList, toList
|
||||||
|
, coder, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The StateManager tracks the room state based on events, their event types
|
||||||
|
and the optional state keys they provide. 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.
|
||||||
|
|
||||||
|
|
||||||
|
## Dictionaries
|
||||||
|
|
||||||
|
@docs StateManager
|
||||||
|
|
||||||
|
|
||||||
|
## Build
|
||||||
|
|
||||||
|
@docs empty, singleton, insert, insertIfNotExists, remove, append
|
||||||
|
|
||||||
|
|
||||||
|
## Query
|
||||||
|
|
||||||
|
@docs isEmpty, member, memberKey, get, size, isEqual
|
||||||
|
|
||||||
|
|
||||||
|
## Lists
|
||||||
|
|
||||||
|
@docs keys, values, fromList, toList
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coders
|
||||||
|
|
||||||
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Mashdict as Mashdict exposing (Mashdict)
|
||||||
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
|
|
||||||
|
|
||||||
|
{-| The StateManager manages the room state by gathering events and looking at
|
||||||
|
their details.
|
||||||
|
-}
|
||||||
|
type StateManager
|
||||||
|
= StateManager (Dict String (Mashdict Event))
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new statemanager on top of an existing StateManager. This can be
|
||||||
|
useful when trying to calculate a room state based on two already existing
|
||||||
|
types.
|
||||||
|
-}
|
||||||
|
append : StateManager -> StateManager -> StateManager
|
||||||
|
append sm2 sm1 =
|
||||||
|
List.foldl insert sm1 (values sm2)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- {-| Remove any floating empty Mashdicts from ALL keys in the dictionary.
|
||||||
|
-- -}
|
||||||
|
-- cleanAll : StateManager -> StateManager
|
||||||
|
-- cleanAll ((StateManager manager) as sm) =
|
||||||
|
-- List.foldl cleanKey sm (Dict.keys manager)
|
||||||
|
|
||||||
|
|
||||||
|
{-| To keep the StateManager as simple as possible, you can keep the dictionary
|
||||||
|
clean by removing any floating empty Mashdicts in the dictionary.
|
||||||
|
|
||||||
|
To save time, this function exclusively removes an empty Mashdict at a given
|
||||||
|
key. This way, you don't need to run a complete clean of a large dictionary
|
||||||
|
every time you just edit a single key in the dictionary.
|
||||||
|
|
||||||
|
-}
|
||||||
|
cleanKey : String -> StateManager -> StateManager
|
||||||
|
cleanKey key (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.update key
|
||||||
|
(Maybe.andThen
|
||||||
|
(\dict ->
|
||||||
|
if Mashdict.isEmpty dict then
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
else
|
||||||
|
Just dict
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> StateManager
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how a StateManager can be encoded to and decoded from a JSON object.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder StateManager
|
||||||
|
coder =
|
||||||
|
Event.coder
|
||||||
|
|> Mashdict.coder .stateKey
|
||||||
|
|> Json.fastDict
|
||||||
|
|> Json.map
|
||||||
|
{ name = Text.docs.stateManager.name
|
||||||
|
, description = Text.docs.stateManager.description
|
||||||
|
, forth = StateManager
|
||||||
|
, back = \(StateManager manager) -> manager
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode a StateManager from a JSON value.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder StateManager
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create an empty StateManager.
|
||||||
|
-}
|
||||||
|
empty : StateManager
|
||||||
|
empty =
|
||||||
|
StateManager Dict.empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Encode a StateManager into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder StateManager
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Build a StateManager using a list of events.
|
||||||
|
-}
|
||||||
|
fromList : List Event -> StateManager
|
||||||
|
fromList events =
|
||||||
|
List.foldl insert empty events
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an event based on its event type and state key. If there is no such
|
||||||
|
event sent in the room, the function returns `Nothing`.
|
||||||
|
-}
|
||||||
|
get : { eventType : String, stateKey : String } -> StateManager -> Maybe Event
|
||||||
|
get { eventType, stateKey } (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.get eventType
|
||||||
|
|> Maybe.andThen (Mashdict.get stateKey)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a new event into the state manager. If the event does not have a
|
||||||
|
state key, it is overlooked.
|
||||||
|
-}
|
||||||
|
insert : Event -> StateManager -> StateManager
|
||||||
|
insert event (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.update
|
||||||
|
event.eventType
|
||||||
|
(\typeDict ->
|
||||||
|
case typeDict of
|
||||||
|
Nothing ->
|
||||||
|
Just <| Mashdict.singleton .stateKey event
|
||||||
|
|
||||||
|
Just md ->
|
||||||
|
Just <| Mashdict.insert event md
|
||||||
|
)
|
||||||
|
|> StateManager
|
||||||
|
|> cleanKey event.eventType
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a new event into the state manager ONLY if no such event has already
|
||||||
|
been defined.
|
||||||
|
|
||||||
|
This function is most useful for including older state events that may have been
|
||||||
|
overwritten in the future.
|
||||||
|
|
||||||
|
-}
|
||||||
|
insertIfNotExists : Event -> StateManager -> StateManager
|
||||||
|
insertIfNotExists event sm =
|
||||||
|
case event.stateKey of
|
||||||
|
Nothing ->
|
||||||
|
sm
|
||||||
|
|
||||||
|
Just s ->
|
||||||
|
case get { eventType = event.eventType, stateKey = s } sm of
|
||||||
|
Just _ ->
|
||||||
|
sm
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
insert event sm
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether the StateManager contains any events.
|
||||||
|
-}
|
||||||
|
isEmpty : StateManager -> Bool
|
||||||
|
isEmpty (StateManager manager) =
|
||||||
|
Dict.isEmpty manager
|
||||||
|
|
||||||
|
|
||||||
|
{-| Since the StateManager's internal structure prevents Elm from making (==)
|
||||||
|
comparisons, the `isEqual` function allows you to make comparisons that ignore
|
||||||
|
the incomparable function.
|
||||||
|
-}
|
||||||
|
isEqual : StateManager -> StateManager -> Bool
|
||||||
|
isEqual (StateManager sm1) (StateManager sm2) =
|
||||||
|
if Dict.size sm1 /= Dict.size sm2 then
|
||||||
|
False
|
||||||
|
|
||||||
|
else if Dict.keys sm1 /= Dict.keys sm2 then
|
||||||
|
False
|
||||||
|
|
||||||
|
else
|
||||||
|
List.all
|
||||||
|
(\key ->
|
||||||
|
case ( Dict.get key sm1, Dict.get key sm2 ) of
|
||||||
|
( Just s1, Just s2 ) ->
|
||||||
|
Mashdict.isEqual s1 s2
|
||||||
|
|
||||||
|
( _, _ ) ->
|
||||||
|
False
|
||||||
|
)
|
||||||
|
(Dict.keys sm1)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Retrieve all keys from a StateManager.
|
||||||
|
-}
|
||||||
|
keys : StateManager -> List { eventType : String, stateKey : String }
|
||||||
|
keys (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.toList
|
||||||
|
|> List.map
|
||||||
|
(\( eventType, dict ) ->
|
||||||
|
dict
|
||||||
|
|> Mashdict.keys
|
||||||
|
|> List.map
|
||||||
|
(\stateKey ->
|
||||||
|
{ eventType = eventType, stateKey = stateKey }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> List.concat
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether an event is part of the StateManager.
|
||||||
|
-}
|
||||||
|
member : Event -> StateManager -> Bool
|
||||||
|
member event (StateManager manager) =
|
||||||
|
case Dict.get event.eventType manager of
|
||||||
|
Just dict ->
|
||||||
|
Mashdict.member event dict
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine whether a given key is part of the StateManager.
|
||||||
|
-}
|
||||||
|
memberKey : { eventType : String, stateKey : String } -> StateManager -> Bool
|
||||||
|
memberKey { eventType, stateKey } (StateManager manager) =
|
||||||
|
case Dict.get eventType manager of
|
||||||
|
Just dict ->
|
||||||
|
Mashdict.memberKey stateKey dict
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
False
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get a StateManager without a given event in it. If the StateManager already
|
||||||
|
doesn't have the event, nothing changes.
|
||||||
|
-}
|
||||||
|
remove : Event -> StateManager -> StateManager
|
||||||
|
remove event (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.update event.eventType (Maybe.map (Mashdict.remove event))
|
||||||
|
|> StateManager
|
||||||
|
|> cleanKey event.eventType
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a StateManager that contains a single event.
|
||||||
|
-}
|
||||||
|
singleton : Event -> StateManager
|
||||||
|
singleton event =
|
||||||
|
insert event empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the StateManager's size by the amount of events.
|
||||||
|
-}
|
||||||
|
size : StateManager -> Int
|
||||||
|
size (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.values
|
||||||
|
|> List.map Mashdict.size
|
||||||
|
|> List.sum
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform the StateManager to a list of events.
|
||||||
|
-}
|
||||||
|
toList : StateManager -> List Event
|
||||||
|
toList =
|
||||||
|
values
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the values from the StateManager, ordered by their event type (and by
|
||||||
|
their state key, if multiple events are of the same event type).
|
||||||
|
-}
|
||||||
|
values : StateManager -> List Event
|
||||||
|
values (StateManager manager) =
|
||||||
|
manager
|
||||||
|
|> Dict.values
|
||||||
|
|> List.map Mashdict.values
|
||||||
|
|> List.concat
|
|
@ -0,0 +1,703 @@
|
||||||
|
module Internal.Values.Timeline exposing
|
||||||
|
( Batch, Timeline
|
||||||
|
, empty, singleton
|
||||||
|
, mostRecentEvents, mostRecentEventsFrom
|
||||||
|
, addSync, insert
|
||||||
|
, coder, encode, decoder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Timeline
|
||||||
|
|
||||||
|
The Timeline data type represents a timeline in the Matrix room. The Matrix room
|
||||||
|
timeline is quite a complex data type, as it is constantly only partially known
|
||||||
|
by the Matrix client. This module exposes a data type that helps explore, track
|
||||||
|
and maintain this room state.
|
||||||
|
|
||||||
|
This design of the timeline uses the batches as waypoints to maintain an order.
|
||||||
|
The Matrix API often returns batches that have the following four pieces of
|
||||||
|
information:
|
||||||
|
|
||||||
|
1. A list of events.
|
||||||
|
2. A filter for which all of the events meet the criteria.
|
||||||
|
3. An end batch token.
|
||||||
|
4. _(Optional)_ A start batch token. If it is not provided, it is the start of
|
||||||
|
the timeline.
|
||||||
|
|
||||||
|
Here's an example of such a timeline batch:
|
||||||
|
|
||||||
|
|-->[■]->[■]->[●]->[■]->[■]->[●]-->|
|
||||||
|
| |
|
||||||
|
|<-- filter: only ■ and ●, no ★ -->|
|
||||||
|
| |
|
||||||
|
start: end:
|
||||||
|
<token_1> <token_2>
|
||||||
|
|
||||||
|
When the Matrix API later returns a batch token that starts with `<token_2>`,
|
||||||
|
we know that we can connect it to the batch above and make a longer list of
|
||||||
|
events!
|
||||||
|
|
||||||
|
|
||||||
|
## Batch
|
||||||
|
|
||||||
|
@docs Batch, Timeline
|
||||||
|
|
||||||
|
|
||||||
|
## Create
|
||||||
|
|
||||||
|
@docs empty, singleton
|
||||||
|
|
||||||
|
|
||||||
|
## Query
|
||||||
|
|
||||||
|
@docs mostRecentEvents, mostRecentEventsFrom
|
||||||
|
|
||||||
|
|
||||||
|
## Manipulate
|
||||||
|
|
||||||
|
@docs addSync, insert
|
||||||
|
|
||||||
|
|
||||||
|
## JSON coder
|
||||||
|
|
||||||
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
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.Json as Json
|
||||||
|
import Recursion
|
||||||
|
import Recursion.Traverse
|
||||||
|
import Set exposing (Set)
|
||||||
|
|
||||||
|
|
||||||
|
{-| A batch is a batch of events that is placed onto the Timeline. Functions
|
||||||
|
that require an insertion, generally require this data type.
|
||||||
|
|
||||||
|
If the `start` value is `Nothing`, it is either the start of the timeline or the
|
||||||
|
start of the timeline part that the user is allowed to view.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Batch =
|
||||||
|
{ events : List String
|
||||||
|
, filter : Filter
|
||||||
|
, start : Maybe TokenValue
|
||||||
|
, end : TokenValue
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Internal batch that's being saved by the Timeline to track a list of events.
|
||||||
|
-}
|
||||||
|
type alias IBatch =
|
||||||
|
{ events : List String
|
||||||
|
, filter : Filter
|
||||||
|
, start : ITokenPTR
|
||||||
|
, end : ITokenPTR
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Pointer to an IBatch in the Timeline.
|
||||||
|
-}
|
||||||
|
type IBatchPTR
|
||||||
|
= IBatchPTR IBatchPTRValue
|
||||||
|
|
||||||
|
|
||||||
|
{-| Location indicator of an IBatch in the Timeline.
|
||||||
|
-}
|
||||||
|
type alias IBatchPTRValue =
|
||||||
|
Int
|
||||||
|
|
||||||
|
|
||||||
|
{-| Internal token value that's being stored by the Timeline.
|
||||||
|
|
||||||
|
If name is `Nothing`, it indicates the start of the timeline.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias IToken =
|
||||||
|
{ name : TokenValue
|
||||||
|
, starts : Set IBatchPTRValue -- This itoken starts the following batches
|
||||||
|
, ends : Set IBatchPTRValue -- This itoken ends the following batches
|
||||||
|
, inFrontOf : Set ITokenPTRValue -- This itoken is in front of the following tokens
|
||||||
|
, behind : Set ITokenPTRValue -- This itoken is behind the following tokens
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Pointer to an IToken in the Timeline.
|
||||||
|
-}
|
||||||
|
type ITokenPTR
|
||||||
|
= ITokenPTR ITokenPTRValue
|
||||||
|
| StartOfTimeline
|
||||||
|
|
||||||
|
|
||||||
|
{-| Location indicator of an IToken in the Timeline.
|
||||||
|
-}
|
||||||
|
type alias ITokenPTRValue =
|
||||||
|
String
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Timeline type represents the timeline state in a Matrix room.
|
||||||
|
|
||||||
|
Following the description of the Matrix spec, a timeline contains the following
|
||||||
|
items:
|
||||||
|
|
||||||
|
- Events that indicate timeline events
|
||||||
|
- Batch values that can be used to paginate through the timeline
|
||||||
|
|
||||||
|
The topological shape of the timeline makes older API responses somewhat
|
||||||
|
unreliable - as a result,
|
||||||
|
|
||||||
|
-}
|
||||||
|
type Timeline
|
||||||
|
= Timeline
|
||||||
|
{ batches : Iddict IBatch
|
||||||
|
, events : Dict String ( IBatchPTR, List IBatchPTR )
|
||||||
|
, filledBatches : Int
|
||||||
|
, mostRecentBatch : ITokenPTR
|
||||||
|
, tokens : Hashdict IToken
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque token value sent by the Matrix API
|
||||||
|
-}
|
||||||
|
type alias TokenValue =
|
||||||
|
String
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new batch as a sync
|
||||||
|
-}
|
||||||
|
addSync : Batch -> Timeline -> Timeline
|
||||||
|
addSync batch timeline =
|
||||||
|
case insertBatch batch timeline of
|
||||||
|
( Timeline t, { start, end } ) ->
|
||||||
|
let
|
||||||
|
old : ITokenPTR
|
||||||
|
old =
|
||||||
|
t.mostRecentBatch
|
||||||
|
in
|
||||||
|
case Timeline { t | mostRecentBatch = end } of
|
||||||
|
tl ->
|
||||||
|
if old == start then
|
||||||
|
tl
|
||||||
|
|
||||||
|
else
|
||||||
|
connectITokenToIToken old start tl
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how a Timeline can be encoded and decoded to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder Timeline
|
||||||
|
coder =
|
||||||
|
Json.object5
|
||||||
|
{ name = Text.docs.timeline.name
|
||||||
|
, description = Text.docs.timeline.description
|
||||||
|
, init =
|
||||||
|
\a b c d e ->
|
||||||
|
Timeline
|
||||||
|
{ batches = a
|
||||||
|
, events = b
|
||||||
|
, filledBatches = c
|
||||||
|
, mostRecentBatch = d
|
||||||
|
, tokens = e
|
||||||
|
}
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "batches"
|
||||||
|
, toField = \(Timeline t) -> t.batches
|
||||||
|
, description = Text.fields.timeline.batches
|
||||||
|
, coder = Json.iddict coderIBatch
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "events"
|
||||||
|
, toField = \(Timeline t) -> t.events
|
||||||
|
, description = Text.fields.timeline.events
|
||||||
|
, coder = Json.fastDict (Json.listWithOne coderIBatchPTR)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "filledBatches"
|
||||||
|
, toField = \(Timeline t) -> t.filledBatches
|
||||||
|
, description = Text.fields.timeline.filledBatches
|
||||||
|
, coder = Json.int
|
||||||
|
, default = ( 0, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "mostRecentBatch"
|
||||||
|
, toField = \(Timeline t) -> t.mostRecentBatch
|
||||||
|
, description = Text.fields.timeline.mostRecentBatch
|
||||||
|
, coder = coderITokenPTR
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "tokens"
|
||||||
|
, toField = \(Timeline t) -> t.tokens
|
||||||
|
, description = Text.fields.timeline.tokens
|
||||||
|
, coder = Hashdict.coder .name coderIToken
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a IBatch to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderIBatch : Json.Coder IBatch
|
||||||
|
coderIBatch =
|
||||||
|
Json.object4
|
||||||
|
{ name = Text.docs.ibatch.name
|
||||||
|
, description = Text.docs.ibatch.description
|
||||||
|
, init = IBatch
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "events"
|
||||||
|
, toField = .events
|
||||||
|
, description = Text.fields.ibatch.events
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "filter"
|
||||||
|
, toField = .filter
|
||||||
|
, description = Text.fields.ibatch.filter
|
||||||
|
, coder = Filter.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "start"
|
||||||
|
, toField = .start
|
||||||
|
, description = Text.fields.ibatch.start
|
||||||
|
, coder = coderITokenPTR
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "end"
|
||||||
|
, toField = .end
|
||||||
|
, description = Text.fields.ibatch.end
|
||||||
|
, coder = coderITokenPTR
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a IBatchPTR to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderIBatchPTR : Json.Coder IBatchPTR
|
||||||
|
coderIBatchPTR =
|
||||||
|
Json.map
|
||||||
|
{ name = Text.docs.itoken.name
|
||||||
|
, description = Text.docs.itoken.description
|
||||||
|
, back = \(IBatchPTR value) -> value
|
||||||
|
, forth = IBatchPTR
|
||||||
|
}
|
||||||
|
coderIBatchPTRValue
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a IBatchPTRValue to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderIBatchPTRValue : Json.Coder IBatchPTRValue
|
||||||
|
coderIBatchPTRValue =
|
||||||
|
Json.int
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a IToken to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderIToken : Json.Coder IToken
|
||||||
|
coderIToken =
|
||||||
|
Json.object5
|
||||||
|
{ name = Text.docs.itoken.name
|
||||||
|
, description = Text.docs.itoken.description
|
||||||
|
, init = IToken
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "name"
|
||||||
|
, toField = .name
|
||||||
|
, description = Text.fields.itoken.name
|
||||||
|
, coder = coderTokenValue
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "starts"
|
||||||
|
, toField = .starts
|
||||||
|
, description = Text.fields.itoken.starts
|
||||||
|
, coder = Json.set coderIBatchPTRValue
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "ends"
|
||||||
|
, toField = .ends
|
||||||
|
, description = Text.fields.itoken.ends
|
||||||
|
, coder = Json.set coderIBatchPTRValue
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "inFrontOf"
|
||||||
|
, toField = .inFrontOf
|
||||||
|
, description = Text.fields.itoken.inFrontOf
|
||||||
|
, coder = Json.set coderITokenPTRValue
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "behind"
|
||||||
|
, toField = .behind
|
||||||
|
, description = Text.fields.itoken.behind
|
||||||
|
, coder = Json.set coderITokenPTRValue
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a ITokenPTR to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderITokenPTR : Json.Coder ITokenPTR
|
||||||
|
coderITokenPTR =
|
||||||
|
Json.maybe coderITokenPTRValue
|
||||||
|
|> Json.map
|
||||||
|
{ name = Text.mappings.itokenPTR.name
|
||||||
|
, description = Text.mappings.itokenPTR.description
|
||||||
|
, back =
|
||||||
|
\itokenptr ->
|
||||||
|
case itokenptr of
|
||||||
|
ITokenPTR name ->
|
||||||
|
Just name
|
||||||
|
|
||||||
|
StartOfTimeline ->
|
||||||
|
Nothing
|
||||||
|
, forth =
|
||||||
|
\value ->
|
||||||
|
case value of
|
||||||
|
Just name ->
|
||||||
|
ITokenPTR name
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
StartOfTimeline
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a ITokenPTRValue to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderITokenPTRValue : Json.Coder ITokenPTRValue
|
||||||
|
coderITokenPTRValue =
|
||||||
|
Json.string
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define how to encode and decode a TokenValue to and from a JSON value.
|
||||||
|
-}
|
||||||
|
coderTokenValue : Json.Coder TokenValue
|
||||||
|
coderTokenValue =
|
||||||
|
Json.string
|
||||||
|
|
||||||
|
|
||||||
|
{-| Append a token at the end of a batch.
|
||||||
|
-}
|
||||||
|
connectIBatchToIToken : IBatchPTR -> ITokenPTR -> Timeline -> Timeline
|
||||||
|
connectIBatchToIToken (IBatchPTR bptr) pointer (Timeline tl) =
|
||||||
|
case pointer of
|
||||||
|
StartOfTimeline ->
|
||||||
|
Timeline tl
|
||||||
|
|
||||||
|
ITokenPTR tptr ->
|
||||||
|
Timeline
|
||||||
|
{ tl
|
||||||
|
| batches =
|
||||||
|
Iddict.update bptr
|
||||||
|
(Maybe.map (\batch -> { batch | end = pointer }))
|
||||||
|
tl.batches
|
||||||
|
, tokens =
|
||||||
|
Hashdict.map tptr
|
||||||
|
(\token -> { token | ends = Set.insert bptr token.ends })
|
||||||
|
tl.tokens
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Append a token at the start of a batch.
|
||||||
|
-}
|
||||||
|
connectITokenToIBatch : ITokenPTR -> IBatchPTR -> Timeline -> Timeline
|
||||||
|
connectITokenToIBatch pointer (IBatchPTR bptr) (Timeline tl) =
|
||||||
|
case pointer of
|
||||||
|
StartOfTimeline ->
|
||||||
|
Timeline tl
|
||||||
|
|
||||||
|
ITokenPTR tptr ->
|
||||||
|
Timeline
|
||||||
|
{ tl
|
||||||
|
| tokens =
|
||||||
|
Hashdict.map tptr
|
||||||
|
(\token -> { token | starts = Set.insert bptr token.starts })
|
||||||
|
tl.tokens
|
||||||
|
, batches =
|
||||||
|
Iddict.update bptr
|
||||||
|
(Maybe.map (\batch -> { batch | start = pointer }))
|
||||||
|
tl.batches
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Connect two tokens to each other, revealing their relative location.
|
||||||
|
-}
|
||||||
|
connectITokenToIToken : ITokenPTR -> ITokenPTR -> Timeline -> Timeline
|
||||||
|
connectITokenToIToken pointer1 pointer2 (Timeline tl) =
|
||||||
|
case ( pointer1, pointer2 ) of
|
||||||
|
( ITokenPTR early, ITokenPTR late ) ->
|
||||||
|
if early == late then
|
||||||
|
Timeline tl
|
||||||
|
|
||||||
|
else
|
||||||
|
Timeline
|
||||||
|
{ tl
|
||||||
|
| tokens =
|
||||||
|
tl.tokens
|
||||||
|
|> Hashdict.map early
|
||||||
|
(\data ->
|
||||||
|
{ data | behind = Set.insert late data.behind }
|
||||||
|
)
|
||||||
|
|> Hashdict.map late
|
||||||
|
(\data ->
|
||||||
|
{ data | inFrontOf = Set.insert early data.inFrontOf }
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
( _, _ ) ->
|
||||||
|
Timeline tl
|
||||||
|
|
||||||
|
|
||||||
|
{-| Timeline JSON decoder that helps decode a Timeline from JSON.
|
||||||
|
-}
|
||||||
|
decoder : Json.Decoder Timeline
|
||||||
|
decoder =
|
||||||
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a new empty timeline.
|
||||||
|
-}
|
||||||
|
empty : Timeline
|
||||||
|
empty =
|
||||||
|
Timeline
|
||||||
|
{ batches = Iddict.empty
|
||||||
|
, events = Dict.empty
|
||||||
|
, filledBatches = 0
|
||||||
|
, mostRecentBatch = StartOfTimeline
|
||||||
|
, tokens = Hashdict.empty .name
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Directly encode a Timeline into a JSON value.
|
||||||
|
-}
|
||||||
|
encode : Json.Encoder Timeline
|
||||||
|
encode =
|
||||||
|
Json.encode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an IBatch from the Timeline.
|
||||||
|
-}
|
||||||
|
getIBatch : IBatchPTR -> Timeline -> Maybe IBatch
|
||||||
|
getIBatch (IBatchPTR ptr) (Timeline { batches }) =
|
||||||
|
Iddict.get ptr batches
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an IToken from the Timeline.
|
||||||
|
-}
|
||||||
|
getITokenFromPTR : ITokenPTR -> Timeline -> Maybe IToken
|
||||||
|
getITokenFromPTR pointer (Timeline { tokens }) =
|
||||||
|
case pointer of
|
||||||
|
ITokenPTR ptr ->
|
||||||
|
Hashdict.get ptr tokens
|
||||||
|
|
||||||
|
StartOfTimeline ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a batch anywhere else in the timeline.
|
||||||
|
-}
|
||||||
|
insert : Batch -> Timeline -> Timeline
|
||||||
|
insert batch timeline =
|
||||||
|
timeline
|
||||||
|
|> insertBatch batch
|
||||||
|
|> Tuple.first
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a batch into the timeline.
|
||||||
|
-}
|
||||||
|
insertBatch : Batch -> Timeline -> ( Timeline, { start : ITokenPTR, end : ITokenPTR } )
|
||||||
|
insertBatch batch timeline =
|
||||||
|
case batch.start of
|
||||||
|
Just start ->
|
||||||
|
timeline
|
||||||
|
|> invokeIToken start
|
||||||
|
|> Tuple.mapSecond (invokeIToken batch.end)
|
||||||
|
|> (\( startPTR, ( endPTR, newTimeline ) ) ->
|
||||||
|
( insertIBatch
|
||||||
|
{ events = batch.events
|
||||||
|
, filter = batch.filter
|
||||||
|
, start = startPTR
|
||||||
|
, end = endPTR
|
||||||
|
}
|
||||||
|
newTimeline
|
||||||
|
, { start = startPTR, end = endPTR }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
timeline
|
||||||
|
|> invokeIToken batch.end
|
||||||
|
|> (\( endPTR, newTimeline ) ->
|
||||||
|
( insertIBatch
|
||||||
|
{ events = batch.events
|
||||||
|
, filter = batch.filter
|
||||||
|
, start = StartOfTimeline
|
||||||
|
, end = endPTR
|
||||||
|
}
|
||||||
|
newTimeline
|
||||||
|
, { start = StartOfTimeline, end = endPTR }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert an internal batch into the timeline, and determine its result.
|
||||||
|
-}
|
||||||
|
insertIBatch : IBatch -> Timeline -> Timeline
|
||||||
|
insertIBatch ibatch (Timeline tl) =
|
||||||
|
case Iddict.insert ibatch tl.batches of
|
||||||
|
( batchPTR, newBatches ) ->
|
||||||
|
{ tl
|
||||||
|
| batches = newBatches
|
||||||
|
, events =
|
||||||
|
List.foldl
|
||||||
|
(\event dict ->
|
||||||
|
Dict.update event
|
||||||
|
(\value ->
|
||||||
|
case value of
|
||||||
|
Nothing ->
|
||||||
|
Just ( IBatchPTR batchPTR, [] )
|
||||||
|
|
||||||
|
Just ( head, tail ) ->
|
||||||
|
Just ( IBatchPTR batchPTR, head :: tail )
|
||||||
|
)
|
||||||
|
dict
|
||||||
|
)
|
||||||
|
tl.events
|
||||||
|
ibatch.events
|
||||||
|
, filledBatches =
|
||||||
|
if List.isEmpty ibatch.events then
|
||||||
|
tl.filledBatches
|
||||||
|
|
||||||
|
else
|
||||||
|
tl.filledBatches + 1
|
||||||
|
}
|
||||||
|
|> Timeline
|
||||||
|
|> connectITokenToIBatch ibatch.start (IBatchPTR batchPTR)
|
||||||
|
|> connectIBatchToIToken (IBatchPTR batchPTR) ibatch.end
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invoke an itoken to guarantee that it exists.
|
||||||
|
-}
|
||||||
|
invokeIToken : TokenValue -> Timeline -> ( ITokenPTR, Timeline )
|
||||||
|
invokeIToken value (Timeline tl) =
|
||||||
|
( ITokenPTR value
|
||||||
|
, Timeline
|
||||||
|
{ tl
|
||||||
|
| tokens =
|
||||||
|
case Hashdict.get value tl.tokens of
|
||||||
|
Just _ ->
|
||||||
|
tl.tokens
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Hashdict.insert
|
||||||
|
{ name = value
|
||||||
|
, starts = Set.empty
|
||||||
|
, ends = Set.empty
|
||||||
|
, inFrontOf = Set.empty
|
||||||
|
, behind = Set.empty
|
||||||
|
}
|
||||||
|
tl.tokens
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Under a given filter, find the most recent events.
|
||||||
|
-}
|
||||||
|
mostRecentEvents : Filter -> Timeline -> List (List String)
|
||||||
|
mostRecentEvents filter (Timeline timeline) =
|
||||||
|
mostRecentFrom filter (Timeline timeline) timeline.mostRecentBatch
|
||||||
|
|
||||||
|
|
||||||
|
{-| Instead of finding the most recent events from the latest sync, users can
|
||||||
|
also find the most recent events given a token value.
|
||||||
|
-}
|
||||||
|
mostRecentEventsFrom : Filter -> ITokenPTRValue -> Timeline -> List (List String)
|
||||||
|
mostRecentEventsFrom filter tokenName timeline =
|
||||||
|
mostRecentFrom filter timeline (ITokenPTR tokenName)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Under a given filter, starting from a given ITokenPTR, find the most recent
|
||||||
|
events.
|
||||||
|
-}
|
||||||
|
mostRecentFrom : Filter -> Timeline -> ITokenPTR -> List (List String)
|
||||||
|
mostRecentFrom filter timeline ptr =
|
||||||
|
Recursion.runRecursion
|
||||||
|
(\p ->
|
||||||
|
case getITokenFromPTR p.ptr timeline of
|
||||||
|
Nothing ->
|
||||||
|
Recursion.base []
|
||||||
|
|
||||||
|
Just token ->
|
||||||
|
if Set.member token.name p.visited then
|
||||||
|
Recursion.base []
|
||||||
|
|
||||||
|
else
|
||||||
|
token.ends
|
||||||
|
|> Set.toList
|
||||||
|
|> List.filterMap (\bptrv -> getIBatch (IBatchPTR bptrv) timeline)
|
||||||
|
|> List.filter (\ibatch -> Filter.subsetOf ibatch.filter filter)
|
||||||
|
|> Recursion.Traverse.traverseList
|
||||||
|
(\ibatch ->
|
||||||
|
Recursion.recurseThen
|
||||||
|
{ ptr = ibatch.start, visited = Set.insert token.name p.visited }
|
||||||
|
(\optionalTimelines ->
|
||||||
|
case optionalTimelines of
|
||||||
|
[] ->
|
||||||
|
List.singleton ibatch.events
|
||||||
|
|> Recursion.base
|
||||||
|
|
||||||
|
_ :: _ ->
|
||||||
|
optionalTimelines
|
||||||
|
|> List.map
|
||||||
|
(\outTimeline ->
|
||||||
|
List.append outTimeline ibatch.events
|
||||||
|
)
|
||||||
|
|> Recursion.base
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> Recursion.map List.concat
|
||||||
|
)
|
||||||
|
{ 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
|
||||||
|
-- }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a timeline with a single batch inserted. This batch is considered the
|
||||||
|
most recent batch, as if created by a sync.
|
||||||
|
-}
|
||||||
|
singleton : Batch -> Timeline
|
||||||
|
singleton b =
|
||||||
|
insert b empty
|
|
@ -0,0 +1,106 @@
|
||||||
|
module Internal.Values.User exposing
|
||||||
|
( User, toString, fromString
|
||||||
|
, localpart, domain
|
||||||
|
, coder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The Matrix user is uniquely identified by their identifier. This User type
|
||||||
|
helps identify and safely handle these strings to transform them into meaningful
|
||||||
|
data types.
|
||||||
|
|
||||||
|
|
||||||
|
## User
|
||||||
|
|
||||||
|
@docs User, toString, fromString
|
||||||
|
|
||||||
|
|
||||||
|
## Divide
|
||||||
|
|
||||||
|
Matrix users are identified by their unique ID. In the Matrix API, this is a
|
||||||
|
string that looks as follows:
|
||||||
|
|
||||||
|
@alice:example.org
|
||||||
|
\---/ \---------/
|
||||||
|
| |
|
||||||
|
| |
|
||||||
|
localpart domain
|
||||||
|
|
||||||
|
Since the username is safely parsed, one can get these parts of the username.
|
||||||
|
|
||||||
|
@docs localpart, domain
|
||||||
|
|
||||||
|
|
||||||
|
## JSON
|
||||||
|
|
||||||
|
@docs coder
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Grammar.ServerName as ServerName
|
||||||
|
import Internal.Grammar.UserId as UserId
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Parser as P
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Matrix user represents a user across multiple Matrix rooms.
|
||||||
|
-}
|
||||||
|
type alias User =
|
||||||
|
UserId.UserID
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define a method to encode/decode Matrix users.
|
||||||
|
-}
|
||||||
|
coder : Json.Coder User
|
||||||
|
coder =
|
||||||
|
Json.parser
|
||||||
|
{ name = "Username"
|
||||||
|
, p =
|
||||||
|
P.andThen
|
||||||
|
(\name ->
|
||||||
|
P.succeed
|
||||||
|
( name
|
||||||
|
, if UserId.isHistorical name then
|
||||||
|
[ log.warn "Historical user found"
|
||||||
|
]
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
)
|
||||||
|
)
|
||||||
|
UserId.userIdParser
|
||||||
|
, toString = UserId.toString
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The domain represents the Matrix homeserver controlling this user. It also
|
||||||
|
offers other Matrix homeservers an indication of where to look if you wish to
|
||||||
|
send a message to this user.
|
||||||
|
-}
|
||||||
|
domain : User -> String
|
||||||
|
domain =
|
||||||
|
.domain >> ServerName.toString
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parse a string and convert it into a User, if formatted properly.
|
||||||
|
-}
|
||||||
|
fromString : String -> Maybe User
|
||||||
|
fromString =
|
||||||
|
UserId.fromString
|
||||||
|
|
||||||
|
|
||||||
|
{-| The localpart is similar to a username, in the sense that every user has
|
||||||
|
their own localpart. The localpart is not unique across multiple servers,
|
||||||
|
however! There can be a user @alice:example.com and a user @alice:example.org in
|
||||||
|
a room at the same time.
|
||||||
|
-}
|
||||||
|
localpart : User -> String
|
||||||
|
localpart =
|
||||||
|
.localpart
|
||||||
|
|
||||||
|
|
||||||
|
{-| Convert a user into its unique identifier string value.
|
||||||
|
-}
|
||||||
|
toString : User -> String
|
||||||
|
toString =
|
||||||
|
UserId.toString
|
|
@ -0,0 +1,191 @@
|
||||||
|
module Internal.Values.Vault exposing
|
||||||
|
( Vault, init
|
||||||
|
, VaultUpdate(..), update
|
||||||
|
, rooms, fromRoomId, mapRoom, updateRoom
|
||||||
|
, getAccountData, setAccountData
|
||||||
|
, coder
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| 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.
|
||||||
|
|
||||||
|
|
||||||
|
## 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
|
249
src/Matrix.elm
249
src/Matrix.elm
|
@ -1,20 +1,255 @@
|
||||||
module Matrix exposing (Vault)
|
module Matrix exposing
|
||||||
{-| # Matrix SDK
|
( Vault, fromUserId, fromUsername
|
||||||
|
, VaultUpdate, update, sync, logs
|
||||||
|
, rooms, fromRoomId
|
||||||
|
, getAccountData, setAccountData
|
||||||
|
, addAccessToken, sendMessageEvent
|
||||||
|
)
|
||||||
|
|
||||||
This first version forms a mere basis from which we will create iterative builds
|
{-|
|
||||||
that slowly improve the codebase.
|
|
||||||
|
|
||||||
|
# Matrix SDK
|
||||||
|
|
||||||
|
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
|
It is generally quite unusual to regularly publish iterative beta versions on
|
||||||
the public registry, but it is also generally quite unusual to exclusively
|
the public registry, but it is also generally quite unusual to exclusively
|
||||||
support a monolithic public registry. (:
|
support a monolithic public registry. (:
|
||||||
|
|
||||||
|
|
||||||
## Vault
|
## 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 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.
|
{-| 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 Vault = Vault
|
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
|
||||||
|
|
|
@ -0,0 +1,144 @@
|
||||||
|
module Matrix.Event exposing
|
||||||
|
( Event, content, eventType, stateKey
|
||||||
|
, eventId, roomId, sender, originServerTs
|
||||||
|
, previousContent, redactedBecause
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Matrix Events
|
||||||
|
|
||||||
|
This module contains all the functions necessary to view and manipulate Matrix
|
||||||
|
events.
|
||||||
|
|
||||||
|
|
||||||
|
## Event
|
||||||
|
|
||||||
|
@docs Event, content, eventType, stateKey
|
||||||
|
|
||||||
|
|
||||||
|
## Metadata
|
||||||
|
|
||||||
|
@docs eventId, roomId, sender, originServerTs
|
||||||
|
|
||||||
|
|
||||||
|
## Optional data
|
||||||
|
|
||||||
|
Occasionally, the Event might bring some extra information. Given how this
|
||||||
|
information isn't always applicable, it doesn't always exist.
|
||||||
|
|
||||||
|
@docs previousContent, redactedBecause
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Values.Envelope as Envelope
|
||||||
|
import Internal.Values.Event as Internal
|
||||||
|
import Json.Encode
|
||||||
|
import Time
|
||||||
|
import Types exposing (Event(..))
|
||||||
|
|
||||||
|
|
||||||
|
{-| In Matrix, the primary form of communication is to send JSON values to one
|
||||||
|
another. These JSON values, together with their metadata, are bundled into Event
|
||||||
|
types. They contain information like:
|
||||||
|
|
||||||
|
- Who sent the JSON value
|
||||||
|
- How they intend you to decode it
|
||||||
|
- When they sent it
|
||||||
|
- In what room they sent it
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias Event =
|
||||||
|
Types.Event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Receive the body of an Event, as created by the user that sent it.
|
||||||
|
-}
|
||||||
|
content : Event -> Json.Encode.Value
|
||||||
|
content (Event event) =
|
||||||
|
Envelope.extract .content event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the globally unique identifier for an event.
|
||||||
|
-}
|
||||||
|
eventId : Event -> String
|
||||||
|
eventId (Event event) =
|
||||||
|
Envelope.extract .eventId event
|
||||||
|
|
||||||
|
|
||||||
|
{-| To give a hint what the event's [content](#content) might look like, users
|
||||||
|
can use this eventType value to hint at how the JSON might be decoded.
|
||||||
|
|
||||||
|
Standard examples of event types are `m.room.message`, `m.room.member` and
|
||||||
|
`me.noordstar.game.chess.move`.
|
||||||
|
|
||||||
|
-}
|
||||||
|
eventType : Event -> String
|
||||||
|
eventType (Event event) =
|
||||||
|
Envelope.extract .eventType event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the timestamp of at what time the event was originally received by
|
||||||
|
the original homeserver.
|
||||||
|
|
||||||
|
Generally, this timestamp offers a relatively accurate indicator of when a
|
||||||
|
message was sent. However, this number isn't completely reliable! The timestamp
|
||||||
|
can be far in the past due to long network lag, and a (malicious) homeserver can
|
||||||
|
spoof this number to make it seem like something was sent ridiculously far in
|
||||||
|
the past - or even in the future.
|
||||||
|
|
||||||
|
-}
|
||||||
|
originServerTs : Event -> Time.Posix
|
||||||
|
originServerTs (Event event) =
|
||||||
|
Envelope.extract .originServerTs event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the previous `content` value for this event. This field is only a
|
||||||
|
`Just value` if the event is a state event, and the Matrix Vault has permission
|
||||||
|
to see the previous content.
|
||||||
|
-}
|
||||||
|
previousContent : Event -> Maybe Json.Encode.Value
|
||||||
|
previousContent (Event event) =
|
||||||
|
Envelope.extract Internal.prevContent event
|
||||||
|
|
||||||
|
|
||||||
|
{-| If the event has been redacted, the homeserver can display the event that
|
||||||
|
redacted it here.
|
||||||
|
-}
|
||||||
|
redactedBecause : Event -> Maybe Event
|
||||||
|
redactedBecause (Event event) =
|
||||||
|
Envelope.mapMaybe Internal.redactedBecause event
|
||||||
|
|> Maybe.map Event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Unique id assigned to the Matrix room. You can use this room id to reference
|
||||||
|
or look up rooms.
|
||||||
|
-}
|
||||||
|
roomId : Event -> String
|
||||||
|
roomId (Event event) =
|
||||||
|
Envelope.extract .roomId event
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the fully-qualified ID of the user who sent an event.
|
||||||
|
-}
|
||||||
|
sender : Event -> Types.User
|
||||||
|
sender (Event event) =
|
||||||
|
Envelope.map .sender event
|
||||||
|
|> Types.User
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine an event's state key.
|
||||||
|
|
||||||
|
It is present if, and only if, the event is a _state_ event. The key makes the
|
||||||
|
piece of state unique in the room. Note that it is often `Just ""`. If it is not
|
||||||
|
present, its value is `Nothing`.
|
||||||
|
|
||||||
|
State keys starting with an `@` are reserved for referencing user IDs, such as
|
||||||
|
room members. With the exception of a few events, state events set with a given
|
||||||
|
user'd ID as the state key can only be set by that user.
|
||||||
|
|
||||||
|
-}
|
||||||
|
stateKey : Event -> Maybe String
|
||||||
|
stateKey (Event event) =
|
||||||
|
Envelope.extract .stateKey event
|
|
@ -0,0 +1,214 @@
|
||||||
|
module Matrix.Room exposing
|
||||||
|
( Room, mostRecentEvents, roomId
|
||||||
|
, getAccountData, setAccountData
|
||||||
|
, sendMessageEvent, sendStateEvent
|
||||||
|
, invite, kick, ban
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Room
|
||||||
|
|
||||||
|
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, roomId
|
||||||
|
|
||||||
|
This module exposes various functions that help you inspect various aspects of
|
||||||
|
a room.
|
||||||
|
|
||||||
|
|
||||||
|
## Account data
|
||||||
|
|
||||||
|
Account data is personal information that the user stores about this Matrix
|
||||||
|
room. This may include information like:
|
||||||
|
|
||||||
|
- What type of room this is
|
||||||
|
- A list of members in the room to ignore
|
||||||
|
- A list of currently ongoing chess matches in the room
|
||||||
|
- Personal notes the user may be taking
|
||||||
|
|
||||||
|
You may consider the account data as a `Dict String Json.Value` type. Account
|
||||||
|
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, 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
|
||||||
|
import Types exposing (Room(..))
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Matrix Room type representing a room that the Matrix user has joined.
|
||||||
|
-}
|
||||||
|
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
|
||||||
|
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
|
||||||
|
}
|
|
@ -0,0 +1,153 @@
|
||||||
|
module Matrix.Settings exposing
|
||||||
|
( setAccessToken, removeAccessToken
|
||||||
|
, getDeviceName, setDeviceName
|
||||||
|
, getSyncTime, setSyncTime
|
||||||
|
, setPassword
|
||||||
|
, removePassword, removePasswordOnLogin
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| The Matrix Vault has lots of configurable variables that you rarely want to
|
||||||
|
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.
|
||||||
|
|
||||||
|
This is mostly useful for users who are logged in with multiple sessions. They
|
||||||
|
will see device names like "Element for Android" or "Element on iOS". For the
|
||||||
|
Elm SDK, they will by default see the Elm SDK with its version included. If you
|
||||||
|
are writing a custom client, however, you are free to change this to something
|
||||||
|
more meaningful to the user.
|
||||||
|
|
||||||
|
@docs getDeviceName, setDeviceName
|
||||||
|
|
||||||
|
|
||||||
|
## Sync time
|
||||||
|
|
||||||
|
Whenever the Matrix API has nothing new to report, the Elm SDK is kept on
|
||||||
|
hold until something new happens. The `syncTime` indicates a timeout to how long
|
||||||
|
the Elm SDK tolerates being held on hold.
|
||||||
|
|
||||||
|
- ↗️ A high value is good because it significantly reduces traffic between the
|
||||||
|
user and the homeserver.
|
||||||
|
- ↘️ A low value is good because it reduces the risk of
|
||||||
|
the connection ending abruptly or unexpectedly.
|
||||||
|
|
||||||
|
Nowadays, most libraries use 30 seconds as the standard, as does the Elm SDK.
|
||||||
|
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
|
||||||
|
import Types exposing (Vault(..))
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the device name.
|
||||||
|
-}
|
||||||
|
getDeviceName : Vault -> String
|
||||||
|
getDeviceName (Vault vault) =
|
||||||
|
Envelope.extractSettings .deviceName vault
|
||||||
|
|
||||||
|
|
||||||
|
{-| Determine the sync timeout value.
|
||||||
|
-}
|
||||||
|
getSyncTime : Vault -> Int
|
||||||
|
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
|
||||||
|
setSyncTime time (Vault vault) =
|
||||||
|
Vault <| Envelope.mapSettings (\s -> { s | syncTime = max 1 time }) vault
|
|
@ -0,0 +1,147 @@
|
||||||
|
module Matrix.User exposing
|
||||||
|
( User, toString
|
||||||
|
, localpart, domain
|
||||||
|
, get
|
||||||
|
)
|
||||||
|
|
||||||
|
{-| Matrix users are identified by their unique ID. In the Matrix API, this is a
|
||||||
|
string that looks as follows:
|
||||||
|
|
||||||
|
@alice:example.org
|
||||||
|
\---/ \---------/
|
||||||
|
| |
|
||||||
|
| |
|
||||||
|
localpart domain
|
||||||
|
|
||||||
|
Since it is very easy to abuse Matrix user IDs to sneak in arbitrary values,
|
||||||
|
the Elm SDK parses them and makes sure they are safe. As a result, you might
|
||||||
|
need this module to get the right information from a user!
|
||||||
|
|
||||||
|
|
||||||
|
## User
|
||||||
|
|
||||||
|
@docs User, toString
|
||||||
|
|
||||||
|
|
||||||
|
## Info
|
||||||
|
|
||||||
|
Sometimes, you are more interested in the username itself. These functions can
|
||||||
|
help you decipher, disambiguate and categorize users based on their username.
|
||||||
|
|
||||||
|
@docs localpart, domain
|
||||||
|
|
||||||
|
|
||||||
|
## Manipulate
|
||||||
|
|
||||||
|
@docs get
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Values.Envelope as Envelope
|
||||||
|
import Internal.Values.User as Internal
|
||||||
|
import Types exposing (User(..))
|
||||||
|
|
||||||
|
|
||||||
|
{-| The User type represents a Matrix user.
|
||||||
|
|
||||||
|
It contains information like:
|
||||||
|
|
||||||
|
- Their username on Matrix
|
||||||
|
- The server that hosts their account
|
||||||
|
- Access tokens needed to talk to the server
|
||||||
|
|
||||||
|
It does **NOT** contain information like:
|
||||||
|
|
||||||
|
- Their nickname
|
||||||
|
- Their profile picture
|
||||||
|
- Your private room with them
|
||||||
|
|
||||||
|
You can get all that information by looking it up in the [Vault](Matrix#Vault).
|
||||||
|
|
||||||
|
**Note:** Please do not store this user type as a variable in your model! You
|
||||||
|
should always maintain a single source of truth in Elm, and the User type
|
||||||
|
contains various credentials and API tokens that might expire if you don't
|
||||||
|
update them from the Vault.
|
||||||
|
|
||||||
|
If you need to remember specific users, you can best compare their identifying
|
||||||
|
string using [toString](Matrix-User#toString) or you can use
|
||||||
|
[get](Matrix-User#get) with the Vault to get the user type.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias User =
|
||||||
|
Types.User
|
||||||
|
|
||||||
|
|
||||||
|
{-| The domain is the name of the server that the user connects to. Server names
|
||||||
|
are case-sensitive, so if the strings are equal, the users are on the same
|
||||||
|
server!
|
||||||
|
|
||||||
|
As a result, you can use the user domain for:
|
||||||
|
|
||||||
|
- When multiple users in a room have the same localpart on different servers
|
||||||
|
- Finding other users from a potentially malicious homeserver
|
||||||
|
- Counting homeservers in a room
|
||||||
|
|
||||||
|
See the following examples:
|
||||||
|
|
||||||
|
domain (get vault "@alice:example.org") -- "example.org"
|
||||||
|
|
||||||
|
domain (get vault "@bob:127.0.0.1") -- "127.0.0.1"
|
||||||
|
|
||||||
|
domain (get vault "@charlie:[2001:db8::]") -- "[2001:db8::]"
|
||||||
|
|
||||||
|
-}
|
||||||
|
domain : User -> String
|
||||||
|
domain (User user) =
|
||||||
|
Envelope.extract Internal.domain user
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get a specific user by their unique identifier.
|
||||||
|
|
||||||
|
The Vault is needed as an input because the `User` type also stores various
|
||||||
|
credentials needed to talk to the Matrix API.
|
||||||
|
|
||||||
|
get vault "@alice:example.org" -- Just (User "alice" "example.org")
|
||||||
|
|
||||||
|
get vault "@bob:127.0.0.1" -- Just (User "bob" "127.0.0.1")
|
||||||
|
|
||||||
|
get vault "@charlie:[2001:db8::]" -- Just (User "charlie" "2001:db8::")
|
||||||
|
|
||||||
|
get vault "@evil:#mp#ss#bl#.c#m" -- Nothing
|
||||||
|
|
||||||
|
get vault "" -- Nothing
|
||||||
|
|
||||||
|
-}
|
||||||
|
get : Types.Vault -> String -> Maybe User
|
||||||
|
get (Types.Vault vault) username =
|
||||||
|
Envelope.mapMaybe (\_ -> Internal.fromString username) vault
|
||||||
|
|> Maybe.map Types.User
|
||||||
|
|
||||||
|
|
||||||
|
{-| The localpart is the user's unique username. Every homeserver has their own
|
||||||
|
username registry, so you might occasionally find distinct users with the same
|
||||||
|
localpart.
|
||||||
|
|
||||||
|
The localpart is often used as a user's name in a room if they haven't set up
|
||||||
|
a custom name.
|
||||||
|
|
||||||
|
See the following examples:
|
||||||
|
|
||||||
|
localpart (get vault "@alice:example.org") -- "alice"
|
||||||
|
|
||||||
|
localpart (get vault "@bob:127.0.0.1") -- "bob"
|
||||||
|
|
||||||
|
localpart (get vault "@charlie:[2001:db8::]") -- "charlie"
|
||||||
|
|
||||||
|
-}
|
||||||
|
localpart : User -> String
|
||||||
|
localpart (User user) =
|
||||||
|
Envelope.extract Internal.localpart user
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the uniquely identifying string for this user. Since the strings are
|
||||||
|
case-sensitive, you can run a simple string comparison to compare usernames.
|
||||||
|
-}
|
||||||
|
toString : User -> String
|
||||||
|
toString (User user) =
|
||||||
|
Envelope.extract Internal.toString user
|
|
@ -0,0 +1,54 @@
|
||||||
|
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)
|
||||||
|
highly recommend using opaque types in order to avoid breaking everyone's code
|
||||||
|
in a future major release.
|
||||||
|
|
||||||
|
This module forms as a protective layer between the internal modules and the
|
||||||
|
exposed modules, hiding all exposed types behind opaque types so the user cannot
|
||||||
|
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, 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
|
||||||
|
import Internal.Values.User as User
|
||||||
|
import Internal.Values.Vault as Vault
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix Event
|
||||||
|
-}
|
||||||
|
type Event
|
||||||
|
= Event (Envelope.Envelope Event.Event)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix Room
|
||||||
|
-}
|
||||||
|
type Room
|
||||||
|
= Room (Envelope.Envelope Room.Room)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix User
|
||||||
|
-}
|
||||||
|
type User
|
||||||
|
= User (Envelope.Envelope User.User)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix Vault
|
||||||
|
-}
|
||||||
|
type Vault
|
||||||
|
= Vault (Envelope.Envelope Vault.Vault)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix VaultUpdate
|
||||||
|
-}
|
||||||
|
type VaultUpdate
|
||||||
|
= VaultUpdate Api.Msg
|
|
@ -0,0 +1,435 @@
|
||||||
|
module Test.Filter.Timeline exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Filter.Timeline as Filter exposing (Filter)
|
||||||
|
import Internal.Grammar.UserId as U
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Set
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Filter
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map2 Filter.and
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.map Filter.allSendersExcept (Fuzz.list Fuzz.string)
|
||||||
|
, Fuzz.map Filter.onlySenders (Fuzz.list Fuzz.string)
|
||||||
|
, Fuzz.constant Filter.pass
|
||||||
|
]
|
||||||
|
)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.map Filter.allTypesExcept (Fuzz.list Fuzz.string)
|
||||||
|
, Fuzz.map Filter.onlyTypes (Fuzz.list Fuzz.string)
|
||||||
|
, Fuzz.constant Filter.pass
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Timeline filter"
|
||||||
|
[ describe "Tautological equivalences"
|
||||||
|
[ test "Pass /= fail"
|
||||||
|
(Filter.pass
|
||||||
|
|> Expect.notEqual Filter.fail
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "All senders == pass"
|
||||||
|
(Filter.allSendersExcept []
|
||||||
|
|> Expect.equal Filter.pass
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "All types == pass"
|
||||||
|
(Filter.allTypesExcept []
|
||||||
|
|> Expect.equal Filter.pass
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No senders == fail"
|
||||||
|
(Filter.onlySenders []
|
||||||
|
|> Expect.equal Filter.fail
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No types == fail"
|
||||||
|
(Filter.onlyTypes []
|
||||||
|
|> Expect.equal Filter.fail
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz2 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Some types /= some senders"
|
||||||
|
(\head tail ->
|
||||||
|
Expect.notEqual
|
||||||
|
(Filter.onlyTypes (head :: tail))
|
||||||
|
(Filter.onlySenders (head :: tail))
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
fuzzer
|
||||||
|
"Filter.and f1 f2 == pass iff f1 == f2 == pass"
|
||||||
|
(\filter1 filter2 ->
|
||||||
|
Expect.equal
|
||||||
|
(Filter.and filter1 filter2 == Filter.pass)
|
||||||
|
(filter1 == Filter.pass && filter2 == Filter.pass)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Event filters"
|
||||||
|
[ fuzz TestEvent.fuzzer
|
||||||
|
"Only event type filter matches"
|
||||||
|
(\event ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.onlyTypes [ event.eventType ])
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Only event sender filter matches"
|
||||||
|
(\event ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.onlySenders [ U.toString event.sender ])
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Not event type filter doesn't match"
|
||||||
|
(\event ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.allTypesExcept [ event.eventType ])
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Not event sender filter doesn't match"
|
||||||
|
(\event ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.allSendersExcept [ U.toString event.sender ])
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz2 TestEvent.fuzzer
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Only matches when in sender list"
|
||||||
|
(\event senders ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.onlySenders senders)
|
||||||
|
|> Expect.equal (List.member (U.toString event.sender) senders)
|
||||||
|
)
|
||||||
|
, fuzz2 TestEvent.fuzzer
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Only matches when in type list"
|
||||||
|
(\event types ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.onlyTypes types)
|
||||||
|
|> Expect.equal (List.member event.eventType types)
|
||||||
|
)
|
||||||
|
, fuzz2 TestEvent.fuzzer
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"All except doesn't match when in sender list"
|
||||||
|
(\event senders ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.allSendersExcept senders)
|
||||||
|
|> Expect.notEqual (List.member (U.toString event.sender) senders)
|
||||||
|
)
|
||||||
|
, fuzz2 TestEvent.fuzzer
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"All except doesn't match when in type list"
|
||||||
|
(\event types ->
|
||||||
|
event
|
||||||
|
|> Filter.match (Filter.allTypesExcept types)
|
||||||
|
|> Expect.notEqual (List.member event.eventType types)
|
||||||
|
)
|
||||||
|
, fuzz (Fuzz.list Fuzz.string)
|
||||||
|
"Only list AND all except list = fail senders"
|
||||||
|
(\senders ->
|
||||||
|
Filter.onlySenders senders
|
||||||
|
|> Filter.and (Filter.allSendersExcept senders)
|
||||||
|
|> Expect.equal Filter.fail
|
||||||
|
)
|
||||||
|
, fuzz (Fuzz.list Fuzz.string)
|
||||||
|
"Only list AND all except list = fail types"
|
||||||
|
(\types ->
|
||||||
|
Filter.onlyTypes types
|
||||||
|
|> Filter.and (Filter.allTypesExcept types)
|
||||||
|
|> Expect.equal Filter.fail
|
||||||
|
)
|
||||||
|
, fuzz2 (Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Only list + all except list = common types"
|
||||||
|
(\t1 t2 ->
|
||||||
|
Expect.equal
|
||||||
|
(Filter.and
|
||||||
|
(Filter.onlyTypes t1)
|
||||||
|
(Filter.allTypesExcept t2)
|
||||||
|
)
|
||||||
|
(Set.diff (Set.fromList t1) (Set.fromList t2)
|
||||||
|
|> Set.toList
|
||||||
|
|> Filter.onlyTypes
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, fuzz2 (Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Only list + all except list = common senders"
|
||||||
|
(\t1 t2 ->
|
||||||
|
Expect.equal
|
||||||
|
(Filter.and
|
||||||
|
(Filter.onlySenders t1)
|
||||||
|
(Filter.allSendersExcept t2)
|
||||||
|
)
|
||||||
|
(Set.diff (Set.fromList t1) (Set.fromList t2)
|
||||||
|
|> Set.toList
|
||||||
|
|> Filter.onlySenders
|
||||||
|
)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Subset testing"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
fuzzer
|
||||||
|
"Combining two filters is always a subset"
|
||||||
|
(\filter1 filter2 ->
|
||||||
|
filter1
|
||||||
|
|> Filter.and filter2
|
||||||
|
|> Expect.all
|
||||||
|
[ Filter.subsetOf filter1 >> Expect.equal True
|
||||||
|
, Filter.subsetOf filter2 >> Expect.equal True
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, fuzz
|
||||||
|
(Fuzz.bool
|
||||||
|
|> Fuzz.andThen
|
||||||
|
(\same ->
|
||||||
|
if same then
|
||||||
|
Fuzz.map (\a -> ( a, a )) fuzzer
|
||||||
|
|
||||||
|
else
|
||||||
|
Fuzz.map2 Tuple.pair fuzzer fuzzer
|
||||||
|
)
|
||||||
|
)
|
||||||
|
"subset goes both way iff equal"
|
||||||
|
(\( filter1, filter2 ) ->
|
||||||
|
Expect.equal
|
||||||
|
(filter1 == filter2)
|
||||||
|
(Filter.subsetOf filter1 filter2
|
||||||
|
&& Filter.subsetOf filter2 filter1
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, fuzz2 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"One more excluded sender is a subset"
|
||||||
|
(\head tail ->
|
||||||
|
Filter.allSendersExcept (head :: tail)
|
||||||
|
|> Filter.subsetOf (Filter.allSendersExcept tail)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz2 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"One more excluded type is a subset"
|
||||||
|
(\head tail ->
|
||||||
|
Filter.allTypesExcept (head :: tail)
|
||||||
|
|> Filter.subsetOf (Filter.allTypesExcept tail)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz2 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"One less included sender is a subset"
|
||||||
|
(\head tail ->
|
||||||
|
Filter.onlySenders tail
|
||||||
|
|> Filter.subsetOf (Filter.onlySenders (head :: tail))
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz2 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"One less included type is a subset"
|
||||||
|
(\head tail ->
|
||||||
|
Filter.onlyTypes tail
|
||||||
|
|> Filter.subsetOf (Filter.onlyTypes (head :: tail))
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz3 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
fuzzer
|
||||||
|
"One more excluded sender is a subset - even when combined with another fuzzer"
|
||||||
|
(\head tail filter ->
|
||||||
|
Filter.allSendersExcept (head :: tail)
|
||||||
|
|> Filter.and filter
|
||||||
|
|> Filter.subsetOf (Filter.and filter <| Filter.allSendersExcept tail)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz3 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
fuzzer
|
||||||
|
"One more excluded type is a subset - even when combined with another fuzzer"
|
||||||
|
(\head tail filter ->
|
||||||
|
Filter.allTypesExcept (head :: tail)
|
||||||
|
|> Filter.and filter
|
||||||
|
|> Filter.subsetOf (Filter.and filter <| Filter.allTypesExcept tail)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz3 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
fuzzer
|
||||||
|
"One less included sender is a subset - even when combined with another fuzzer"
|
||||||
|
(\head tail filter ->
|
||||||
|
Filter.onlySenders tail
|
||||||
|
|> Filter.and filter
|
||||||
|
|> Filter.subsetOf (Filter.and filter <| Filter.onlySenders (head :: tail))
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz3 Fuzz.string
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
fuzzer
|
||||||
|
"One less included type is a subset - even when combined with another fuzzer"
|
||||||
|
(\head tail filter ->
|
||||||
|
Filter.onlyTypes tail
|
||||||
|
|> Filter.and filter
|
||||||
|
|> Filter.subsetOf (Filter.and filter <| Filter.onlyTypes (head :: tail))
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Use case testing"
|
||||||
|
[ fuzz3 (Fuzz.list TestEvent.fuzzer)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Only senders + only type"
|
||||||
|
(\events senders types ->
|
||||||
|
let
|
||||||
|
l1 : List Event.Event
|
||||||
|
l1 =
|
||||||
|
events
|
||||||
|
|> Filter.run
|
||||||
|
(Filter.and
|
||||||
|
(Filter.onlySenders senders)
|
||||||
|
(Filter.onlyTypes types)
|
||||||
|
)
|
||||||
|
|
||||||
|
l2 : List Event.Event
|
||||||
|
l2 =
|
||||||
|
List.filter
|
||||||
|
(\e ->
|
||||||
|
List.member (U.toString e.sender) senders
|
||||||
|
&& List.member e.eventType types
|
||||||
|
)
|
||||||
|
events
|
||||||
|
in
|
||||||
|
Expect.all
|
||||||
|
[ Expect.equal (List.length l1) (List.length l2)
|
||||||
|
|> always
|
||||||
|
, List.map2 Event.isEqual l1 l2
|
||||||
|
|> List.all identity
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
]
|
||||||
|
()
|
||||||
|
)
|
||||||
|
, fuzz3 (Fuzz.list TestEvent.fuzzer)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"Only senders + all except type"
|
||||||
|
(\events senders types ->
|
||||||
|
let
|
||||||
|
l1 : List Event.Event
|
||||||
|
l1 =
|
||||||
|
events
|
||||||
|
|> Filter.run
|
||||||
|
(Filter.and
|
||||||
|
(Filter.onlySenders senders)
|
||||||
|
(Filter.allTypesExcept types)
|
||||||
|
)
|
||||||
|
|
||||||
|
l2 : List Event.Event
|
||||||
|
l2 =
|
||||||
|
List.filter
|
||||||
|
(\e ->
|
||||||
|
List.member (U.toString e.sender) senders
|
||||||
|
&& (not <| List.member (U.toString e.sender) types)
|
||||||
|
)
|
||||||
|
events
|
||||||
|
in
|
||||||
|
Expect.all
|
||||||
|
[ Expect.equal (List.length l1) (List.length l2)
|
||||||
|
|> always
|
||||||
|
, List.map2 Event.isEqual l1 l2
|
||||||
|
|> List.all identity
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
]
|
||||||
|
()
|
||||||
|
)
|
||||||
|
, fuzz3 (Fuzz.list TestEvent.fuzzer)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"All except senders + only type"
|
||||||
|
(\events senders types ->
|
||||||
|
let
|
||||||
|
l1 : List Event.Event
|
||||||
|
l1 =
|
||||||
|
events
|
||||||
|
|> Filter.run
|
||||||
|
(Filter.and
|
||||||
|
(Filter.allSendersExcept senders)
|
||||||
|
(Filter.onlyTypes types)
|
||||||
|
)
|
||||||
|
|
||||||
|
l2 : List Event.Event
|
||||||
|
l2 =
|
||||||
|
List.filter
|
||||||
|
(\e ->
|
||||||
|
(not <| List.member (U.toString e.sender) senders)
|
||||||
|
&& List.member e.eventType types
|
||||||
|
)
|
||||||
|
events
|
||||||
|
in
|
||||||
|
Expect.all
|
||||||
|
[ Expect.equal (List.length l1) (List.length l2)
|
||||||
|
|> always
|
||||||
|
, List.map2 Event.isEqual l1 l2
|
||||||
|
|> List.all identity
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
]
|
||||||
|
()
|
||||||
|
)
|
||||||
|
, fuzz3 (Fuzz.list TestEvent.fuzzer)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
"All except senders + all except type"
|
||||||
|
(\events senders types ->
|
||||||
|
let
|
||||||
|
l1 : List Event.Event
|
||||||
|
l1 =
|
||||||
|
events
|
||||||
|
|> Filter.run
|
||||||
|
(Filter.and
|
||||||
|
(Filter.allSendersExcept senders)
|
||||||
|
(Filter.allTypesExcept types)
|
||||||
|
)
|
||||||
|
|
||||||
|
l2 : List Event.Event
|
||||||
|
l2 =
|
||||||
|
List.filter
|
||||||
|
(\e ->
|
||||||
|
(not <| List.member (U.toString e.sender) senders)
|
||||||
|
&& (not <| List.member e.eventType types)
|
||||||
|
)
|
||||||
|
events
|
||||||
|
in
|
||||||
|
Expect.all
|
||||||
|
[ Expect.equal (List.length l1) (List.length l2)
|
||||||
|
|> always
|
||||||
|
, List.map2 Event.isEqual l1 l2
|
||||||
|
|> List.all identity
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
]
|
||||||
|
()
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz fuzzer
|
||||||
|
"encode -> decode is the same"
|
||||||
|
(\filter ->
|
||||||
|
filter
|
||||||
|
|> Filter.encode
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString Filter.decoder
|
||||||
|
|> Expect.equal (Ok ( filter, [] ))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,126 @@
|
||||||
|
module Test.Grammar.ServerName exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Grammar.ServerName as SN
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
dnsFuzzer : Fuzzer String
|
||||||
|
dnsFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\head tail ->
|
||||||
|
String.fromList (head :: tail)
|
||||||
|
)
|
||||||
|
("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
|
||||||
|
|> String.toList
|
||||||
|
|> Fuzz.oneOfValues
|
||||||
|
)
|
||||||
|
("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-."
|
||||||
|
|> String.toList
|
||||||
|
|> Fuzz.oneOfValues
|
||||||
|
|> Fuzz.listOfLengthBetween 0 (255 - 1)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
hostnameFuzzer : Fuzzer String
|
||||||
|
hostnameFuzzer =
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ dnsFuzzer
|
||||||
|
, ipv4Fuzzer
|
||||||
|
, Fuzz.map (\x -> "[" ++ x ++ "]") ipv6Fuzzer
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
ipv4Fuzzer : Fuzzer String
|
||||||
|
ipv4Fuzzer =
|
||||||
|
Fuzz.intRange 0 255
|
||||||
|
|> Fuzz.listOfLength 4
|
||||||
|
|> Fuzz.map
|
||||||
|
(List.map String.fromInt
|
||||||
|
>> List.intersperse "."
|
||||||
|
>> String.concat
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
ipv6Fuzzer : Fuzzer String
|
||||||
|
ipv6Fuzzer =
|
||||||
|
let
|
||||||
|
num : Fuzzer String
|
||||||
|
num =
|
||||||
|
"0123456789abcdefABCDEF"
|
||||||
|
|> String.toList
|
||||||
|
|> Fuzz.oneOfValues
|
||||||
|
|> Fuzz.listOfLength 4
|
||||||
|
|> Fuzz.map String.fromList
|
||||||
|
in
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ Fuzz.listOfLength 8 num
|
||||||
|
|> Fuzz.map (List.intersperse ":")
|
||||||
|
|> Fuzz.map String.concat
|
||||||
|
, Fuzz.listOfLengthBetween 0 7 num
|
||||||
|
|> Fuzz.andThen
|
||||||
|
(\front ->
|
||||||
|
num
|
||||||
|
|> Fuzz.listOfLengthBetween 0 (8 - 1 - List.length front)
|
||||||
|
|> Fuzz.map
|
||||||
|
(\back ->
|
||||||
|
[ front
|
||||||
|
|> List.intersperse ":"
|
||||||
|
, [ "::" ]
|
||||||
|
, back
|
||||||
|
|> List.intersperse ":"
|
||||||
|
]
|
||||||
|
|> List.concat
|
||||||
|
|> String.concat
|
||||||
|
)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
portFuzzer : Fuzzer String
|
||||||
|
portFuzzer =
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ Fuzz.constant ""
|
||||||
|
, Fuzz.intRange 0 65535
|
||||||
|
|> Fuzz.map (\p -> ":" ++ String.fromInt p)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
serverNameFuzzer : Fuzzer String
|
||||||
|
serverNameFuzzer =
|
||||||
|
Fuzz.map2 (++) hostnameFuzzer portFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Server name tests"
|
||||||
|
[ describe "Checking correct values"
|
||||||
|
[ fuzz serverNameFuzzer
|
||||||
|
"Correct server names validate"
|
||||||
|
(\server ->
|
||||||
|
SN.fromString server
|
||||||
|
|> Maybe.map SN.toString
|
||||||
|
|> Expect.equal (Just server)
|
||||||
|
)
|
||||||
|
, test "Checking spec examples"
|
||||||
|
(\() ->
|
||||||
|
let
|
||||||
|
examples : List String
|
||||||
|
examples =
|
||||||
|
[ "matrix.org"
|
||||||
|
, "matrix.org:8888"
|
||||||
|
, "1.2.3.4"
|
||||||
|
, "1.2.3.4:1234"
|
||||||
|
, "[1234:5678::abcd]"
|
||||||
|
, "[1234:5678::abcd]:5678"
|
||||||
|
]
|
||||||
|
in
|
||||||
|
examples
|
||||||
|
|> List.map SN.fromString
|
||||||
|
|> List.map ((/=) Nothing)
|
||||||
|
|> Expect.equalLists
|
||||||
|
(List.repeat (List.length examples) True)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,159 @@
|
||||||
|
module Test.Grammar.UserId exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Grammar.ServerName as SN
|
||||||
|
import Internal.Grammar.UserId as U
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Grammar.ServerName as ServerName
|
||||||
|
|
||||||
|
|
||||||
|
modernUserCharFuzzer : Fuzzer Char
|
||||||
|
modernUserCharFuzzer =
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ Fuzz.intRange 0x61 0x7A
|
||||||
|
|> Fuzz.map Char.fromCode
|
||||||
|
, "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||||
|
|> String.toList
|
||||||
|
|> Fuzz.oneOfValues
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
historicalUserCharFuzzer : Fuzzer Char
|
||||||
|
historicalUserCharFuzzer =
|
||||||
|
[ ( 0x21, 0x39 ), ( 0x3B, 0x7E ) ]
|
||||||
|
|> List.map (\( low, high ) -> Fuzz.intRange low high)
|
||||||
|
|> Fuzz.oneOf
|
||||||
|
|> Fuzz.map Char.fromCode
|
||||||
|
|
||||||
|
|
||||||
|
modernUserFuzzer : Fuzzer String
|
||||||
|
modernUserFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\localpart domain ->
|
||||||
|
let
|
||||||
|
maxLocalSize : Int
|
||||||
|
maxLocalSize =
|
||||||
|
255 - String.length domain - 2
|
||||||
|
in
|
||||||
|
localpart
|
||||||
|
|> List.take maxLocalSize
|
||||||
|
|> String.fromList
|
||||||
|
|> (\l -> "@" ++ l ++ ":" ++ domain)
|
||||||
|
)
|
||||||
|
(Fuzz.listOfLengthBetween 1 255 modernUserCharFuzzer)
|
||||||
|
(ServerName.serverNameFuzzer
|
||||||
|
|> Fuzz.filter
|
||||||
|
(\name ->
|
||||||
|
String.length name < 255 - 2
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
historicalUserFuzzer : Fuzzer String
|
||||||
|
historicalUserFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\localpart domain ->
|
||||||
|
let
|
||||||
|
maxLocalSize : Int
|
||||||
|
maxLocalSize =
|
||||||
|
255 - String.length domain - 2
|
||||||
|
in
|
||||||
|
localpart
|
||||||
|
|> List.take maxLocalSize
|
||||||
|
|> String.fromList
|
||||||
|
|> (\l -> "@" ++ l ++ ":" ++ domain)
|
||||||
|
)
|
||||||
|
(Fuzz.listOfLengthBetween 1 255 historicalUserCharFuzzer)
|
||||||
|
(ServerName.serverNameFuzzer
|
||||||
|
|> Fuzz.filter
|
||||||
|
(\name ->
|
||||||
|
String.length name < 255 - 2
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
userFuzzer : Fuzzer String
|
||||||
|
userFuzzer =
|
||||||
|
Fuzz.oneOf [ modernUserFuzzer, historicalUserFuzzer ]
|
||||||
|
|
||||||
|
|
||||||
|
fullUserFuzzer : Fuzzer U.UserID
|
||||||
|
fullUserFuzzer =
|
||||||
|
userFuzzer
|
||||||
|
|> Fuzz.map U.fromString
|
||||||
|
|> Fuzz.map (Maybe.withDefault { localpart = "a", domain = { host = SN.DNS "a", port_ = Nothing } })
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "UserId"
|
||||||
|
[ describe "Size"
|
||||||
|
[ fuzz ServerName.serverNameFuzzer
|
||||||
|
"Username cannot be length 0"
|
||||||
|
(\domain ->
|
||||||
|
"@"
|
||||||
|
++ ":"
|
||||||
|
++ domain
|
||||||
|
|> U.fromString
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, fuzz2 (Fuzz.listOfLengthBetween 1 255 historicalUserCharFuzzer)
|
||||||
|
ServerName.serverNameFuzzer
|
||||||
|
"Username length cannot exceed 255"
|
||||||
|
(\localpart domain ->
|
||||||
|
let
|
||||||
|
username : String
|
||||||
|
username =
|
||||||
|
"@"
|
||||||
|
++ String.fromList localpart
|
||||||
|
++ ":"
|
||||||
|
++ domain
|
||||||
|
in
|
||||||
|
Expect.equal
|
||||||
|
(U.fromString username == Nothing)
|
||||||
|
(String.length username > 255)
|
||||||
|
)
|
||||||
|
, fuzz modernUserFuzzer
|
||||||
|
"Modern fuzzer has appropriate size"
|
||||||
|
(String.length >> Expect.lessThan 256)
|
||||||
|
, fuzz historicalUserFuzzer
|
||||||
|
"Historical fuzzer has appropriate size"
|
||||||
|
(String.length >> Expect.lessThan 256)
|
||||||
|
, fuzz userFuzzer
|
||||||
|
"User fuzzers have appropriate size"
|
||||||
|
(String.length >> Expect.lessThan 256)
|
||||||
|
]
|
||||||
|
, describe "From string evaluation"
|
||||||
|
[ fuzz userFuzzer
|
||||||
|
"fromString always returns a value on fuzzer"
|
||||||
|
(U.fromString >> Expect.notEqual Nothing)
|
||||||
|
, fuzz userFuzzer
|
||||||
|
"fromString -> toString returns the same value"
|
||||||
|
(\username ->
|
||||||
|
username
|
||||||
|
|> U.fromString
|
||||||
|
|> Maybe.map U.toString
|
||||||
|
|> Expect.equal (Just username)
|
||||||
|
)
|
||||||
|
|
||||||
|
-- Not always True
|
||||||
|
-- TODO: Define a fitting fuzzer for this test
|
||||||
|
-- , fuzz historicalUserFuzzer
|
||||||
|
-- "Historical users are historical"
|
||||||
|
-- (\username ->
|
||||||
|
-- username
|
||||||
|
-- |> U.fromString
|
||||||
|
-- |> Maybe.map U.isHistorical
|
||||||
|
-- |> Expect.equal (Just True)
|
||||||
|
-- )
|
||||||
|
, fuzz modernUserFuzzer
|
||||||
|
"Modern users are not historical"
|
||||||
|
(\username ->
|
||||||
|
username
|
||||||
|
|> U.fromString
|
||||||
|
|> Maybe.map U.isHistorical
|
||||||
|
|> Expect.equal (Just False)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,35 @@
|
||||||
|
module Test.Matrix.Settings exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz
|
||||||
|
import Matrix.Settings
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Types as TestTypes
|
||||||
|
|
||||||
|
|
||||||
|
settings : Test
|
||||||
|
settings =
|
||||||
|
describe "Exposed Matrix.Settings"
|
||||||
|
[ describe "Set values"
|
||||||
|
[ fuzz2 TestTypes.vault
|
||||||
|
Fuzz.string
|
||||||
|
"Set device name"
|
||||||
|
(\vault name ->
|
||||||
|
vault
|
||||||
|
|> Matrix.Settings.setDeviceName name
|
||||||
|
|> Matrix.Settings.getDeviceName
|
||||||
|
|> Expect.equal name
|
||||||
|
)
|
||||||
|
, fuzz2 TestTypes.vault
|
||||||
|
Fuzz.int
|
||||||
|
"Set sync time"
|
||||||
|
(\vault sync ->
|
||||||
|
vault
|
||||||
|
|> Matrix.Settings.setSyncTime sync
|
||||||
|
|> Matrix.Settings.getSyncTime
|
||||||
|
|> Expect.equal (max 1 sync)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
-- , describe "Read values" []
|
||||||
|
]
|
|
@ -0,0 +1,195 @@
|
||||||
|
module Test.Tools.Hashdict exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : (a -> String) -> Fuzzer a -> Fuzzer (Hashdict a)
|
||||||
|
fuzzer toHash fuz =
|
||||||
|
Fuzz.map (Hashdict.fromList toHash) (Fuzz.list fuz)
|
||||||
|
|
||||||
|
|
||||||
|
eventFuzzer : Fuzzer (Hashdict Event.Event)
|
||||||
|
eventFuzzer =
|
||||||
|
fuzzer .eventId TestEvent.fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Hashdict"
|
||||||
|
[ describe "empty"
|
||||||
|
[ test "empty isEmpty"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.isEmpty
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Nothing is member"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.empty .eventId
|
||||||
|
|> Hashdict.member event
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"No key is member"
|
||||||
|
(\key ->
|
||||||
|
Hashdict.empty identity
|
||||||
|
|> Hashdict.memberKey key
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"Get gets Nothing"
|
||||||
|
(\key ->
|
||||||
|
Hashdict.empty identity
|
||||||
|
|> Hashdict.get key
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, test "Size is zero"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.size
|
||||||
|
|> Expect.equal 0
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No keys"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.keys
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No values"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.values
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "To list is []"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.toList
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "From list is empty"
|
||||||
|
([]
|
||||||
|
|> Hashdict.fromList (\x -> x)
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty identity)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Empty + empty == empty"
|
||||||
|
(Hashdict.empty identity
|
||||||
|
|> Hashdict.union (Hashdict.empty String.toUpper)
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty String.toLower)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz (Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\indent ->
|
||||||
|
Hashdict.empty identity
|
||||||
|
|> Json.encode (Hashdict.coder identity Json.string)
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Json.decode <| Hashdict.coder identity Json.string)
|
||||||
|
|> Result.map (Tuple.mapFirst (Hashdict.isEqual (Hashdict.empty String.toUpper)))
|
||||||
|
|> Expect.equal (Ok ( True, [] ))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "singleton"
|
||||||
|
[ fuzz TestEvent.fuzzer
|
||||||
|
"singleton = empty + insert"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.empty .eventId
|
||||||
|
|> Hashdict.insert event
|
||||||
|
|> Hashdict.isEqual (Hashdict.singleton .eventId event)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Singleton - event = empty"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.remove event
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty .roomId)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Singletong - event (key) = empty"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.removeKey event.eventId
|
||||||
|
|> Hashdict.isEqual (Hashdict.empty .roomId)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"not isEmpty"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.isEmpty
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"member"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.member event
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"memberKey"
|
||||||
|
(\event ->
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.memberKey event.eventId
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"False memberKey"
|
||||||
|
(\event ->
|
||||||
|
if event.eventId == event.roomId then
|
||||||
|
Expect.pass
|
||||||
|
|
||||||
|
else
|
||||||
|
Hashdict.singleton .eventId event
|
||||||
|
|> Hashdict.memberKey event.roomId
|
||||||
|
|> 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)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\hashdict indent ->
|
||||||
|
hashdict
|
||||||
|
|> Json.encode (Hashdict.coder .eventId Event.coder)
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Json.decode <| Hashdict.coder .eventId Event.coder)
|
||||||
|
|> Result.map (Tuple.first >> Hashdict.toList)
|
||||||
|
|> Expect.equal (Ok (Hashdict.toList hashdict))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,499 @@
|
||||||
|
module Test.Tools.Json exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human2 =
|
||||||
|
{ name : String, age : Maybe Int }
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human3 =
|
||||||
|
{ name : String, age : Maybe Int, hobbies : List String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human4 =
|
||||||
|
{ name : String
|
||||||
|
, age : Maybe Int
|
||||||
|
, hobbies : List String
|
||||||
|
, weight : Maybe Float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human5 =
|
||||||
|
{ name : String
|
||||||
|
, age : Maybe Int
|
||||||
|
, hobbies : List String
|
||||||
|
, weight : Maybe Float
|
||||||
|
, height : Float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human6 =
|
||||||
|
{ name : String
|
||||||
|
, age : Maybe Int
|
||||||
|
, hobbies : List String
|
||||||
|
, weight : Maybe Float
|
||||||
|
, height : Float
|
||||||
|
, invitedToParty : Bool
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human7 =
|
||||||
|
{ name : String
|
||||||
|
, age : Maybe Int
|
||||||
|
, hobbies : List String
|
||||||
|
, weight : Maybe Float
|
||||||
|
, height : Float
|
||||||
|
, invitedToParty : Bool
|
||||||
|
, presentGiven : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Human8 =
|
||||||
|
{ name : String
|
||||||
|
, age : Maybe Int
|
||||||
|
, hobbies : List String
|
||||||
|
, weight : Maybe Float
|
||||||
|
, height : Float
|
||||||
|
, invitedToParty : Bool
|
||||||
|
, presentGiven : Maybe String
|
||||||
|
, grid : List (List Int)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias MegaHuman =
|
||||||
|
{ human2 : Human2
|
||||||
|
, human3 : Human3
|
||||||
|
, human4 : Human4
|
||||||
|
, human5 : Human5
|
||||||
|
, human6 : Human6
|
||||||
|
, human7 : Human7
|
||||||
|
, human8 : Human8
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
ageField : Json.Field (Maybe Int) { a | age : Maybe Int }
|
||||||
|
ageField =
|
||||||
|
Json.field.optional.value
|
||||||
|
{ fieldName = "age"
|
||||||
|
, toField = .age
|
||||||
|
, description = []
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
ageFuzzer : Fuzzer (Maybe Int)
|
||||||
|
ageFuzzer =
|
||||||
|
Fuzz.maybe Fuzz.int
|
||||||
|
|
||||||
|
|
||||||
|
gridField : Json.Field (List (List Int)) { a | grid : List (List Int) }
|
||||||
|
gridField =
|
||||||
|
Json.field.optional.withDefault
|
||||||
|
{ fieldName = "grid"
|
||||||
|
, toField = .grid
|
||||||
|
, description = []
|
||||||
|
, coder = Json.list (Json.list Json.int)
|
||||||
|
, default = ( [], [] )
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
gridFuzzer : Fuzzer (List (List Int))
|
||||||
|
gridFuzzer =
|
||||||
|
Fuzz.list (Fuzz.list Fuzz.int)
|
||||||
|
|
||||||
|
|
||||||
|
heightField : Json.Field Float { a | height : Float }
|
||||||
|
heightField =
|
||||||
|
Json.field.required
|
||||||
|
{ fieldName = "height"
|
||||||
|
, toField = .height
|
||||||
|
, description = []
|
||||||
|
, coder = Json.float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
heightFuzzer : Fuzzer Float
|
||||||
|
heightFuzzer =
|
||||||
|
Fuzz.niceFloat
|
||||||
|
|
||||||
|
|
||||||
|
hobbiesField : Json.Field (List String) { a | hobbies : List String }
|
||||||
|
hobbiesField =
|
||||||
|
Json.field.optional.withDefault
|
||||||
|
{ fieldName = "hobbies"
|
||||||
|
, toField = .hobbies
|
||||||
|
, description = []
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
, default = ( [], [] )
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
hobbiesFuzzer : Fuzzer (List String)
|
||||||
|
hobbiesFuzzer =
|
||||||
|
Fuzz.list Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
invitedToPartyField : Json.Field Bool { a | invitedToParty : Bool }
|
||||||
|
invitedToPartyField =
|
||||||
|
Json.field.optional.withDefault
|
||||||
|
{ fieldName = "invitedToParty"
|
||||||
|
, toField = .invitedToParty
|
||||||
|
, description = []
|
||||||
|
, coder = Json.bool
|
||||||
|
, default = ( False, [] )
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
invitedToPartyFuzzer : Fuzzer Bool
|
||||||
|
invitedToPartyFuzzer =
|
||||||
|
Fuzz.bool
|
||||||
|
|
||||||
|
|
||||||
|
nameField : Json.Field String { a | name : String }
|
||||||
|
nameField =
|
||||||
|
Json.field.required
|
||||||
|
{ fieldName = "name"
|
||||||
|
, toField = .name
|
||||||
|
, description = []
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
nameFuzzer : Fuzzer String
|
||||||
|
nameFuzzer =
|
||||||
|
Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
presentGivenField : Json.Field (Maybe String) { a | presentGiven : Maybe String }
|
||||||
|
presentGivenField =
|
||||||
|
Json.field.required
|
||||||
|
{ fieldName = "presentGiven"
|
||||||
|
, toField = .presentGiven
|
||||||
|
, description = []
|
||||||
|
, coder = Json.maybe Json.string
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
presentGivenFuzzer : Fuzzer (Maybe String)
|
||||||
|
presentGivenFuzzer =
|
||||||
|
Fuzz.maybe Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
weightField : Json.Field (Maybe Float) { a | weight : Maybe Float }
|
||||||
|
weightField =
|
||||||
|
Json.field.optional.value
|
||||||
|
{ fieldName = "weight"
|
||||||
|
, toField = .weight
|
||||||
|
, description = []
|
||||||
|
, coder = Json.float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
weightFuzzer : Fuzzer (Maybe Float)
|
||||||
|
weightFuzzer =
|
||||||
|
-- TODO: Maybe make Float not so nice?
|
||||||
|
Fuzz.maybe Fuzz.niceFloat
|
||||||
|
|
||||||
|
|
||||||
|
human2Coder : Json.Coder Human2
|
||||||
|
human2Coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Human2"
|
||||||
|
, description = []
|
||||||
|
, init = Human2
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
|
||||||
|
|
||||||
|
human2Fuzzer : Fuzzer Human2
|
||||||
|
human2Fuzzer =
|
||||||
|
Fuzz.map2 Human2
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
human3Coder : Json.Coder Human3
|
||||||
|
human3Coder =
|
||||||
|
Json.object3
|
||||||
|
{ name = "Human3"
|
||||||
|
, description = []
|
||||||
|
, init = Human3
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
hobbiesField
|
||||||
|
|
||||||
|
|
||||||
|
human3Fuzzer : Fuzzer Human3
|
||||||
|
human3Fuzzer =
|
||||||
|
Fuzz.map3 Human3
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
hobbiesFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
human4Coder : Json.Coder Human4
|
||||||
|
human4Coder =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Human4"
|
||||||
|
, description = []
|
||||||
|
, init = Human4
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
hobbiesField
|
||||||
|
weightField
|
||||||
|
|
||||||
|
|
||||||
|
human4Fuzzer : Fuzzer Human4
|
||||||
|
human4Fuzzer =
|
||||||
|
Fuzz.map4 Human4
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
hobbiesFuzzer
|
||||||
|
weightFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
human5Coder : Json.Coder Human5
|
||||||
|
human5Coder =
|
||||||
|
Json.object5
|
||||||
|
{ name = "Human5"
|
||||||
|
, description = []
|
||||||
|
, init = Human5
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
hobbiesField
|
||||||
|
weightField
|
||||||
|
heightField
|
||||||
|
|
||||||
|
|
||||||
|
human5Fuzzer : Fuzzer Human5
|
||||||
|
human5Fuzzer =
|
||||||
|
Fuzz.map5 Human5
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
hobbiesFuzzer
|
||||||
|
weightFuzzer
|
||||||
|
heightFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
human6Coder : Json.Coder Human6
|
||||||
|
human6Coder =
|
||||||
|
Json.object6
|
||||||
|
{ name = "Human6"
|
||||||
|
, description = []
|
||||||
|
, init = Human6
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
hobbiesField
|
||||||
|
weightField
|
||||||
|
heightField
|
||||||
|
invitedToPartyField
|
||||||
|
|
||||||
|
|
||||||
|
human6Fuzzer : Fuzzer Human6
|
||||||
|
human6Fuzzer =
|
||||||
|
Fuzz.map6 Human6
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
hobbiesFuzzer
|
||||||
|
weightFuzzer
|
||||||
|
heightFuzzer
|
||||||
|
invitedToPartyFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
human7Coder : Json.Coder Human7
|
||||||
|
human7Coder =
|
||||||
|
Json.object7
|
||||||
|
{ name = "Human7"
|
||||||
|
, description = []
|
||||||
|
, init = Human7
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
hobbiesField
|
||||||
|
weightField
|
||||||
|
heightField
|
||||||
|
invitedToPartyField
|
||||||
|
presentGivenField
|
||||||
|
|
||||||
|
|
||||||
|
human7Fuzzer : Fuzzer Human7
|
||||||
|
human7Fuzzer =
|
||||||
|
Fuzz.map7 Human7
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
hobbiesFuzzer
|
||||||
|
weightFuzzer
|
||||||
|
heightFuzzer
|
||||||
|
invitedToPartyFuzzer
|
||||||
|
presentGivenFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
human8Coder : Json.Coder Human8
|
||||||
|
human8Coder =
|
||||||
|
Json.object8
|
||||||
|
{ name = "Human8"
|
||||||
|
, description = []
|
||||||
|
, init = Human8
|
||||||
|
}
|
||||||
|
nameField
|
||||||
|
ageField
|
||||||
|
hobbiesField
|
||||||
|
weightField
|
||||||
|
heightField
|
||||||
|
invitedToPartyField
|
||||||
|
presentGivenField
|
||||||
|
gridField
|
||||||
|
|
||||||
|
|
||||||
|
human8Fuzzer : Fuzzer Human8
|
||||||
|
human8Fuzzer =
|
||||||
|
Fuzz.map8 Human8
|
||||||
|
nameFuzzer
|
||||||
|
ageFuzzer
|
||||||
|
hobbiesFuzzer
|
||||||
|
weightFuzzer
|
||||||
|
heightFuzzer
|
||||||
|
invitedToPartyFuzzer
|
||||||
|
presentGivenFuzzer
|
||||||
|
gridFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
megaHumanCoder : Json.Coder MegaHuman
|
||||||
|
megaHumanCoder =
|
||||||
|
Json.object7
|
||||||
|
{ name = "MegaHuman"
|
||||||
|
, description = []
|
||||||
|
, init = MegaHuman
|
||||||
|
}
|
||||||
|
(Json.field.required { fieldName = "h2", toField = .human2, description = [], coder = human2Coder })
|
||||||
|
(Json.field.required { fieldName = "h3", toField = .human3, description = [], coder = human3Coder })
|
||||||
|
(Json.field.required { fieldName = "h4", toField = .human4, description = [], coder = human4Coder })
|
||||||
|
(Json.field.required { fieldName = "h5", toField = .human5, description = [], coder = human5Coder })
|
||||||
|
(Json.field.required { fieldName = "h6", toField = .human6, description = [], coder = human6Coder })
|
||||||
|
(Json.field.required { fieldName = "h7", toField = .human7, description = [], coder = human7Coder })
|
||||||
|
(Json.field.required { fieldName = "h8", toField = .human8, description = [], coder = human8Coder })
|
||||||
|
|
||||||
|
|
||||||
|
megahumanFuzzer : Fuzzer MegaHuman
|
||||||
|
megahumanFuzzer =
|
||||||
|
Fuzz.map7 MegaHuman
|
||||||
|
human2Fuzzer
|
||||||
|
human3Fuzzer
|
||||||
|
human4Fuzzer
|
||||||
|
human5Fuzzer
|
||||||
|
human6Fuzzer
|
||||||
|
human7Fuzzer
|
||||||
|
human8Fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "JSON module"
|
||||||
|
[ describe "Human2"
|
||||||
|
[ fuzz human2Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human2Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human2Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Human3"
|
||||||
|
[ fuzz human3Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human3Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human3Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Human4"
|
||||||
|
[ fuzz human4Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human4Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human4Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Human5"
|
||||||
|
[ fuzz human5Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human5Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human5Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Human6"
|
||||||
|
[ fuzz human6Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human6Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human6Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Human7"
|
||||||
|
[ fuzz human7Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human7Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human7Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Human8"
|
||||||
|
[ fuzz human8Fuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\human ->
|
||||||
|
human
|
||||||
|
|> Json.encode human8Coder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode human8Coder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok human)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "MegaHuman"
|
||||||
|
[ fuzz megahumanFuzzer
|
||||||
|
"Recoding succeeds"
|
||||||
|
(\megahuman ->
|
||||||
|
megahuman
|
||||||
|
|> Json.encode megaHumanCoder
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode megaHumanCoder)
|
||||||
|
|> Result.map Tuple.first
|
||||||
|
|> Expect.equal (Ok megahuman)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,205 @@
|
||||||
|
module Test.Tools.Mashdict exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Mashdict as Mashdict exposing (Mashdict)
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : (a -> Maybe String) -> Fuzzer a -> Fuzzer (Mashdict a)
|
||||||
|
fuzzer toHash fuz =
|
||||||
|
Fuzz.map (Mashdict.fromList toHash) (Fuzz.list fuz)
|
||||||
|
|
||||||
|
|
||||||
|
eventFuzzer : Fuzzer (Mashdict Event.Event)
|
||||||
|
eventFuzzer =
|
||||||
|
fuzzer .stateKey TestEvent.fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Mashdict"
|
||||||
|
[ describe "empty"
|
||||||
|
[ test "empty isEmpty"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.isEmpty
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Nothing is member"
|
||||||
|
(\event ->
|
||||||
|
Mashdict.empty .stateKey
|
||||||
|
|> Mashdict.member event
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"No key is member"
|
||||||
|
(\key ->
|
||||||
|
Mashdict.empty identity
|
||||||
|
|> Mashdict.memberKey key
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"Get gets Nothing"
|
||||||
|
(\key ->
|
||||||
|
Mashdict.empty identity
|
||||||
|
|> Mashdict.get key
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, test "Size is zero"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.size
|
||||||
|
|> Expect.equal 0
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No keys"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.keys
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "No values"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.values
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "To list is []"
|
||||||
|
(Mashdict.empty identity
|
||||||
|
|> Mashdict.toList
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "From list is empty"
|
||||||
|
([]
|
||||||
|
|> Mashdict.fromList (\x -> x)
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty identity)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Empty + empty == empty"
|
||||||
|
(Mashdict.empty Maybe.Just
|
||||||
|
|> Mashdict.union (Mashdict.empty Maybe.Just)
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty Maybe.Just)
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz (Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\indent ->
|
||||||
|
Mashdict.empty Just
|
||||||
|
|> Json.encode (Mashdict.coder Just Json.string)
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Json.decode <| Mashdict.coder Just Json.string)
|
||||||
|
|> Result.map (Tuple.mapFirst <| Mashdict.isEqual (Mashdict.empty Just))
|
||||||
|
|> Expect.equal (Ok ( True, [] ))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "singleton"
|
||||||
|
[ fuzz TestEvent.fuzzer
|
||||||
|
"singleton = empty + insert"
|
||||||
|
(\event ->
|
||||||
|
Mashdict.empty .stateKey
|
||||||
|
|> Mashdict.insert event
|
||||||
|
|> Mashdict.isEqual (Mashdict.singleton .stateKey event)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"singleton - event = empty"
|
||||||
|
(\event ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.remove event
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty (always Nothing))
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"singleton - event (key) = empty"
|
||||||
|
(\event ->
|
||||||
|
case event.stateKey of
|
||||||
|
Just key ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.removeKey key
|
||||||
|
|> Mashdict.isEqual (Mashdict.empty .stateKey)
|
||||||
|
|> Expect.equal True
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Expect.pass
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"Only isEmpty when not Nothing"
|
||||||
|
(\event ->
|
||||||
|
Expect.equal
|
||||||
|
(case event.stateKey of
|
||||||
|
Just _ ->
|
||||||
|
False
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
True
|
||||||
|
)
|
||||||
|
(event
|
||||||
|
|> Mashdict.singleton .stateKey
|
||||||
|
|> Mashdict.isEmpty
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"member"
|
||||||
|
(\event ->
|
||||||
|
Expect.equal
|
||||||
|
(case event.stateKey of
|
||||||
|
Just _ ->
|
||||||
|
True
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
False
|
||||||
|
)
|
||||||
|
(Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.member event
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, fuzz2 TestEvent.fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"memberKey"
|
||||||
|
(\event rkey ->
|
||||||
|
case event.stateKey of
|
||||||
|
Just key ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.memberKey key
|
||||||
|
|> Expect.equal True
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.memberKey rkey
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"False memberKey"
|
||||||
|
(\event ->
|
||||||
|
if event.stateKey == Just event.roomId then
|
||||||
|
Expect.pass
|
||||||
|
|
||||||
|
else
|
||||||
|
Mashdict.singleton .stateKey event
|
||||||
|
|> Mashdict.memberKey event.roomId
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz2 eventFuzzer
|
||||||
|
(Fuzz.intRange 0 10)
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\hashdict indent ->
|
||||||
|
hashdict
|
||||||
|
|> Json.encode (Mashdict.coder .stateKey Event.coder)
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString (Json.decode <| Mashdict.coder .stateKey Event.coder)
|
||||||
|
|> Result.map (Tuple.first >> Mashdict.toList)
|
||||||
|
|> Expect.equal (Ok (Mashdict.toList hashdict))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,66 @@
|
||||||
|
module Test.Tools.Timestamp exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Timestamp
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map Time.millisToPosix Fuzz.int
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Timestamp"
|
||||||
|
[ describe "JSON"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
Fuzz.int
|
||||||
|
"JSON encode -> JSON decode"
|
||||||
|
(\time indent ->
|
||||||
|
time
|
||||||
|
|> Timestamp.encode
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString Timestamp.decoder
|
||||||
|
|> Expect.equal (Ok ( time, [] ))
|
||||||
|
)
|
||||||
|
, fuzz fuzzer
|
||||||
|
"JSON decode -> millis"
|
||||||
|
(\time ->
|
||||||
|
time
|
||||||
|
|> Timestamp.encode
|
||||||
|
|> D.decodeValue D.int
|
||||||
|
|> Expect.equal (Ok <| Time.posixToMillis time)
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.int
|
||||||
|
"JSON decode -> time"
|
||||||
|
(\n ->
|
||||||
|
n
|
||||||
|
|> E.int
|
||||||
|
|> D.decodeValue Timestamp.decoder
|
||||||
|
|> Expect.equal (Ok ( Time.millisToPosix n, [] ))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Identity"
|
||||||
|
[ fuzz fuzzer
|
||||||
|
"Posix -> int -> Posix"
|
||||||
|
(\time ->
|
||||||
|
time
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Time.millisToPosix
|
||||||
|
|> Expect.equal time
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.int
|
||||||
|
"int -> Posix -> int"
|
||||||
|
(\n ->
|
||||||
|
n
|
||||||
|
|> Time.millisToPosix
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Expect.equal n
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,17 @@
|
||||||
|
module Test.Types exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Test.Values.Envelope as TestEnvelope
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
import Test.Values.Vault as TestVault
|
||||||
|
import Types exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
event : Fuzzer Event
|
||||||
|
event =
|
||||||
|
Fuzz.map Event (TestEnvelope.fuzzer TestEvent.fuzzer)
|
||||||
|
|
||||||
|
|
||||||
|
vault : Fuzzer Vault
|
||||||
|
vault =
|
||||||
|
Fuzz.map Vault (TestEnvelope.fuzzer TestVault.vault)
|
|
@ -0,0 +1,162 @@
|
||||||
|
module Test.Values.Context exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Config.Leaks as Leaks
|
||||||
|
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
|
||||||
|
fuzzer =
|
||||||
|
let
|
||||||
|
maybeString : Fuzzer (Maybe String)
|
||||||
|
maybeString =
|
||||||
|
Fuzz.maybe Fuzz.string
|
||||||
|
in
|
||||||
|
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 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
|
||||||
|
with the same seed to ensure it is not a (tiny) coincidence and a leak is in
|
||||||
|
fact coming through.
|
||||||
|
-}
|
||||||
|
leaks : Test
|
||||||
|
leaks =
|
||||||
|
describe "No leaks allowed"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"Access token"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setAccessToken value
|
||||||
|
|> Context.getAccessToken
|
||||||
|
|> Expect.notEqual Leaks.accessToken
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"Base URL"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setBaseUrl value
|
||||||
|
|> Context.getBaseUrl
|
||||||
|
|> Expect.notEqual Leaks.baseUrl
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"Transaction"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setTransaction value
|
||||||
|
|> Context.getTransaction
|
||||||
|
|> Expect.notEqual Leaks.transaction
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
versionsFuzzer
|
||||||
|
"Versions"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setVersions value
|
||||||
|
|> Context.getVersions
|
||||||
|
|> Expect.notEqual Leaks.versions
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
apiContext : Test
|
||||||
|
apiContext =
|
||||||
|
describe "Verify writing info"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"Access token"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setAccessToken value
|
||||||
|
|> Context.getAccessToken
|
||||||
|
|> Expect.equal value
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"Base URL"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setBaseUrl value
|
||||||
|
|> Context.getBaseUrl
|
||||||
|
|> Expect.equal value
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
"Transaction"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setTransaction value
|
||||||
|
|> Context.getTransaction
|
||||||
|
|> Expect.equal value
|
||||||
|
)
|
||||||
|
, fuzz2 fuzzer
|
||||||
|
versionsFuzzer
|
||||||
|
"Versions"
|
||||||
|
(\context value ->
|
||||||
|
context
|
||||||
|
|> Context.apiFormat
|
||||||
|
|> Context.setVersions value
|
||||||
|
|> Context.getVersions
|
||||||
|
|> Expect.equal value
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- json : Test
|
||||||
|
-- json =
|
||||||
|
-- describe "JSON encode + JSON decode"
|
||||||
|
-- [ fuzz fuzzer
|
||||||
|
-- "JSON recode"
|
||||||
|
-- (\context ->
|
||||||
|
-- context
|
||||||
|
-- |> Context.encode
|
||||||
|
-- |> D.decodeValue Context.decoder
|
||||||
|
-- |> Expect.equal (Ok ( context, [] ))
|
||||||
|
-- )
|
||||||
|
-- ]
|
|
@ -0,0 +1,64 @@
|
||||||
|
module Test.Values.Envelope exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Config.Default as Default
|
||||||
|
import Internal.Values.Envelope as Envelope exposing (Envelope)
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Context as TestContext
|
||||||
|
import Test.Values.Settings as TestSettings
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer a -> Fuzzer (Envelope a)
|
||||||
|
fuzzer fuz =
|
||||||
|
Fuzz.map3 Envelope
|
||||||
|
fuz
|
||||||
|
TestContext.fuzzer
|
||||||
|
TestSettings.fuzzer
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Envelope value"
|
||||||
|
[ describe "init"
|
||||||
|
[ describe "Default settings"
|
||||||
|
[ fuzz Fuzz.string
|
||||||
|
"currentVersion"
|
||||||
|
(\s ->
|
||||||
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|
|> Envelope.init
|
||||||
|
|> Envelope.extractSettings .currentVersion
|
||||||
|
|> Expect.equal Default.currentVersion
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"deviceName"
|
||||||
|
(\s ->
|
||||||
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|
|> Envelope.init
|
||||||
|
|> Envelope.extractSettings .deviceName
|
||||||
|
|> Expect.equal Default.deviceName
|
||||||
|
)
|
||||||
|
, fuzz Fuzz.string
|
||||||
|
"syncTime"
|
||||||
|
(\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, [] ))
|
||||||
|
-- )
|
||||||
|
-- ]
|
||||||
|
]
|
|
@ -0,0 +1,83 @@
|
||||||
|
module Test.Values.Event exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Grammar.UserId as UserId
|
||||||
|
import Test.Tools.Timestamp as TestTimestamp
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Event
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map8 Event
|
||||||
|
valueFuzzer
|
||||||
|
Fuzz.string
|
||||||
|
TestTimestamp.fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
UserId.fullUserFuzzer
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.maybe unsignedDataFuzzer)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Fuzzer for an event with a set state key
|
||||||
|
-}
|
||||||
|
fuzzerState : Fuzzer Event
|
||||||
|
fuzzerState =
|
||||||
|
Fuzz.map2
|
||||||
|
(\event default ->
|
||||||
|
{ event
|
||||||
|
| stateKey =
|
||||||
|
event.stateKey
|
||||||
|
|> Maybe.withDefault default
|
||||||
|
|> Maybe.Just
|
||||||
|
}
|
||||||
|
)
|
||||||
|
fuzzer
|
||||||
|
Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
unsignedDataFuzzer : Fuzzer Event.UnsignedData
|
||||||
|
unsignedDataFuzzer =
|
||||||
|
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)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Example values that can be used for arbitrary JSON values
|
||||||
|
-}
|
||||||
|
valueFuzzer : Fuzzer E.Value
|
||||||
|
valueFuzzer =
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ Fuzz.map E.int Fuzz.int
|
||||||
|
, Fuzz.map E.string Fuzz.string
|
||||||
|
, Fuzz.map (E.list E.int) (Fuzz.list Fuzz.int)
|
||||||
|
, Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string)
|
||||||
|
, Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer))
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Sanity check"
|
||||||
|
[ fuzz fuzzer
|
||||||
|
"event = event"
|
||||||
|
(\event ->
|
||||||
|
Event.isEqual event event
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
]
|
|
@ -0,0 +1,105 @@
|
||||||
|
module Test.Values.Room exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Values.Room as Room exposing (Room)
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
placeholderValue : E.Value
|
||||||
|
placeholderValue =
|
||||||
|
E.string "foo bar baz"
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Room
|
||||||
|
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 : Fuzzer a -> (a -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
|
||||||
|
addAFewTimes fuzz f roomFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\items room -> List.foldl f room items)
|
||||||
|
(Fuzz.list fuzz)
|
||||||
|
roomFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
add2AFewTimes : Fuzzer a -> Fuzzer b -> (a -> b -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
|
||||||
|
add2AFewTimes fuzz1 fuzz2 f roomFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\items room -> List.foldl (\( a, b ) -> f a b) room items)
|
||||||
|
(Fuzz.list <| Fuzz.pair fuzz1 fuzz2)
|
||||||
|
roomFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
add3AFewTimes : Fuzzer a -> Fuzzer b -> Fuzzer c -> (a -> b -> c -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
|
||||||
|
add3AFewTimes fuzz1 fuzz2 fuzz3 f roomFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\items room -> List.foldl (\( a, b, c ) -> f a b c) room items)
|
||||||
|
(Fuzz.list <| Fuzz.triple fuzz1 fuzz2 fuzz3)
|
||||||
|
roomFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
add4AFewTimes : Fuzzer a -> Fuzzer b -> Fuzzer c -> Fuzzer d -> (a -> b -> c -> d -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
|
||||||
|
add4AFewTimes fuzz1 fuzz2 fuzz3 fuzz4 f roomFuzzer =
|
||||||
|
Fuzz.map2
|
||||||
|
(\items room -> List.foldl (\( ( a, b ), ( c, d ) ) -> f a b c d) room items)
|
||||||
|
(Fuzz.list <| Fuzz.pair (Fuzz.pair fuzz1 fuzz2) (Fuzz.pair fuzz3 fuzz4))
|
||||||
|
roomFuzzer
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- suite : Test
|
||||||
|
-- suite =
|
||||||
|
-- describe "Room"
|
||||||
|
-- [ fuzz3 fuzzer
|
||||||
|
-- Fuzz.string
|
||||||
|
-- Fuzz.string
|
||||||
|
-- "JSON Account Data can be overridden"
|
||||||
|
-- (\room key text ->
|
||||||
|
-- room
|
||||||
|
-- |> Room.setAccountData key (E.string text)
|
||||||
|
-- |> Room.getAccountData key
|
||||||
|
-- |> Maybe.map (D.decodeValue D.string)
|
||||||
|
-- |> Maybe.andThen Result.toMaybe
|
||||||
|
-- |> Expect.equal (Just text)
|
||||||
|
-- )
|
||||||
|
-- , fuzz fuzzer
|
||||||
|
-- "Room -> JSON -> Room is equal"
|
||||||
|
-- (\room ->
|
||||||
|
-- let
|
||||||
|
-- value : E.Value
|
||||||
|
-- value =
|
||||||
|
-- Room.encode room
|
||||||
|
-- in
|
||||||
|
-- value
|
||||||
|
-- |> D.decodeValue Room.decode
|
||||||
|
-- |> Result.toMaybe
|
||||||
|
-- |> Maybe.map Tuple.first
|
||||||
|
-- |> Maybe.map Room.encode
|
||||||
|
-- |> Maybe.map (E.encode 0)
|
||||||
|
-- |> Expect.equal (Just <| E.encode 0 value)
|
||||||
|
-- )
|
||||||
|
-- ]
|
|
@ -0,0 +1,92 @@
|
||||||
|
module Test.Values.Settings exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Config.Default as Default
|
||||||
|
import Internal.Values.Settings as Settings exposing (Settings)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Settings
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.map5 Settings
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.currentVersion
|
||||||
|
, Fuzz.string
|
||||||
|
]
|
||||||
|
)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.deviceName
|
||||||
|
, Fuzz.string
|
||||||
|
]
|
||||||
|
)
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.removePasswordOnLogin
|
||||||
|
, Fuzz.bool
|
||||||
|
]
|
||||||
|
)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.syncTime
|
||||||
|
, Fuzz.int
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Settings"
|
||||||
|
[ describe "init"
|
||||||
|
[ test "Current version"
|
||||||
|
(Settings.init
|
||||||
|
|> .currentVersion
|
||||||
|
|> Expect.equal Default.currentVersion
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Device name"
|
||||||
|
(Settings.init
|
||||||
|
|> .deviceName
|
||||||
|
|> Expect.equal Default.deviceName
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Remove password on login"
|
||||||
|
(Settings.init
|
||||||
|
|> .removePasswordOnLogin
|
||||||
|
|> Expect.equal Default.removePasswordOnLogin
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Sync time"
|
||||||
|
(Settings.init
|
||||||
|
|> .syncTime
|
||||||
|
|> Expect.equal Default.syncTime
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "JSON encode init is {}"
|
||||||
|
(Settings.init
|
||||||
|
|> Settings.encode
|
||||||
|
|> E.encode 0
|
||||||
|
|> Expect.equal "{}"
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "JSON decode {} is init"
|
||||||
|
("{}"
|
||||||
|
|> D.decodeString Settings.decoder
|
||||||
|
|> Expect.equal (Ok ( Settings.init, [] ))
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz2 fuzzer
|
||||||
|
Fuzz.int
|
||||||
|
"JSON encode -> JSON decode -> identical"
|
||||||
|
(\settings indent ->
|
||||||
|
settings
|
||||||
|
|> Settings.encode
|
||||||
|
|> E.encode indent
|
||||||
|
|> D.decodeString Settings.decoder
|
||||||
|
|> Expect.equal (Ok ( settings, [] ))
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -0,0 +1,138 @@
|
||||||
|
module Test.Values.StateManager exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Test exposing (..)
|
||||||
|
import Test.Values.Event as TestEvent
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer StateManager
|
||||||
|
fuzzer =
|
||||||
|
TestEvent.fuzzer
|
||||||
|
|> Fuzz.list
|
||||||
|
|> Fuzz.map StateManager.fromList
|
||||||
|
|
||||||
|
|
||||||
|
fuzzerKey : Fuzzer { eventType : String, stateKey : String }
|
||||||
|
fuzzerKey =
|
||||||
|
Fuzz.map2
|
||||||
|
(\a b -> { eventType = a, stateKey = b })
|
||||||
|
Fuzz.string
|
||||||
|
Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "StateManager"
|
||||||
|
[ describe "empty"
|
||||||
|
[ test "empty isEmpty"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.isEmpty
|
||||||
|
|> Expect.equal True
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzer
|
||||||
|
"empty has no member"
|
||||||
|
(\event ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.member event
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz fuzzerKey
|
||||||
|
"empty has no memberKey"
|
||||||
|
(\key ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.memberKey key
|
||||||
|
|> Expect.equal False
|
||||||
|
)
|
||||||
|
, fuzz fuzzerKey
|
||||||
|
"Empty gets Nothing"
|
||||||
|
(\key ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.get key
|
||||||
|
|> Expect.equal Nothing
|
||||||
|
)
|
||||||
|
, test "Empty has no keys"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.keys
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "Empty has no values"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.values
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "toList empty equals []"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.toList
|
||||||
|
|> Expect.equal []
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "fromList [] equals empty"
|
||||||
|
([]
|
||||||
|
|> StateManager.fromList
|
||||||
|
|> Expect.equal StateManager.empty
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
, test "JSON encode -> JSON decode remains empty"
|
||||||
|
(StateManager.empty
|
||||||
|
|> StateManager.encode
|
||||||
|
|> E.encode 0
|
||||||
|
|> D.decodeString StateManager.decoder
|
||||||
|
|> Expect.equal (Ok ( StateManager.empty, [] ))
|
||||||
|
|> always
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "singleton"
|
||||||
|
[ fuzz TestEvent.fuzzerState
|
||||||
|
"singleton = empty + event"
|
||||||
|
(\event ->
|
||||||
|
StateManager.empty
|
||||||
|
|> StateManager.insert event
|
||||||
|
|> StateManager.isEqual (StateManager.singleton event)
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzerState
|
||||||
|
"singleton - event = empty"
|
||||||
|
(\event ->
|
||||||
|
StateManager.singleton event
|
||||||
|
|> StateManager.remove event
|
||||||
|
|> StateManager.isEqual StateManager.empty
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
, fuzz TestEvent.fuzzerState
|
||||||
|
"singleton has one member"
|
||||||
|
(\event ->
|
||||||
|
StateManager.singleton event
|
||||||
|
|> StateManager.member event
|
||||||
|
|> Expect.equal True
|
||||||
|
)
|
||||||
|
|
||||||
|
-- , fuzz2 TestEvent.fuzzerState TestEvent.fuzzerState
|
||||||
|
-- "singleton has no other members"
|
||||||
|
-- (\e1 e2 ->
|
||||||
|
-- if (Debug.log "To compare" e1) == e2 then
|
||||||
|
-- Expect.pass
|
||||||
|
-- else
|
||||||
|
-- ()
|
||||||
|
-- |> Debug.log "Not equal"
|
||||||
|
-- |> always (StateManager.singleton e1)
|
||||||
|
-- |> StateManager.member e2
|
||||||
|
-- |> Expect.equal False
|
||||||
|
-- )
|
||||||
|
, fuzz TestEvent.fuzzerState
|
||||||
|
"singleton has one value"
|
||||||
|
(\event ->
|
||||||
|
StateManager.singleton event
|
||||||
|
|> StateManager.values
|
||||||
|
|> Expect.equal [ event ]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
-- Write other tests here
|
||||||
|
]
|
|
@ -0,0 +1,385 @@
|
||||||
|
module Test.Values.Timeline exposing (..)
|
||||||
|
|
||||||
|
import Expect
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer Timeline
|
||||||
|
fuzzer =
|
||||||
|
TestFilter.fuzzer
|
||||||
|
|> Fuzz.andThen
|
||||||
|
(\globalFilter ->
|
||||||
|
Fuzz.oneOf
|
||||||
|
[ Fuzz.map2
|
||||||
|
(\start batches ->
|
||||||
|
List.foldl
|
||||||
|
(\b ( s, f ) ->
|
||||||
|
( b.end
|
||||||
|
, f >> Timeline.insert { b | start = Just s, filter = globalFilter }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
( start, identity )
|
||||||
|
batches
|
||||||
|
|> Tuple.second
|
||||||
|
)
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.listOfLengthBetween 0 10 fuzzerBatch)
|
||||||
|
, Fuzz.map2
|
||||||
|
(\start batches ->
|
||||||
|
List.foldl
|
||||||
|
(\b ( s, f ) ->
|
||||||
|
( b.end
|
||||||
|
, f >> Timeline.insert { b | start = Just s, filter = Filter.and globalFilter b.filter }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
( start, identity )
|
||||||
|
batches
|
||||||
|
|> Tuple.second
|
||||||
|
)
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.listOfLengthBetween 0 4 fuzzerBatch)
|
||||||
|
, Fuzz.map2
|
||||||
|
(\start batches ->
|
||||||
|
List.foldl
|
||||||
|
(\b ( s, f ) ->
|
||||||
|
( b.end
|
||||||
|
, f >> Timeline.addSync { b | start = Just s, filter = globalFilter }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
( start, identity )
|
||||||
|
batches
|
||||||
|
|> Tuple.second
|
||||||
|
)
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.listOfLengthBetween 0 10 fuzzerBatch)
|
||||||
|
, Fuzz.map2
|
||||||
|
(\start batches ->
|
||||||
|
List.foldl
|
||||||
|
(\b ( s, f ) ->
|
||||||
|
( b.end
|
||||||
|
, f >> Timeline.addSync { b | start = Just s, filter = Filter.and globalFilter b.filter }
|
||||||
|
)
|
||||||
|
)
|
||||||
|
( start, identity )
|
||||||
|
batches
|
||||||
|
|> Tuple.second
|
||||||
|
)
|
||||||
|
Fuzz.string
|
||||||
|
(Fuzz.listOfLengthBetween 0 4 fuzzerBatch)
|
||||||
|
]
|
||||||
|
|> Fuzz.listOfLengthBetween 0 10
|
||||||
|
|> Fuzz.map (List.foldl (<|) Timeline.empty)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
fuzzerBatch : Fuzzer Batch
|
||||||
|
fuzzerBatch =
|
||||||
|
Fuzz.map4 Batch
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
TestFilter.fuzzer
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
Fuzz.string
|
||||||
|
|
||||||
|
|
||||||
|
suite : Test
|
||||||
|
suite =
|
||||||
|
describe "Timeline"
|
||||||
|
[ describe "most recent events with filters"
|
||||||
|
[ fuzz TestFilter.fuzzer
|
||||||
|
"Events are returned properly"
|
||||||
|
(\filter ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom filter "token_3"
|
||||||
|
|> Expect.equal
|
||||||
|
[ [ "a", "b", "c", "d", "e", "f" ] ]
|
||||||
|
)
|
||||||
|
, fuzz2 TestFilter.fuzzer
|
||||||
|
TestFilter.fuzzer
|
||||||
|
"Sub-events get the same results"
|
||||||
|
(\f1 f2 ->
|
||||||
|
let
|
||||||
|
subFilter =
|
||||||
|
Filter.and f1 f2
|
||||||
|
in
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = f1
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = f1
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom subFilter "token_3"
|
||||||
|
|> Expect.equal
|
||||||
|
[ [ "a", "b", "c", "d", "e", "f" ] ]
|
||||||
|
)
|
||||||
|
, fuzz2 TestFilter.fuzzer
|
||||||
|
TestFilter.fuzzer
|
||||||
|
"ONLY same result if sub-filter"
|
||||||
|
(\f1 f2 ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = f1
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = f1
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom f2 "token_3"
|
||||||
|
|> (\events ->
|
||||||
|
Expect.equal
|
||||||
|
(Filter.subsetOf f1 f2)
|
||||||
|
(events == [ [ "a", "b", "c", "d", "e", "f" ] ])
|
||||||
|
)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Forks in the road"
|
||||||
|
[ fuzz2 TestFilter.fuzzer
|
||||||
|
TestFilter.fuzzer
|
||||||
|
"Two options returned"
|
||||||
|
(\f1 f2 ->
|
||||||
|
let
|
||||||
|
subFilter =
|
||||||
|
Filter.and f1 f2
|
||||||
|
in
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = f1
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = f2
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "g", "h", "i" ]
|
||||||
|
, filter = subFilter
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_4"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom subFilter "token_4"
|
||||||
|
|> Expect.equal
|
||||||
|
[ [ "a", "b", "c", "g", "h", "i" ]
|
||||||
|
, [ "d", "e", "f", "g", "h", "i" ]
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Gaps"
|
||||||
|
[ fuzz TestFilter.fuzzer
|
||||||
|
"Gaps leave behind old events"
|
||||||
|
(\filter ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_4"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom filter "token_4"
|
||||||
|
|> Expect.equal [ [ "d", "e", "f" ] ]
|
||||||
|
)
|
||||||
|
, fuzz3 TestFilter.fuzzer
|
||||||
|
(Fuzz.list Fuzz.string)
|
||||||
|
(Fuzz.pair (Fuzz.list Fuzz.string) (Fuzz.list Fuzz.string))
|
||||||
|
"Gaps can be bridged"
|
||||||
|
(\filter l1 ( l2, l3 ) ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = l1
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = l3
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_4"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = l2
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom filter "token_4"
|
||||||
|
|> Expect.equal [ List.concat [ l1, l2, l3 ] ]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "JSON"
|
||||||
|
[ fuzz fuzzer
|
||||||
|
"Encode + Decode gives same output"
|
||||||
|
(\timeline ->
|
||||||
|
timeline
|
||||||
|
|> Json.encode 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)
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Weird loops"
|
||||||
|
[ fuzz TestFilter.fuzzer
|
||||||
|
"Weird loops stop looping"
|
||||||
|
(\filter ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "g", "h", "i" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom filter "token_2"
|
||||||
|
|> Expect.equal
|
||||||
|
[ [ "a", "b", "c" ]
|
||||||
|
, [ "d", "e", "f", "g", "h", "i" ]
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
, describe "Sync"
|
||||||
|
[ fuzz TestFilter.fuzzer
|
||||||
|
"Sync fills gaps"
|
||||||
|
(\filter ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.addSync
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.addSync
|
||||||
|
{ events = [ "f", "g", "h" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_4"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEvents filter
|
||||||
|
|> Expect.equal [ [ "a", "b", "c", "d", "e", "f", "g", "h" ] ]
|
||||||
|
)
|
||||||
|
, fuzz TestFilter.fuzzer
|
||||||
|
"Sync doesn't fill open gaps"
|
||||||
|
(\filter ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.addSync
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.addSync
|
||||||
|
{ events = [ "f", "g", "h" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_4"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEvents filter
|
||||||
|
|> Expect.equal [ [ "f", "g", "h" ] ]
|
||||||
|
)
|
||||||
|
, fuzz3 (Fuzz.pair Fuzz.string Fuzz.string)
|
||||||
|
fuzzer
|
||||||
|
TestFilter.fuzzer
|
||||||
|
"Getting /sync is the same as getting from the token"
|
||||||
|
(\( start, end ) timeline filter ->
|
||||||
|
let
|
||||||
|
t : Timeline
|
||||||
|
t =
|
||||||
|
Timeline.addSync
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just start
|
||||||
|
, end = end
|
||||||
|
}
|
||||||
|
timeline
|
||||||
|
in
|
||||||
|
Expect.equal
|
||||||
|
(Timeline.mostRecentEvents filter t)
|
||||||
|
(Timeline.mostRecentEventsFrom filter end t)
|
||||||
|
)
|
||||||
|
, fuzz TestFilter.fuzzer
|
||||||
|
"Weird loops stop looping"
|
||||||
|
(\filter ->
|
||||||
|
Timeline.empty
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "a", "b", "c" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_1"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "d", "e", "f" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_2"
|
||||||
|
, end = "token_3"
|
||||||
|
}
|
||||||
|
|> Timeline.insert
|
||||||
|
{ events = [ "g", "h", "i" ]
|
||||||
|
, filter = filter
|
||||||
|
, start = Just "token_3"
|
||||||
|
, end = "token_2"
|
||||||
|
}
|
||||||
|
|> Timeline.mostRecentEventsFrom filter "token_2"
|
||||||
|
|> Expect.equal
|
||||||
|
[ [ "a", "b", "c" ]
|
||||||
|
, [ "d", "e", "f", "g", "h", "i" ]
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
]
|
|
@ -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 }
|
||||||
|
}
|
|
@ -0,0 +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.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)
|
Loading…
Reference in New Issue