Compare commits

...

260 Commits
1.0.0 ... main

Author SHA1 Message Date
BramvdnHeuvel 1701904144
Publish beta 3.5.0
Merge pull request #38 from noordstar/develop
2024-07-26 09:38:59 +02:00
Bram e42ff71809 Prepare develop for master
elm-test --fuzz 1000 --seed 105375026504828
2024-07-26 09:34:06 +02:00
Bram c6d388bff6 Remove invalid function from documentation 2024-07-26 09:25:03 +02:00
BramvdnHeuvel a336c8b057
Merge pull request #37 from noordstar/4-transfer-api
Add lots of API features
2024-07-26 09:21:40 +02:00
Bram 8d28fe63b9 Fix bugs 2024-07-25 19:15:30 +02:00
Bram a8d879afbb elm-format 2024-07-24 14:05:49 +02:00
Bram 61a8e18714 Add kick + invite + ban user to Matrix.Room 2024-07-24 14:03:12 +02:00
Bram a2582f36f9 Add invite function 2024-07-22 12:58:52 +02:00
Bram 41bee45693 Add global account data functions 2024-07-21 10:38:34 +02:00
Bram 3566d3ee7a Solve elm test bugs from moving user 2024-07-19 09:02:01 +02:00
Bram 8b2db7bff6 Add setAccountData to Matrix rooms 2024-07-19 09:01:42 +02:00
Bram 5319f47145 Move user from Vault to Envelop Context 2024-07-19 08:51:19 +02:00
Bram 87ebcbcd21 Add sendStateEvent to Room API 2024-07-17 14:13:13 +02:00
Bram 0521ca2f3e Add sendMessageEvent to Room API 2024-07-16 12:41:09 +02:00
Bram fee68f7e0f Merge branch 'develop' into 4-transfer-api 2024-07-16 12:34:11 +02:00
Bram 7b615c6452 Merge branch '4-transfer-api' of github.com:noordstar/elm-matrix-sdk-beta into 4-transfer-api 2024-07-16 12:33:37 +02:00
BramvdnHeuvel 07c34c3530
Publish beta 3.4.0
Merge pull request #34 from noordstar/develop
2024-07-16 12:12:10 +02:00
Bram 1ed9fa7d22 Prepare develop for master
elm-test --fuzz 1000 --seed 156536263253947
2024-07-16 12:06:35 +02:00
Bram cacb876a95 Fix test errors
elm-test --fuzz 1000 --seed 156536263253947
2024-07-16 12:05:23 +02:00
Bram 20504d4a8b Remove test issues & warnings 2024-07-16 10:20:38 +02:00
Bram a401c25a47 Remove issues & warnings 2024-07-16 10:10:42 +02:00
Bram f3799add87 HOTFIX: Fix syntax error 2024-07-15 16:13:11 +02:00
BramvdnHeuvel eb8d90ab8b
Enable safe recursion in VaultUpdate type
Merge pull request #33 from noordstar/safe-recursion
2024-07-15 16:08:34 +02:00
Bram 1736679e0f elm-format 2024-07-15 16:07:28 +02:00
Bram 31817ed545 Merge develop into safe-recursion 2024-07-15 16:07:08 +02:00
BramvdnHeuvel 899088d63c
Add room navigation functions to exposed library
Merge pull request #32 from noordstar/4-lib-improvement
2024-07-15 16:01:52 +02:00
Bram 48e5eae327 Merge develop into 4-lib-improvement 2024-07-15 16:00:38 +02:00
Bram 90eb06f3a1 elm-format 2024-07-15 15:57:08 +02:00
BramvdnHeuvel a9e4a39e7f
Add /sync endpoint to Elm SDK
Merge pull request #31 from noordstar/4-transfer-api
2024-07-15 15:51:24 +02:00
Bram d7a7fa385c Enable safe recursion in VaultUpdate type 2024-07-15 15:50:32 +02:00
Bram c7204c4c41 Remove Debug.log from API definition 2024-07-13 13:39:33 +02:00
BramvdnHeuvel c473d60161
Merge branch 'develop' into 4-transfer-api 2024-07-13 09:58:40 +02:00
BramvdnHeuvel 41ec76822f
Add logs function to Matrix
Merge pull request #27 from noordstar/4-log-reader
2024-07-13 09:57:18 +02:00
Bram 458ea59425 Add ways to navigate through rooms 2024-07-13 09:50:39 +02:00
Bram 1eb07377fd Fix StrippedEvent JSON coder 2024-07-13 09:39:14 +02:00
Bram 39f8021a8f Fix spec misconception
Apparently, the  field is also meant for other reasons than the cputime         unlimited
filesize        unlimited
datasize        unlimited
stacksize       8MB
coredumpsize    unlimited
resident        unlimited
maxproc         62741
descriptors     524288
memorylocked    8MB
addressspace    unlimited
maxfilelocks    unlimited
sigpending      62741
msgqueue        819200
nice            0
rt_priority     0
rt_time         unlimited field on the filter, despite the description suggesting otherwise.
2024-07-13 09:38:57 +02:00
Bram 1aecb1116a Merge updated develop into branch
I accidentally forgot to pull the branch, but now the conflict has been resolved.
2024-07-09 18:39:24 +02:00
Bram 8a3b7efbf6 Merge branch 'develop' into 4-transfer-api 2024-07-09 17:53:47 +02:00
Bram 005e103389 Expose sync function 2024-07-09 17:50:48 +02:00
Bram 4e378a5f50 Add /sync as task 2024-07-09 17:33:41 +02:00
Bram 0978e43fc0 Finish /sync API definition 2024-07-09 16:55:19 +02:00
Bram 632158f309 Add toUpdate function for sync V4 2024-07-09 16:48:53 +02:00
Bram c5d07f0a94 Add toUpdate function for sync V1 - V3 2024-07-09 13:29:45 +02:00
Bram b239eecc6b Add toUpdate function for /sync v1 2024-07-09 00:08:46 +02:00
Bram e7d3a129b1 Finish /sync for all spec versions v1.1 to v1.11 2024-07-08 23:07:50 +02:00
Bram e122a7b262 Rename /sync v4 to v3 2024-07-08 22:11:04 +02:00
Bram 29906ff976 Remove redundant /sync versions 2024-07-08 22:10:29 +02:00
Bram 80bb05fd30 Add /sync from v1.1 to v1.5 2024-07-08 20:08:32 +02:00
Bram 1d0a9de7da Automate defaultToString behaviour 2024-07-08 18:24:41 +02:00
noordstar a95fbbb856
Merge pull request #30 from noordstar/patch-iddict
Move Iddict to noordstar/elm-iddict
2024-07-02 10:24:54 +02:00
Bram 95f0aa2934 Remove deprecated spec version
To improve backwards compatibility, we'll start with v1.1 and go from there. Then, if the spec versions seem fit, we can work backwards.
2024-06-13 22:43:25 +02:00
Bram 7ab21b4314 Add /sync at r0.4.0 (partially) 2024-06-13 22:42:36 +02:00
Bram 0092f96a25 Add /sync at r0.3.0 2024-06-13 22:27:12 +02:00
Bram 6300d15edf Move Iddict to noordstar/elm-iddict 2024-06-13 19:47:39 +02:00
BramvdnHeuvel 17a1d1af3e
Publish beta 3.3.1
Merge pull request #29 from noordstar/develop
2024-06-10 10:10:41 +02:00
Bram van den Heuvel 61dad6c5e8 Add Matrix Room to README 2024-06-10 10:07:44 +02:00
Bram 693124aa15 Add documentation for StrippedEvent 2024-06-08 15:32:17 +02:00
Bram 6783186c18 Add nextBatch value in Vault 2024-06-08 15:25:49 +02:00
Bram 0ded7ab6bd Add ephemeral events to Room 2024-06-08 15:19:55 +02:00
Bram f6a6bb535e Add StrippedEvent module 2024-06-08 15:10:58 +02:00
Bram 76cc6d46b9 Prepare develop for master
No elm-test for this patch update. The update does not concern written Elm tests, and it has been tested on the Elm SDK demo code
2024-06-05 17:41:11 +02:00
BramvdnHeuvel 425d964af5
Merge pull request #28 from noordstar/patch-no-baseurl-found
Default to original server name if no well-known found
2024-06-05 12:16:53 +02:00
Bram 21ae0ea376 Default to original server name if no well-known found 2024-06-04 15:50:08 +02:00
Bram 7b00a46ffa Add object1 2024-06-03 15:02:35 +02:00
Bram f714438dd4 Add logs function for better runtime documentation 2024-06-03 11:05:06 +02:00
Bram a514497406 Improve documentation of sendMessageEvent 2024-06-03 11:04:34 +02:00
BramvdnHeuvel 306d8e2f93
Publish beta 3.3.0
Merge pull request #26 from noordstar/develop
2024-05-30 23:19:38 +02:00
Bram f7837a91c8 Prepare develop for master
elm-test --fuzz 1000 --seed 373594127264638
2024-05-30 23:15:40 +02:00
Bram d360c561f9 Hide custom Elm configurations 2024-05-30 16:46:44 +02:00
BramvdnHeuvel acd4a07d5e
Merge pull request #25 from noordstar/4-transfer-api
Add password
2024-05-30 14:07:52 +02:00
Bram 1de9566e1d SECURITY: Remove Elm output
Yes, this index.html file contains credentials. For this reason, the password has been reset and the software should no longer work.
2024-05-30 14:02:20 +02:00
Bram 85d767414d Make username optional 2024-05-30 13:54:30 +02:00
Bram 994c99af15 Add RemovePasswordOnLogin feature 2024-05-30 13:53:56 +02:00
Bram b465ad1f47 Remove password after login, if necessary 2024-05-30 10:52:48 +02:00
Bram e8c0df004e Add removePasswordOnLogin setting 2024-05-30 10:48:20 +02:00
BramvdnHeuvel c5e546b25c
Merge pull request #24 from noordstar/4-transfer-api
Add MVP for API interaction
2024-05-30 10:20:48 +02:00
Bram bec1ae4a3b Fix merge conflict bug 2024-05-28 18:29:26 +02:00
BramvdnHeuvel daf4bcb1b1
Merge branch 'develop' into 4-transfer-api 2024-05-28 18:25:16 +02:00
Bram b0026617cf Add JSON fields to Text module 2024-05-28 18:20:01 +02:00
Bram 7fcef60ec6 Move logs to Text module 2024-05-28 16:46:33 +02:00
Bram 2b9370f0c2 Fix bugs for MVP
This version now officially works. I have tested it and I will publish an example soon.
2024-05-28 10:32:17 +02:00
Bram 12c919b071 Finish addAccessToken function 2024-05-27 23:47:37 +02:00
Bram 567ac5596a Merge branch '4-compiler-bug' into 4-transfer-api 2024-05-27 16:44:57 +02:00
Bram b32e0ef123 Fix test errors 2024-05-27 16:39:50 +02:00
Bram 9e761db4f9 Fix (most) warnings 2024-05-26 19:24:31 +02:00
Bram e335c150f0 Fix compiler bugs 2024-05-26 18:53:31 +02:00
Bram 4349a14a87 BREAKING: Fix bug breaking Elm compiler 2024-05-26 18:12:37 +02:00
Bram 487c872d43 Add method to create a Vault 2024-05-26 13:12:03 +02:00
Bram 42ca8f6c9c Add Elm SDK logo 2024-05-25 19:48:29 +02:00
Bram e6257d8e38 Change VaultUpdate to API Backpack 2024-05-25 19:47:15 +02:00
Bram 7a75bffbfb Add send message event as Task 2024-05-25 17:03:42 +02:00
Bram 4f08dd1176 Add send message event API endpoint 2024-05-25 16:15:27 +02:00
Bram 50b10c64ca Add makeVBA TaskChain 2024-05-24 16:19:13 +02:00
Bram 3b0b3264de Finish /login API endpoint 2024-05-24 15:15:44 +02:00
Bram c84bb2a1ef Extract access token value on r0.0.0 login endpoint 2024-05-23 18:57:55 +02:00
Bram 6e89371845 Add /_matrix/client/r0/login on r0.0.0 2024-05-22 20:52:35 +02:00
Bram 77387ab492 Add makeVB TaskChain 2024-05-22 20:52:07 +02:00
Bram 83043e73f4 Add /.well-known/matrix.client endpoint 2024-05-22 20:51:36 +02:00
Bram becd3bcdb1 Update GetEvent + Invite endpoint to new Enveloped Http Log type 2024-05-22 19:17:21 +02:00
Bram e786bebeb2 Add /_matrix/client/versions endpoint 2024-05-22 19:13:20 +02:00
Bram 3ee6debf44 Refactor Context 2024-05-22 19:12:34 +02:00
Bram b6e4396138 Update existing types & modules 2024-05-22 19:11:39 +02:00
Bram 568afed458 Add Invite API endpoint 2024-05-19 00:22:51 +02:00
Bram 2714b53a2d Add GetEvent API endpoint 2024-05-19 00:22:36 +02:00
Bram 3fdd25d6d6 Add spec version control for API endpoints 2024-05-19 00:22:12 +02:00
Bram e49a0e3dc3 Add documentation 2024-05-17 18:00:33 +02:00
Bram 2e8185841a Add HTTP module for Matrix API requests 2024-05-17 14:28:06 +02:00
BramvdnHeuvel 9a6fcc5ad4
Publish beta 3.2.0
Merge pull request #23 from noordstar/develop
2024-05-10 15:50:29 +02:00
Bram ff8b6c043a Prepare develop for master
elm-test --fuzz 1000 --seed 70276890098989
2024-05-10 15:41:27 +02:00
Bram 7935e112ed Add Task Chain + API setup 2024-05-10 15:26:18 +02:00
BramvdnHeuvel 2baf012345
Merge pull request #22 from noordstar/3-vault
Add Vault as data type
2024-05-10 15:24:10 +02:00
Bram 107233fbad Remove fixed TODO 2024-05-10 15:21:31 +02:00
Bram 41d8503d7e Update library description 2024-05-09 20:53:57 +02:00
Bram e3e765503f Add initial VaultUpdate design 2024-05-09 18:39:17 +02:00
Bram 5cf6b59602 Add initial Vault design 2024-05-08 07:57:08 +02:00
BramvdnHeuvel ca1695c376
Publish beta 3.1.0
Merge pull request #21 from noordstar/develop
2024-04-26 15:53:06 +02:00
Bram e1c7c8792e Prepare develop for master
elm-test --fuzz 1000 --seed 134719727714686
2024-04-26 15:44:01 +02:00
BramvdnHeuvel bcdb178414
Merge pull request #20 from noordstar/3-room on GitHub
Add Room as data type
2024-04-26 15:30:23 +02:00
Bram e6a1bd13f0 Fix memory issue
It seems that the Room type is too complex and hence uses too much memory for testing it properly. For this reason, tests are temporarily disabled
2024-04-26 15:29:04 +02:00
Bram 2ff381d7f5 Fix JSON comparison bug for non-comparable types 2024-04-26 15:26:52 +02:00
Bram df71779620 Add Matrix.Room 2024-04-26 11:31:35 +02:00
Bram c309461602 Add initial Room design 2024-04-24 11:12:46 +02:00
noordstar c7659b592b
Publish beta 3.0.0
Merge pull request #18 from noordstar/develop
2024-04-12 15:11:16 +02:00
Bram 8f83e6a41c Prepare develop for master
elm-test --fuzz 1000 --seed 5363838114785
2024-04-12 14:59:52 +02:00
BramvdnHeuvel 8c73fbf9b1
Merge pull request #19 from noordstar/parser
Expose Matrix.User
2024-04-12 14:49:48 +02:00
Bram 086e491b06 Ignore decoder logs
Specifically on Hashdict/Mashdict as they variate based on JSON input
2024-04-12 14:30:33 +02:00
Bram 0ef298a28e Connect User to Event type 2024-04-12 13:57:38 +02:00
Bram 259f695b74 Expose Matrix.User module 2024-04-12 13:15:26 +02:00
Bram ae19884a18 Correct IPv6 Parser 2024-04-12 13:14:50 +02:00
Bram b3e103a5d9 Write Grammar tests 2024-04-10 18:14:32 +02:00
Bram 203205f53c Expose Elm types
As a general rule of thumb, internal values need no opaque types to hide their implementation
2024-04-10 08:28:52 +02:00
Bram c858ef151e Merge develop into parser branch 2024-04-09 20:46:10 +02:00
Bram 78794ef59b Add exposed modules + elm-format 2024-04-09 20:43:18 +02:00
Bram cd0c687307 Add server name module 2024-04-09 20:38:35 +02:00
Bram 077605bcbc Remove old file locations 2024-04-09 20:37:01 +02:00
BramvdnHeuvel 709d608056
Merge pull request #17 from noordstar/3-timeline
Add Timeline as data type
2024-04-08 14:21:04 +02:00
Bram f1dde4874b Merge Text code 2024-03-29 12:01:05 +01:00
Bram 5856084b45 Remove unused RationalOrder module
Kill your darlings, I guess. :(
2024-03-29 11:53:24 +01:00
Bram db6573180b elm-format 2024-03-29 11:52:12 +01:00
Bram 3983ab0de2 Merge develop into 3-timeline
Fixing merge conflict
2024-03-29 11:29:48 +01:00
Bram ccefa2ed9b Add documentation 2024-03-29 11:28:04 +01:00
Bram d41c31e8c1 Allow Timeline fuzzers to simulate /sync 2024-03-29 11:18:01 +01:00
Bram 792e60761a Add addSync to Timeline 2024-03-29 11:08:42 +01:00
Bram 33d98dd6ff Improve code readability
Cleaning up unused imports + changing order of operations on a value that is 0 by default
2024-03-29 10:51:10 +01:00
Bram ed78695213 Add Timeline JSON coder 2024-03-29 10:46:02 +01:00
Bram 791ada6f64 Merge branch 'parser' of github.com:noordstar/elm-matrix-sdk-beta into parser 2024-03-29 07:18:53 +01:00
Bram 56c978bcf3 Add custom text 2024-03-29 07:16:36 +01:00
Bram d1336a0e23 Add server name + user id parsers 2024-03-29 07:15:27 +01:00
Bram d68de7f2fb Add parser helper functions 2024-03-29 07:13:06 +01:00
Bram 43f0ac5ef2 Add server name specified fuzzers 2024-03-25 10:07:47 +01:00
Bram 421e1f6ce7 Add Elm Timeline to elm.json 2024-03-25 08:52:55 +01:00
Bram 1940b1d51f Fix RationalOrder formatting 2024-02-15 13:20:25 +01:00
Bram 7acae258ed Complete Timeline by fixing bugs 2024-02-15 13:15:19 +01:00
Bram 10c7075bef Merge branch '3-timeline' of github.com:noordstar/elm-matrix-sdk-beta into 3-timeline 2024-02-15 11:34:25 +01:00
Bram van den Heuvel cf28a3f210 Implement `mostRecentEvents` function 2024-02-15 01:27:00 +01:00
Bram van den Heuvel 2d26e1826d Add challenge 2 2024-02-13 11:13:16 +01:00
Bram van den Heuvel 6134702d25 Add Timeline documentation 2024-02-12 18:54:58 +01:00
Bram cd8163bb41 Fix bugs 2024-02-02 12:57:38 +01:00
BramvdnHeuvel f0933b9854
Publish beta 2.1.2
Merge pull request #16 from noordstar/develop
2024-02-02 12:54:00 +01:00
Bram bbe1eeef12 Prepare develop for master
elm-test --fuzz 10000 --seed 49678983951728
2024-02-02 12:15:50 +01:00
Bram 016290d9e1 Merge branch 'develop' into 3-timeline 2024-01-29 22:09:59 +01:00
BramvdnHeuvel 16a7e7e66b
Merge pull request #15 from noordstar/json-extra
Json reintroduction
2024-01-29 21:52:31 +01:00
Bram d40af28b38 Add RationalOrder type 2024-01-29 21:42:33 +01:00
Bram van den Heuvel ead65c07f5 Write object field documentation 2024-01-25 14:47:54 +01:00
Bram b6e181237f Merge branch 'develop' into 3-timeline 2024-01-23 19:20:44 +01:00
Bram c3c08845d8 Merge branch 'develop' into json-extra 2024-01-23 13:43:05 +01:00
Bram acd13ac67a Complete documentation 2024-01-22 18:09:08 +01:00
Bram dd5f298fd3 Migrate remaining objects to new JSON coders 2024-01-22 17:44:22 +01:00
Bram d1fbc87730 Refactor to new JSON coders 2024-01-19 16:22:51 +01:00
Bram 28d2a17a10 Add final features to JSON coder module 2024-01-19 16:21:41 +01:00
Bram 3f08e4a3e7 Add more high-level ary humans 2024-01-18 14:46:50 +01:00
Bram ecdc136f9e Write JSON test module 2024-01-16 16:06:38 +01:00
Bram 21dfa1e77f Fix documentation standards 2024-01-16 16:05:34 +01:00
Bram van den Heuvel 6f42916a19 Add advanced JSON module 2024-01-16 14:13:27 +01:00
BramvdnHeuvel 5aebeddd29
Publish beta 2.1.1
Merge pull request #14 from noordstar/develop
2024-01-12 17:26:31 +01:00
BramvdnHeuvel ef9b007730
Merge origin/develop-to-main to origin/develop
Develop to main for beta 2.1.1
2024-01-12 17:22:32 +01:00
Bram van den Heuvel 311de94c1f Bump to beta 2.1.1 2024-01-12 17:18:01 +01:00
Bram van den Heuvel 462aa3a2dc Fix test 2024-01-12 17:15:07 +01:00
BramvdnHeuvel cecf9c1f77
Merge pull request #11 from noordstar/settings-patch
Update syncTime to be at least 1
2024-01-12 17:12:24 +01:00
Bram van den Heuvel ad3f45d035 Update syncTime to be at least 1 2024-01-12 17:11:07 +01:00
Bram 2f7a247dbd Rewrite Timeline tests for comparing timelines through JSON 2024-01-12 00:08:35 +01:00
Bram 394799da8b Add Timeline JSON coders 2024-01-12 00:08:06 +01:00
Bram van den Heuvel 29f6a5e754 Refactor Batch input 2024-01-11 22:35:14 +01:00
Bram van den Heuvel 79aff7af3b Refactor Timeline architecture 2024-01-11 09:20:16 +01:00
Bram van den Heuvel 0ce58d6f9e Add grammer definition 2024-01-10 10:02:14 +01:00
Bram van den Heuvel fd569aa476 Implement complex JSON decoder 2024-01-10 09:22:12 +01:00
Bram van den Heuvel ae38fe6878 Introduce phantom file 2024-01-10 00:59:22 +01:00
Bram van den Heuvel 06c048286c Add log module 2024-01-10 00:59:09 +01:00
Bram van den Heuvel 2d01802b86 Rename Tools.Encode and Tools.Decode to Extra 2024-01-09 18:35:21 +01:00
Bram van den Heuvel 81b0b1c166 Add first (faulty) design of Timeline 2024-01-09 18:19:29 +01:00
Bram 211f8f1df4 Add Timeline framework
The tests fail, but using test-driven development we will now build them functional
2024-01-05 13:51:06 +01:00
Bram e8ee125def Add subsetOf Filter function 2024-01-04 03:13:17 +01:00
Bram 3739043f87 Create Timeline filter 2024-01-04 02:00:31 +01:00
BramvdnHeuvel 2de15acc28
Publish beta 2.1.0
Merge pull request #10 from noordstar/develop
2023-12-29 17:56:36 +01:00
BramvdnHeuvel 2507766248
Merge origin/develop-to-main to origin/develop
Develop to main for beta 2.1.0
2023-12-29 17:17:34 +01:00
Bram af26e2b0a4 Prepare develop for master
elm-test --fuzz 10000 --seed 188919533398969
2023-12-29 17:03:57 +01:00
Bram 138bfd5743 Add elm-test as new merging requirement 2023-12-29 16:56:53 +01:00
BramvdnHeuvel 70f57b1b96
Merge current data types to develop
Merge pull request #8 from noordstar/3-data-types
2023-12-29 15:50:32 +01:00
BramvdnHeuvel a70e1a775b
Merge State Manager to 3-data-types
Merge pull request #7 from noordstar/3-state-manager
2023-12-29 15:19:40 +01:00
Bram 20b4ea2f5c elm-format 2023-12-29 14:58:50 +01:00
Bram 5cdb4fad33 Remove warnings 2023-12-29 14:57:59 +01:00
Bram e1a4bcab9b Add StateManager type 2023-12-29 14:50:43 +01:00
Bram acfeabb39e Merge branch 'elm-test' into 3-state-manager 2023-12-26 17:44:48 +01:00
Bram 277c15c7e1 Add Mashdict 2023-12-26 17:43:06 +01:00
Bram c7a3fe804b elm-format + add more tests 2023-12-26 16:11:51 +01:00
Bram f465c9cbb1 Add isEqual function for Hashdict + tests 2023-12-26 12:59:50 +01:00
Bram 26ca6600d7 Add Hashdict test 2023-12-24 15:49:55 +01:00
BramvdnHeuvel cee2b3a5bb
Merge Event type as data type
Merge pull request #6 from noordstar/3-event
2023-12-24 15:27:39 +01:00
Bram 4905b7341d Complete documentation 2023-12-24 11:36:34 +01:00
Bram fa642b46d6 Refactor test suite 2023-12-24 11:30:50 +01:00
Bram bf64d5911f Add Timestamp test 2023-12-24 11:17:43 +01:00
Bram 959642499b Envelope refactor
Effectively, the Envelope type has been moved to the Types module, effectively keeping it separate from other data types.
2023-12-24 02:16:52 +01:00
Bram 3e54ea9cbe Add separate Settings module 2023-12-24 01:26:06 +01:00
Bram 5ac3e7eb6a Fix Event test
This commit is starting to show how the definition of the Envelope wrapper is better done on a different level
2023-12-24 00:37:22 +01:00
Bram 1a819cbe39 Add exposed Event module 2023-12-24 00:03:07 +01:00
Bram 5065ed05ff Add Event tests 2023-12-22 23:44:46 +01:00
Bram ff180ec84d Merge branch '3-data-types' into 3-event 2023-12-22 22:24:07 +01:00
Bram 5d2d9ddb73 Merge develop into 3-data-types 2023-12-22 22:22:48 +01:00
Bram 0448b74609 Improve Event documentation 2023-12-22 22:20:19 +01:00
Bram van den Heuvel ce83d1260f Add reader functions for Event types 2023-12-22 16:59:45 +01:00
BramvdnHeuvel 0bca889d41
Publish beta 2.0.0
Merge pull request #5 from noordstar/develop
2023-12-21 23:39:09 +01:00
BramvdnHeuvel ac938344fd
Merge pull request #4 from noordstar/develop-to-main
Develop to main for beta 2.0.0
2023-12-21 23:23:33 +01:00
BramvdnHeuvel d856974ade
Merge pull request #3 from noordstar/elm-test
Add Elm tests
2023-12-21 23:21:41 +01:00
Bram 978d6c6315 elm-format 2023-12-21 23:17:34 +01:00
Bram 88818abe20 Add Context test 2023-12-21 23:16:21 +01:00
Bram ca0a7b41df Add Matrix.Settings test 2023-12-21 22:39:30 +01:00
Bram 16c9e0d4e1 Prepare develop for master 2023-12-21 22:27:34 +01:00
Bram 4e68dfbcbd Add Iddict tests 2023-12-20 13:26:21 +01:00
Bram 14058f4b69 Add Event type 2023-12-19 02:46:23 +01:00
BramvdnHeuvel 2e6d07bc42
Merge pull request #2 from noordstar/2-transfer-tools
Task 2: Adding configurations
2023-12-19 00:13:05 +01:00
Bram 1d3ceb9b2d Fix typos 2023-12-18 17:30:52 +01:00
Bram d9d5760928 Reorder Envelope functions alphabetically 2023-12-18 17:20:43 +01:00
Bram 5bd95699d2 Add function for Envelope 2023-12-18 17:19:12 +01:00
Bram 447a18ab04 Update Internal.Config.Text docs 2023-12-18 17:10:04 +01:00
Bram 87a5919921 Include Context in Envelope 2023-12-18 14:27:22 +01:00
Bram 7254fcfaa4 Add Context type 2023-12-18 14:26:57 +01:00
Bram b3479cf2c9 Add leaking values 2023-12-18 05:51:24 +01:00
Bram 3b927dc460 Update exposed Vault to match internal Vault 2023-12-18 02:11:31 +01:00
Bram ce0f96a74e Merge branch 'develop' into 2-transfer-tools
This operation merges the new update from the `develop` branch in order to get the latest changes.
2023-12-18 02:05:13 +01:00
BramvdnHeuvel 603057568d
Merge pull request #1 from noordstar/1-repo-setup
Task 1: finish repository setup
2023-12-18 02:00:30 +01:00
Bram 2fd2eb4e5a Fix broken link 2023-12-18 01:57:14 +01:00
Bram ee1012f783 Add VSCode workspace settings to .gitignore 2023-12-18 01:34:00 +01:00
Bram 29f9482b74 Add public settings interface 2023-12-18 01:32:57 +01:00
Bram 8b7b2aa312 Add internal Vault type 2023-12-18 01:32:21 +01:00
Bram 5293eb4003 Add Envelope function to extract settings values 2023-12-18 01:30:15 +01:00
Bram f910c0225b Add Envelope JSON coders 2023-12-18 01:08:40 +01:00
Bram 848d83a18e Add JSON coder helper files 2023-12-17 21:29:45 +01:00
Bram 1b0be9bffa Add Envelope type 2023-12-17 15:18:54 +01:00
Bram 70d44c2cb6 Add guidelines to merging branches 2023-12-16 01:49:13 +01:00
Bram 7c7e05d42a Add standardized text values 2023-12-16 01:25:02 +01:00
Bram b7c2e28f71 Add default config values 2023-12-16 00:28:14 +01:00
Bram dd10d43da1 Add Timestamp data type 2023-12-15 23:55:03 +01:00
Bram van den Heuvel 31d176d110 Add CONTRIBUTING.md 2023-12-15 18:29:25 +01:00
Bram van den Heuvel 037e598b36 elm-format 2023-12-15 15:05:48 +01:00
Bram van den Heuvel a53fca3326 Add VersionControl 2023-12-15 15:03:01 +01:00
Bram van den Heuvel da81a09eb8 elm-format Hashdict documentation 2023-12-15 15:02:02 +01:00
Bram van den Heuvel fcc7699a44 elm-format Hashdict & Iddict
I should attempt to not forget this!
2023-12-14 20:43:23 +01:00
Bram van den Heuvel 41ede5bbff Add Hashdict 2023-12-14 18:35:27 +01:00
Bram van den Heuvel 6fa7904b8d Add JSON coders for id-dict 2023-12-14 15:29:05 +01:00
Bram van den Heuvel c5e1b756a2 Add id-dict 2023-12-14 14:23:29 +01:00
80 changed files with 19469 additions and 13 deletions

9
.gitignore vendored
View File

@ -2,3 +2,12 @@
elm-stuff
# elm-repl generated files
repl-temp-*
# VScode settings
.vscode/
# Elm output
index.html
elm.js
# Elm configurations
elm-*.json

View File

@ -18,8 +18,9 @@ supported for which spec versions.
- ✅ **One way to do things** instead of having multiple functions that are
considered deprecated.
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) at
@elm_matrix_sdk@social.noordstar.me to stay up-to-date on the latest changes.
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) or join the
conversation on [Matrix](https://matrix.to/#/#elm-sdk:matrix.org) to stay
up-to-date on the latest changes.
## How to install
@ -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
not expect the versions to remain reliable for years! If you need a stable
version, please wait around for a full version.
## Contribute
If you wish to contribute, please read the
[contribution guide](docs/CONTRIBUTING.md).

71
docs/CONTRIBUTING.md Normal file
View File

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

31
docs/before-merge.md Normal file
View File

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

BIN
docs/logo.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.7 KiB

16
docs/logo.svg Normal file
View File

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

After

Width:  |  Height:  |  Size: 1.2 KiB

138
docs/timeline.md Normal file
View File

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

View File

@ -3,11 +3,27 @@
"name": "noordstar/elm-matrix-sdk-beta",
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
"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",
"exposed-modules": [ "Matrix" ],
"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"
}
}

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

@ -0,0 +1,196 @@
module Internal.Api.Api exposing
( TaskChain, request
, VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
)
{-|
# API
The API module is a front-end for implementing API endpoints according to spec.
This module is imported by various API endpoint implementations to keep the
implementation simple and understandable.
@docs TaskChain, request
## Spec versions
To respect spec versions, there is often a variety of ways to communicate with
the homeserver. For this reason, users can differentiate spec versions using
these functions.
@docs VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
-}
import Internal.Api.Chain as C
import Internal.Api.Request as R
import Internal.Config.Log exposing (Log, log)
import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (APIContext, Versions)
import Internal.Values.Envelope as E
import Internal.Values.Vault as V
import Recursion
import Set
{-| A TaskChain helps create a chain of HTTP requests.
-}
type alias TaskChain ph1 ph2 =
C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) { ph1 | baseUrl : () } { ph2 | baseUrl : () }
{-| Make an HTTP request that adheres to the Matrix spec rules.
-}
request :
{ attributes : List (R.Attribute { ph1 | baseUrl : () })
, coder : Json.Coder returnValue
, contextChange : returnValue -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
, method : String
, path : List String
, toUpdate : returnValue -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
}
-> TaskChain ph1 ph2
request data =
R.toChain
{ logHttp =
\r ->
( E.HttpRequest r
, String.concat
-- TODO: Move this to Internal.Config.Text module
[ "Matrix HTTP: "
, r.method
, " "
, r.url
]
|> log.info
|> List.singleton
)
, coder = data.coder
, request =
R.callAPI
{ method = data.method
, path = data.path
}
|> R.withAttributes data.attributes
, toContextChange = data.contextChange
, toUpdate = data.toUpdate
}
{-| This type allows different definitions for different spec versions,
allowing the Elm SDK to communicate differently to the server depending on
how up-to-date the server is.
-}
type VersionControl a ph1 ph2
= VC
{ name : VersionType
, chain : a -> TaskChain (WithV ph1) (WithV ph2)
, prev : Maybe (VersionControl a ph1 ph2)
}
type VersionType
= SpecVersion String
| UnstableFeature String
type alias WithV ph =
{ ph | versions : () }
{-| Start with a given spec version supporting a given API endpoint.
-}
startWithVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
startWithVersion name chain =
VC
{ name = SpecVersion name
, chain = chain
, prev = Nothing
}
{-| Start with a given unstable feature supporting a given API endpoint.
-}
startWithUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
startWithUnstableFeature name chain =
VC
{ name = UnstableFeature name
, chain = chain
, prev = Nothing
}
{-| Add a new unstable feature that supports a different version of the API endpoint.
-}
forUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
forUnstableFeature name chain prev =
VC
{ name = UnstableFeature name
, chain = chain
, prev = Just prev
}
{-| Add a new spec version that supports a different version of the API endpoint.
-}
forVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
forVersion name chain prev =
VC
{ name = SpecVersion name
, chain = chain
, prev = Just prev
}
{-| Add another spec version that has the API endpoint defined the same as the previous API endpoint.
-}
sameForVersion : String -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
sameForVersion name (VC data) =
VC
{ name = SpecVersion name
, chain = data.chain
, prev = Just (VC data)
}
supportedVersion : Versions -> VersionType -> Bool
supportedVersion { versions, unstableFeatures } name =
case name of
SpecVersion n ->
List.member n versions
UnstableFeature n ->
Set.member n unstableFeatures
-- NOTE: Interesting detail! For some reason, I cannot add the `context`
-- NOTE: variable to the top line of the defined input values!
-- NOTE: Maybe this is a bug?
{-| Once you are done, turn a VersionControl type into a Task Chain.
-}
versionChain : VersionControl a ph1 ph2 -> a -> TaskChain (WithV ph1) (WithV ph2)
versionChain vc input =
\context ->
case Context.getVersions context of
versions ->
Recursion.runRecursion
(\mvc ->
case mvc of
Nothing ->
Recursion.base (C.fail R.NoSupportedVersion context)
Just (VC data) ->
if supportedVersion versions data.name then
Recursion.base (data.chain input context)
else
Recursion.recurse data.prev
)
(Just vc)

View File

@ -0,0 +1,116 @@
module Internal.Api.BanUser.Api exposing (Phantom, banUser)
{-|
# Ban user
This module helps to ban users from a room.
@docs Phantom, banUser
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as R
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
banUser : BanUserInput -> A.TaskChain (Phantom a) (Phantom a)
banUser =
A.startWithVersion "r0.0.0" banUserV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" banUserV2
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias BanUserInput =
{ reason : Maybe String
, roomId : String
, user : User
}
type alias BanUserInputV1 a =
{ a | reason : Maybe String, roomId : String, user : User }
type alias BanUserOutputV1 =
()
banUserV1 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
banUserV1 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV1
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "ban" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
banUserV2 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
banUserV2 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
]
, coder = coderV1
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "ban" ]
, toUpdate =
\() ->
( E.More []
, []
)
}
coderV1 : Json.Coder BanUserOutputV1
coderV1 =
Json.unit

View File

@ -0,0 +1,134 @@
module Internal.Api.BaseUrl.Api exposing (baseUrl)
{-|
# Base URL
This module looks for the right homeserver address.
@docs baseUrl
-}
import Internal.Api.Chain as C
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Context as Context
import Internal.Values.Envelope as E
import Internal.Values.Vault as V
{-| Get the homeserver base URL of a given server name.
-}
baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () }
baseUrl data =
R.toChain
{ logHttp =
\r ->
( E.HttpRequest r
, Text.logs.httpRequest r.method r.url
|> log.info
|> List.singleton
)
, coder = coder
, request =
\context ->
{ attributes = []
, baseUrl = data.url
, context = context
, method = "GET"
, path = [ ".well-known", "matrix", "client" ]
}
, toContextChange = \info -> Context.setBaseUrl info.homeserver.baseUrl
, toUpdate =
\info ->
( E.SetBaseUrl info.homeserver.baseUrl
, Text.logs.baseUrlFound data.url info.homeserver.baseUrl
|> log.debug
|> List.singleton
)
}
type alias BaseUrlInput =
{ url : String }
type alias DiscoveryInformation =
{ homeserver : HomeserverInformation
, identityServer : Maybe IdentityServerInformation
}
type alias HomeserverInformation =
{ baseUrl : String }
type alias IdentityServerInformation =
{ baseUrl : String }
coder : Json.Coder DiscoveryInformation
coder =
Json.object2
{ name = "Discovery Information"
, description =
[ "Gets discovery information about the domain. The file may include additional keys, which MUST follow the Java package naming convention, e.g. com.example.myapp.property. This ensures property names are suitably namespaced for each application and reduces the risk of clashes."
, "Note that this endpoint is not necessarily handled by the homeserver, but by another webserver, to be used for discovering the homeserver URL."
, "https://spec.matrix.org/v1.10/client-server-api/#getwell-knownmatrixclient"
]
, init = DiscoveryInformation
}
(Json.field.required
{ fieldName = "m.homeserver"
, toField = .homeserver
, coder =
Json.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = HomeserverInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover homeserver information."
]
}
)
(Json.field.optional.value
{ fieldName = "m.identity_server"
, toField = .identityServer
, coder =
Json.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = IdentityServerInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover identity server information."
]
}
)

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

@ -0,0 +1,203 @@
module Internal.Api.Chain exposing
( TaskChain, CompleteChain
, IdemChain, toTask
, fail, succeed, andThen, catchWith, maybe
)
{-|
# Task chains
Elm uses a `Task` type to avoid issues that JavaScript deals with, yet the same
**callback hell** issue might appear that JavaScript developers often deal with.
For this reason, this module helps chain different `Task` types together such
that all information is stored and values are dealt with appropriately.
Elm's type checking system helps making this system sufficiently rigorous to
avoid leaking values passing through the API in unexpected ways.
@docs TaskChain, CompleteChain
## Finished chain
@docs IdemChain, toTask
## Operations
@docs fail, succeed, andThen, catchWith, maybe
-}
import Internal.Config.Log exposing (Log)
import Internal.Values.Context exposing (APIContext)
import Task
type alias Backpacked u a =
{ a | messages : List u, logs : List Log }
{-| The TaskChain is a piece in the long chain of tasks that need to be completed.
The type defines four variables:
- `err` value that may arise on an error
- `u` the update msg that should be returned
- `a` phantom type before executing the chain's context
- `b` phantom type after executing the chain's context
-}
type alias TaskChain err u a b =
APIContext a -> Task.Task (FailedChainPiece err u) (TaskChainPiece u a b)
{-| An IdemChain is a TaskChain that does not influence the chain's context
- `err` value that may arise on an error
- `u` the update msg that should be executed
- `a` phantom type before, during and after the chain's context
-}
type alias IdemChain err u a =
TaskChain err u a a
{-| A CompleteChain is a complete task chain where all necessary information
has been defined. In simple terms, whenever a Matrix API call is made, all
necessary information for that endpoint:
1. Was previously known and has been inserted, or
2. Was acquired before actually making the API call.
-}
type alias CompleteChain u =
TaskChain Never u {} {}
{-| A TaskChainPiece is a piece that updates the chain's context.
Once a chain is executed, the process will add the `messages` value to its list
of updates, and it will update its context according to the `contextChange`
function.
-}
type alias TaskChainPiece u a b =
Backpacked u { contextChange : APIContext a -> APIContext b }
{-| A FailedChainPiece initiates an early breakdown of a chain. Unless caught,
this halts execution of the chain. The process will add the `messages` value to
its list of updates, and it will return the given `err` value for a direct
explanation of what went wrong.
-}
type alias FailedChainPiece err u =
Backpacked u { error : err }
{-| Chain two tasks together. The second task will only run if the first one
succeeds.
-}
andThen : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
andThen f2 f1 =
\context ->
f1 context
|> Task.andThen
(\old ->
context
|> old.contextChange
|> f2
|> Task.map
(\new ->
{ contextChange = old.contextChange >> new.contextChange
, logs = List.append old.logs new.logs
, messages = List.append old.messages new.messages
}
)
|> Task.mapError
(\new ->
{ error = new.error
, logs = List.append old.logs new.logs
, messages = List.append old.messages new.messages
}
)
)
{-| When an error has occurred, "fix" it with an artificial task chain result.
-}
catchWith : (err -> TaskChainPiece u a b) -> TaskChain err u a b -> TaskChain err2 u a b
catchWith onErr f =
onError (\e -> succeed <| onErr e) f
{-| Creates a task that always fails.
-}
fail : err -> TaskChain err u a b
fail e _ =
Task.fail { error = e, logs = [], messages = [] }
{-| Optionally run a task that doesn't need to succeed.
If the provided chain fails, it will be ignored. This way, the chain can be
executed without breaking the whole chain if it fails. This can be useful for:
1. Sending information to the Matrix API and not caring if it actually arrives
2. Gaining optional information that might be nice to know, but not necessary
Consequently, the optional chain cannot add any information that the rest of
the chain relies on.
-}
maybe : IdemChain err u a -> IdemChain err2 u a
maybe f =
{ contextChange = identity
, logs = []
, messages = []
}
|> succeed
|> always
|> onError
|> (|>) f
{-| When an error occurs, this function allows the task chain to go down a
similar but different route.
-}
onError : (err -> TaskChain err2 u a b) -> TaskChain err u a b -> TaskChain err2 u a b
onError onErr f =
\context ->
f context
|> Task.onError
(\old ->
{ contextChange = identity
, logs = old.logs -- TODO: Log caught errors
, messages = old.messages
}
|> succeed
|> andThen (onErr old.error)
|> (|>) context
)
{-| Creates a task that always succeeds.
-}
succeed : TaskChainPiece u a b -> TaskChain err u a b
succeed piece _ =
Task.succeed piece
{-| Once the chain is complete, turn it into a valid task.
-}
toTask : IdemChain Never u a -> APIContext a -> Task.Task Never (Backpacked u {})
toTask chain context =
chain context
|> Task.onError (\e -> Task.succeed <| never e.error)
|> Task.map
(\backpack ->
{ messages = backpack.messages
, logs = backpack.logs
}
)

View File

@ -0,0 +1,247 @@
module Internal.Api.GetEvent.Api exposing (GetEventInput, getEvent)
{-|
# Get event
Get a single event based on `roomId/eventId`. You must have permission to
retrieve this event e.g. by being a member in the room for this event.
@docs GetEventInput, getEvent
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Tools.Timestamp as Timestamp
import Internal.Values.Envelope as E
import Internal.Values.Event as Event exposing (Event)
import Internal.Values.Room as Room
import Internal.Values.User as User
import Internal.Values.Vault as V
{-| Input for getting an event.
-}
type alias GetEventInput =
{ eventId : String, roomId : String }
{-| Standard input for version 1 of the GetEvent API endpoint.
-}
type alias GetEventInputV1 a =
{ a | eventId : String, roomId : String }
{-| Universal phantom type encompassing all versions of this API endpoint.
-}
type alias Phantom a =
PhantomV1 { a | versions : () }
{-| Phantom values necessary for version 1 of the GetEvent API endpoint.
-}
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
{-| Get an event based on a room id and event id.
-}
getEvent : GetEventInput -> A.TaskChain (Phantom a) (Phantom a)
getEvent =
A.startWithVersion "r0.5.0" getEventV1
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" getEventV2
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.versionChain
{-| Version 1 of the GetEvent API endpoint
-}
getEventV1 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
getEventV1 { eventId, roomId } =
A.request
{ attributes =
[ R.accessToken
, R.onStatusCode 404 "M_NOT_FOUND"
]
, coder = getEventCoderV1
, contextChange = always identity
, method = "GET"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "event", eventId ]
, toUpdate =
\event ->
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
, event.eventId
|> Text.logs.getEventId
|> log.debug
|> List.singleton
)
}
{-| Version 2 of the GetEvent API endpoint
-}
getEventV2 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
getEventV2 { eventId, roomId } =
A.request
{ attributes =
[ R.accessToken
, R.onStatusCode 404 "M_NOT_FOUND"
]
, coder = getEventCoderV1
, contextChange = always identity
, method = "GET"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "event", eventId ]
, toUpdate =
\event ->
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
, event.eventId
|> Text.logs.getEventId
|> log.debug
|> List.singleton
)
}
getEventCoderV1 : Json.Coder Event
getEventCoderV1 =
Json.object8
{ name = "ClientEvent"
, description =
[ "ClientEvent as described by the Matrix spec"
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
]
, init = Event
}
(Json.field.required
{ fieldName = "content"
, toField = .content
, description =
[ "The body of this event, as created by the client which sent it."
]
, coder = Json.value
}
)
(Json.field.required
{ fieldName = "event_id"
, toField = .eventId
, description =
[ "The globally unique identifier for this event."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "origin_server_ts"
, toField = .originServerTs
, description =
[ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent."
]
, coder = Timestamp.coder
}
)
(Json.field.required
{ fieldName = "room_id"
, toField = .roomId
, description =
[ "The ID of the room associated with this event."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "sender"
, toField = .sender
, description =
[ "Contains the fully-qualified ID of the user who sent this event."
]
, coder = User.coder
}
)
(Json.field.optional.value
{ fieldName = "state_key"
, toField = .stateKey
, description =
[ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string."
, "State keys starting with an @ are reserved for referencing user IDs, such as room members. With the exception of a few events, state events set with a given users ID as the state key MUST only be set by that user."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "type"
, toField = .eventType
, description =
[ "The type of the event."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "unsigned"
, toField = .unsigned
, description =
[ "Contains optional extra information about the event."
]
, coder =
Json.object4
{ name = "UnsignedData"
, description =
[ "UnsignedData as described by the Matrix spec"
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
]
, init = \a b c d -> Event.UnsignedData { age = a, membership = Nothing, prevContent = b, redactedBecause = c, transactionId = d }
}
(Json.field.optional.value
{ fieldName = "age"
, toField = \(Event.UnsignedData data) -> data.age
, description =
[ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is."
]
, coder = Json.int
}
)
(Json.field.optional.value
{ fieldName = "prev_content"
, toField = \(Event.UnsignedData data) -> data.prevContent
, description =
[ " The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content."
, "Changed in v1.2: Previously, this field was specified at the top level of returned events rather than in unsigned (with the exception of the GET .../notifications endpoint), though in practice no known server implementations honoured this."
]
, coder = Json.value
}
)
(Json.field.optional.value
{ fieldName = "redacted_because"
, toField = \(Event.UnsignedData data) -> data.redactedBecause
, description =
[ "The event that redacted this event, if any."
]
, coder = Json.lazy (\() -> getEventCoderV1)
}
)
(Json.field.optional.value
{ fieldName = "transaction_id"
, toField = \(Event.UnsignedData data) -> data.transactionId
, description =
[ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it."
]
, coder = Json.string
}
)
}
)

View File

@ -0,0 +1,128 @@
module Internal.Api.InviteUser.Api exposing (InviteInput, Phantom, inviteUser)
{-|
# Invite
This API invites a user to participate in a particular room. They do not start
participating in the room until they actually join the room.
Only users currently in a particular room can invite other users to join that
room.
If the user was invited to the room, the homeserver will append a m.room.member
event to the room.
@docs InviteInput, Phantom, inviteUser
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as Room
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
{-| Invite a user to a room.
-}
inviteUser : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
inviteUser =
A.startWithVersion "r0.0.0" inviteV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" inviteV2
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.versionChain
{-| Context needed for inviting a user.
-}
type alias Phantom a =
{ a | accessToken : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : () }
{-| Input for inviting a user.
-}
type alias InviteInput =
{ reason : Maybe String, roomId : String, user : User }
type alias InviteInputV1 a =
{ a | roomId : String, user : User }
type alias InviteInputV2 a =
{ a | roomId : String, user : User, reason : Maybe String }
inviteV1 : InviteInputV1 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
inviteV1 { roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyString "user_id" (User.toString user)
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = Json.value
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "invite" ]
, toUpdate =
always
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
, Text.logs.invitedUser (User.toString user) roomId
|> log.debug
|> List.singleton
)
}
inviteV2 : InviteInputV2 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
inviteV2 { reason, roomId, user } =
A.request
{ attributes =
[ R.accessToken
, R.bodyOpString "reason" reason
, R.bodyString "user_id" (User.toString user)
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = Json.value
, contextChange = always identity
, method = "POST"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "invite" ]
, toUpdate =
always
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
, Text.logs.invitedUser (User.toString user) roomId
|> log.debug
|> List.singleton
)
}

View File

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

View File

@ -0,0 +1,935 @@
module Internal.Api.LoginWithUsernameAndPassword.Api exposing (Phantom, loginWithUsernameAndPassword)
{-|
# Login
This module allows the user to log in using a username and password.
@docs Phantom, loginWithUsernameAndPassword
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Context as Context
import Internal.Values.Envelope as E
import Internal.Values.User as User exposing (User)
import Internal.Values.Vault as V
import Json.Encode as E
{-| Log in using a username and password.
-}
loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> A.TaskChain (Phantom a) (Phantom { a | accessToken : () })
loginWithUsernameAndPassword =
A.startWithVersion "r0.0.0" loginWithUsernameAndPasswordV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.forVersion "r0.3.0" loginWithUsernameAndPasswordV2
|> A.forVersion "r0.4.0" loginWithUsernameAndPasswordV3
|> A.forVersion "r0.5.0" loginWithUsernameAndPasswordV4
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" loginWithUsernameAndPasswordV5
|> A.sameForVersion "v1.2"
|> A.forVersion "v1.3" loginWithUsernameAndPasswordV6
|> A.forVersion "v1.4" loginWithUsernameAndPasswordV7
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.versionChain
{-| Context needed for logging in with a username and password
-}
type alias Phantom a =
{ a | baseUrl : (), now : (), versions : () }
type alias LoginWithUsernameAndPasswordInput =
{ deviceId : Maybe String
, enableRefreshToken : Maybe Bool
, initialDeviceDisplayName : Maybe String
, password : String
, username : String
}
type alias LoginWithUsernameAndPasswordInputV1 a =
{ a
| password : String
, username : String
}
type alias LoginWithUsernameAndPasswordInputV2 a =
{ a
| deviceId : Maybe String
, initialDeviceDisplayName : Maybe String
, password : String
, username : String
}
type alias LoginWithUsernameAndPasswordInputV3 a =
{ a
| deviceId : Maybe String
, enableRefreshToken : Maybe Bool
, initialDeviceDisplayName : Maybe String
, password : String
, username : String
}
type alias LoginWithUsernameAndPasswordOutputV1 =
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
, homeserver : String
, refreshToken : Maybe String
, user : Maybe User
}
type alias LoginWithUsernameAndPasswordOutputV2 =
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
, deviceId : Maybe String
, homeserver : String
, user : Maybe User
}
type alias LoginWithUsernameAndPasswordOutputV3 =
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
, deviceId : Maybe String
, homeserver : Maybe String
, user : Maybe User
}
type alias LoginWithUsernameAndPasswordOutputV4 =
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
, deviceId : Maybe String
, homeserver : Maybe String
, user : Maybe User
, wellKnown : Maybe DiscoveryInformationV1
}
type alias LoginWithUsernameAndPasswordOutputV5 =
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
, deviceId : Maybe String
, expiresInMs : Maybe Int
, homeserver : Maybe String
, refreshToken : Maybe String
, user : Maybe User
, wellKnown : Maybe DiscoveryInformationV1
}
type alias LoginWithUsernameAndPasswordOutputV6 =
{ accessToken : String
, deviceId : String
, expiresInMs : Maybe Int
, homeserver : Maybe String
, refreshToken : Maybe String
, user : User
, wellKnown : Maybe DiscoveryInformationV1
}
type alias DiscoveryInformationV1 =
{ homeserver : HomeserverInformation
, identityServer : Maybe IdentityServerInformation
}
type alias HomeserverInformation =
{ baseUrl : String }
type alias IdentityServerInformation =
{ baseUrl : String }
type alias PhantomV1 a =
{ a | baseUrl : (), now : () }
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV1 { username, password } =
\context ->
A.request
{ attributes =
[ R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
]
, coder = coderV1
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, out.user
|> Maybe.map E.SetUser
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV2 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "device_id" deviceId
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "string" -- Yup. That's what it says.
]
, coder = coderV2
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, out.user
|> Maybe.map E.SetUser
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV3 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV3
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, out.user
|> Maybe.map E.SetUser
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV4 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV4
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, out.user
|> Maybe.map E.SetUser
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV5 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV4
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, out.user
|> Maybe.map E.SetUser
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV6 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyOpBool "refresh_token" enableRefreshToken
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV5
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = out.expiresInMs
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, out.user
|> Maybe.map E.SetUser
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV7 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyOpBool "refresh_token" enableRefreshToken
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV6
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = out.expiresInMs
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, E.RemovePasswordIfNecessary
, E.SetUser out.user
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, E.SetDeviceId out.deviceId
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
coderV1 : Json.Coder LoginWithUsernameAndPasswordOutputV1
coderV1 =
Json.object4
{ name = "Login Response"
, description =
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
, "https://spec.matrix.org/legacy/r0.0.0/client_server.html#post-matrix-client-r0-login"
]
, init = LoginWithUsernameAndPasswordOutputV1
}
(Json.field.required
{ fieldName = "access_token"
, toField = .accessToken
, description =
[ "An access token for the account. This access token can then be used to authorize other requests. The access token may expire at some point, and if so, it SHOULD come with a refresh_token. There is no specific error message to indicate that a request has failed because an access token has expired; instead, if a client has reason to believe its access token is valid, and it receives an auth error, they should attempt to refresh for a new token on failure, and retry the request with the new token."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "home_server"
, toField = .homeserver
, description =
[ "The hostname of the homeserver on which the account has been registered."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "refresh_token"
, toField = .refreshToken
, description =
[ "A refresh_token may be exchanged for a new access_token using the /tokenrefresh API endpoint."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "user_id"
, toField = .user
, description =
[ "The fully-qualified Matrix ID that has been registered."
]
, coder = User.coder
}
)
coderV2 : Json.Coder LoginWithUsernameAndPasswordOutputV2
coderV2 =
Json.object4
{ name = "Login Response"
, description =
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
, "https://spec.matrix.org/legacy/client_server/r0.3.0.html#post-matrix-client-r0-login"
]
, init = LoginWithUsernameAndPasswordOutputV2
}
(Json.field.required
{ fieldName = "access_token"
, toField = .accessToken
, description =
[ "An access token for the account. This access token can then be used to authorize other requests."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "device_id"
, toField = .deviceId
, description =
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "home_server"
, toField = .homeserver
, description =
[ "The hostname of the homeserver on which the account has been registered."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "user_id"
, toField = .user
, description =
[ "The fully-qualified Matrix ID that has been registered."
]
, coder = User.coder
}
)
coderV3 : Json.Coder LoginWithUsernameAndPasswordOutputV3
coderV3 =
Json.object4
{ name = "Login Response"
, description =
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
, "https://spec.matrix.org/legacy/client_server/r0.3.0.html#post-matrix-client-r0-login"
]
, init = LoginWithUsernameAndPasswordOutputV3
}
(Json.field.required
{ fieldName = "access_token"
, toField = .accessToken
, description =
[ "An access token for the account. This access token can then be used to authorize other requests."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "device_id"
, toField = .deviceId
, description =
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "home_server"
, toField = .homeserver
, description =
[ "The hostname of the homeserver on which the account has been registered."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "user_id"
, toField = .user
, description =
[ "The fully-qualified Matrix ID that has been registered."
]
, coder = User.coder
}
)
coderV4 : Json.Coder LoginWithUsernameAndPasswordOutputV4
coderV4 =
Json.object5
{ name = "Login Response"
, description =
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
, "https://spec.matrix.org/legacy/client_server/r0.5.0.html#post-matrix-client-r0-login"
]
, init = LoginWithUsernameAndPasswordOutputV4
}
(Json.field.required
{ fieldName = "access_token"
, toField = .accessToken
, description =
[ "An access token for the account. This access token can then be used to authorize other requests."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "device_id"
, toField = .deviceId
, description =
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "home_server"
, toField = .homeserver
, description =
[ "The hostname of the homeserver on which the account has been registered."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "user_id"
, toField = .user
, description =
[ "The fully-qualified Matrix ID that has been registered."
]
, coder = User.coder
}
)
(Json.field.optional.value
{ fieldName = "well_known"
, toField = .wellKnown
, description =
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
]
, coder = disoveryInformationCoderV1
}
)
coderV5 : Json.Coder LoginWithUsernameAndPasswordOutputV5
coderV5 =
Json.object7
{ name = "Login Response"
, description =
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
, "https://spec.matrix.org/v1.3/client-server-api/#post_matrixclientv3login"
]
, init = LoginWithUsernameAndPasswordOutputV5
}
(Json.field.required
{ fieldName = "access_token"
, toField = .accessToken
, description =
[ "An access token for the account. This access token can then be used to authorize other requests."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "device_id"
, toField = .deviceId
, description =
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "expires_in_ms"
, toField = .expiresInMs
, description =
[ "The lifetime of the access token, in milliseconds. Once the access token has expired a new access token can be obtained by using the provided refresh token. If no refresh token is provided, the client will need to re-log in to obtain a new access token. If not given, the client can assume that the access token will not expire. "
]
, coder = Json.int
}
)
(Json.field.optional.value
{ fieldName = "home_server"
, toField = .homeserver
, description =
[ "The hostname of the homeserver on which the account has been registered."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "refresh_token"
, toField = .refreshToken
, description =
[ "A refresh token for the account. This token can be used to obtain a new access token when it expires by calling the /refresh endpoint."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "user_id"
, toField = .user
, description =
[ "The fully-qualified Matrix ID that has been registered."
]
, coder = User.coder
}
)
(Json.field.optional.value
{ fieldName = "well_known"
, toField = .wellKnown
, description =
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
]
, coder = disoveryInformationCoderV1
}
)
coderV6 : Json.Coder LoginWithUsernameAndPasswordOutputV6
coderV6 =
Json.object7
{ name = "Login Response"
, description =
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
, "https://spec.matrix.org/v1.3/client-server-api/#post_matrixclientv3login"
]
, init = LoginWithUsernameAndPasswordOutputV6
}
(Json.field.required
{ fieldName = "access_token"
, toField = .accessToken
, description =
[ "An access token for the account. This access token can then be used to authorize other requests."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "device_id"
, toField = .deviceId
, description =
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "expires_in_ms"
, toField = .expiresInMs
, description =
[ "The lifetime of the access token, in milliseconds. Once the access token has expired a new access token can be obtained by using the provided refresh token. If no refresh token is provided, the client will need to re-log in to obtain a new access token. If not given, the client can assume that the access token will not expire. "
]
, coder = Json.int
}
)
(Json.field.optional.value
{ fieldName = "home_server"
, toField = .homeserver
, description =
[ "The hostname of the homeserver on which the account has been registered."
]
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "refresh_token"
, toField = .refreshToken
, description =
[ "A refresh token for the account. This token can be used to obtain a new access token when it expires by calling the /refresh endpoint."
]
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "user_id"
, toField = .user
, description =
[ "The fully-qualified Matrix ID that has been registered."
]
, coder = User.coder
}
)
(Json.field.optional.value
{ fieldName = "well_known"
, toField = .wellKnown
, description =
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
]
, coder = disoveryInformationCoderV1
}
)
disoveryInformationCoderV1 : Json.Coder DiscoveryInformationV1
disoveryInformationCoderV1 =
Json.object2
{ name = "Discovery Information"
, description =
[ "Gets discovery information about the domain. The file may include additional keys, which MUST follow the Java package naming convention, e.g. com.example.myapp.property. This ensures property names are suitably namespaced for each application and reduces the risk of clashes."
, "Note that this endpoint is not necessarily handled by the homeserver, but by another webserver, to be used for discovering the homeserver URL."
, "https://spec.matrix.org/v1.10/client-server-api/#getwell-knownmatrixclient"
]
, init = DiscoveryInformationV1
}
(Json.field.required
{ fieldName = "m.homeserver"
, toField = .homeserver
, coder =
Json.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = HomeserverInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover homeserver information."
]
}
)
(Json.field.optional.value
{ fieldName = "m.identity_server"
, toField = .identityServer
, coder =
Json.object1
{ name = "Homeserver Information"
, description =
[ "Used by clients to discover homeserver information."
]
, init = HomeserverInformation
}
(Json.field.required
{ fieldName = "base_url"
, toField = .baseUrl
, description =
[ "The base URL for the homeserver for client-server connections."
]
, coder = Json.string
}
)
, description =
[ "Used by clients to discover identity server information."
]
}
)

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

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

View File

@ -0,0 +1,40 @@
module Internal.Api.Now.Api exposing (getNow)
{-|
# Now
Get the current time.
@docs getNow
-}
import Internal.Api.Api as A
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Values.Context as Context
import Internal.Values.Envelope as E
import Task
import Time
{-| Get the current time and place it in the context.
-}
getNow : A.TaskChain a { a | now : () }
getNow =
\_ ->
Task.map
(\now ->
{ messages = [ E.SetNow now ]
, logs =
now
|> Time.posixToMillis
|> Text.logs.getNow
|> log.debug
|> List.singleton
, contextChange = Context.setNow now
}
)
Time.now

View File

@ -0,0 +1,613 @@
module Internal.Api.Request exposing
( ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
, Request, Error(..)
, accessToken, timeout, onStatusCode
, fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
, queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
)
{-|
# API module
This module helps describe API requests.
## Plan
@docs ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
Sometimes, APIs might fail. As a result, you may receive an error.
@docs Request, Error
## API attributes
### General attributes
@docs accessToken, timeout, onStatusCode
### Body
@docs fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
### Query parameters
@docs queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
-}
import Dict
import Http
import Internal.Api.Chain as C
import Internal.Config.Log exposing (Log, log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (APIContext)
import Json.Decode as D
import Json.Encode as E
import Task
import Url
import Url.Builder as UrlBuilder
{-| The API call is a plan that describes how an interaction is planned with
the Matrix API.
-}
type alias ApiCall ph =
{ attributes : List ContextAttr
, baseUrl : String
, context : APIContext ph
, method : String
, path : List String
}
{-| Shortcut definition to define a function that bases an APICall on a given
APIContext.
-}
type alias ApiPlan a =
APIContext a -> ApiCall a
{-| An attribute maps a given context to an attribute for an API call.
-}
type alias Attribute a =
APIContext a -> ContextAttr
{-| A context attribute describes one aspect of the API call that is to be made.
-}
type ContextAttr
= BodyParam String Json.Value
| FullBody Json.Value
| Header Http.Header
| NoAttr
| QueryParam UrlBuilder.QueryParameter
| StatusCodeResponse Int ( Error, List Log )
| Timeout Float
{-| Error indicating that something went wrong.
-}
type Error
= InternetException Http.Error
| MissingUsername
| MissingPassword
| NoSupportedVersion
| ServerReturnsBadJSON String
| ServerReturnsError String Json.Value
{-| Ordinary shape of an HTTP request.
-}
type alias Request x a =
{ headers : List Http.Header
, body : Http.Body
, method : String
, url : String
, resolver : Http.Resolver x a
, timeout : Maybe Float
}
{-| Attribute that requires an access token to be present
-}
accessToken : Attribute { a | accessToken : () }
accessToken =
Context.getAccessToken
>> (++) "Bearer "
>> Http.header "Authorization"
>> Header
{-| Attribute that adds a boolean value to the HTTP body.
-}
bodyBool : String -> Bool -> Attribute a
bodyBool key value =
bodyValue key <| Json.encode Json.bool value
{-| Attribute that adds an integer value to the HTTP body.
-}
bodyInt : String -> Int -> Attribute a
bodyInt key value =
bodyValue key <| Json.encode Json.int value
{-| Attribute that adds a boolean to the HTTP body if it is given.
-}
bodyOpBool : String -> Maybe Bool -> Attribute a
bodyOpBool key value =
case value of
Just v ->
bodyBool key v
Nothing ->
empty
{-| Attribute that adds an integer value to the HTTP body if it is given.
-}
bodyOpInt : String -> Maybe Int -> Attribute a
bodyOpInt key value =
case value of
Just v ->
bodyInt key v
Nothing ->
empty
{-| Attribute that adds a string value to the HTTP body if it is given.
-}
bodyOpString : String -> Maybe String -> Attribute a
bodyOpString key value =
case value of
Just v ->
bodyString key v
Nothing ->
empty
{-| Attribute that adds a JSON value to the HTTP body if it is given.
-}
bodyOpValue : String -> Maybe Json.Value -> Attribute a
bodyOpValue key value =
case value of
Just v ->
bodyValue key v
Nothing ->
empty
{-| Attribute that adds a string value to the HTTP body.
-}
bodyString : String -> String -> Attribute a
bodyString key value =
bodyValue key <| Json.encode Json.string value
{-| Attribute that adds a JSON value to the HTTP body.
-}
bodyValue : String -> Json.Value -> Attribute a
bodyValue key value _ =
BodyParam key value
{-| Create a plan to create an API call.
-}
callAPI : { method : String, path : List String } -> ApiPlan { a | baseUrl : () }
callAPI { method, path } context =
{ attributes = []
, baseUrl = Context.getBaseUrl context
, context = context
, method = method
, path = path
}
{-| Decode the server's response into (hopefully) something meaningful.
-}
decodeServerResponse : D.Decoder ( a, List Log ) -> String -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
decodeServerResponse decoder body statusCodeError =
case D.decodeString D.value body of
Err e ->
let
description : String
description =
D.errorToString e
in
Err
( ServerReturnsBadJSON description
, description
|> Text.logs.serverReturnedInvalidJSON
|> log.error
|> List.singleton
)
Ok v ->
decodeServerValue decoder v statusCodeError
{-| Decode the server's response, assuming that it parses correctly to
a JSON value.
-}
decodeServerValue : D.Decoder ( a, List Log ) -> Json.Value -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
decodeServerValue decoder value statusCodeError =
value
|> D.decodeValue decoder
|> Result.mapError
(\err ->
let
description : String
description =
D.errorToString err
-- TODO: Parse errors returned by Matrix API
error : Maybe ( Error, List Log )
error =
Nothing
in
case ( error, statusCodeError ) of
( Just e, _ ) ->
e
( Nothing, Just e ) ->
e
( Nothing, Nothing ) ->
( ServerReturnsBadJSON description
, description
|> Text.logs.serverReturnedUnknownJSON
|> log.error
|> List.singleton
)
)
{-| Add an empty attribute that does nothing.
-}
empty : Attribute a
empty =
always NoAttr
{-| Adds a JSON value as the HTTP body.
-}
fullBody : Json.Value -> Attribute a
fullBody value _ =
FullBody value
getBody : List ContextAttr -> Maybe Json.Value
getBody attributes =
attributes
|> List.filterMap
(\attr ->
case attr of
FullBody v ->
Just v
_ ->
Nothing
)
|> List.reverse
|> List.head
|> (\fb ->
case fb of
Just _ ->
fb
Nothing ->
case
List.filterMap
(\attr ->
case attr of
BodyParam key value ->
Just ( key, value )
_ ->
Nothing
)
attributes
of
[] ->
Nothing
head :: tail ->
Just <| E.object (head :: tail)
)
getHeaders : List ContextAttr -> List Http.Header
getHeaders =
List.filterMap
(\attr ->
case attr of
Header h ->
Just h
_ ->
Nothing
)
getQueryParams : List ContextAttr -> List UrlBuilder.QueryParameter
getQueryParams =
List.filterMap
(\attr ->
case attr of
QueryParam q ->
Just q
_ ->
Nothing
)
getStatusCodes : List ContextAttr -> Dict.Dict Int ( Error, List Log )
getStatusCodes =
List.filterMap
(\attr ->
case attr of
StatusCodeResponse code err ->
Just ( code, err )
_ ->
Nothing
)
>> Dict.fromList
getTimeout : List ContextAttr -> Maybe Float
getTimeout =
List.filterMap
(\attr ->
case attr of
Timeout f ->
Just f
_ ->
Nothing
)
>> List.reverse
>> List.head
getUrl : ApiCall a -> String
getUrl { attributes, baseUrl, path } =
UrlBuilder.crossOrigin
baseUrl
(List.map Url.percentEncode path)
(getQueryParams attributes)
{-| When the HTTP request cannot be deciphered but the status code is known,
return with a given default error.
-}
onStatusCode : Int -> String -> Attribute a
onStatusCode code err _ =
StatusCodeResponse code
( err
|> E.string
|> Tuple.pair "errcode"
|> List.singleton
|> E.object
|> ServerReturnsError err
, String.concat
-- TODO: Move to Internal.Config.Text
[ "Received an invalid HTTP response from Matrix server "
, "but managed to decode it using the status code "
, String.fromInt code
, ": Default to errcode "
, err
]
|> log.warn
|> List.singleton
)
{-| Add a boolean value as a query parameter to the URL.
-}
queryBool : String -> Bool -> Attribute a
queryBool key value _ =
(if value then
"true"
else
"false"
)
|> UrlBuilder.string key
|> QueryParam
{-| Add an integer value as a query parameter to the URL.
-}
queryInt : String -> Int -> Attribute a
queryInt key value _ =
QueryParam <| UrlBuilder.int key value
{-| Add a boolean value as a query parameter to the URL if it exists.
-}
queryOpBool : String -> Maybe Bool -> Attribute a
queryOpBool key value =
case value of
Just v ->
queryBool key v
Nothing ->
empty
{-| Add an integer value as a query parameter to the URL if it exists.
-}
queryOpInt : String -> Maybe Int -> Attribute a
queryOpInt key value =
case value of
Just v ->
queryInt key v
Nothing ->
empty
{-| Add a string value as a query parameter to the URL if it exists.
-}
queryOpString : String -> Maybe String -> Attribute a
queryOpString key value =
case value of
Just v ->
queryString key v
Nothing ->
empty
{-| Add a string value as a query parameter to the URL.
-}
queryString : String -> String -> Attribute a
queryString key value _ =
QueryParam <| UrlBuilder.string key value
{-| Resolve the response of a Matrix API call.
-}
rawApiCallResolver : D.Decoder ( a, List Log ) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
rawApiCallResolver decoder statusCodeErrors =
Http.stringResolver
(\response ->
case response of
Http.BadUrl_ s ->
Http.BadUrl s
|> InternetException
|> Tuple.pair
|> (|>) [ log.error ("Encountered bad URL " ++ s) ]
|> Err
Http.Timeout_ ->
Http.Timeout
|> InternetException
|> Tuple.pair
|> (|>) [ log.error "Encountered timeout - maybe the server is down?" ]
|> Err
Http.NetworkError_ ->
Http.NetworkError
|> InternetException
|> Tuple.pair
|> (|>) [ log.error "Encountered a network error - the user might be offline" ]
|> Err
Http.BadStatus_ metadata body ->
statusCodeErrors
|> Dict.get metadata.statusCode
|> decodeServerResponse decoder body
Http.GoodStatus_ metadata body ->
statusCodeErrors
|> Dict.get metadata.statusCode
|> decodeServerResponse decoder body
)
{-| Configure the HTTP request to time out after a given expiry time.
-}
timeout : Float -> Attribute a
timeout f _ =
Timeout f
{-| Transform an APICall to a TaskChain.
-}
toChain :
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
, coder : Json.Coder httpOut
, request : ApiPlan ph1
, toContextChange : httpOut -> (APIContext ph1 -> APIContext ph2)
, toUpdate : httpOut -> ( update, List Log )
}
-> C.TaskChain Error update ph1 ph2
toChain data apiContext =
data.request apiContext
|> (\call ->
let
r : Request ( Error, List Log ) ( httpOut, List Log )
r =
{ method = call.method
, headers = getHeaders call.attributes
, url = getUrl call
, body =
getBody call.attributes
|> Maybe.map Http.jsonBody
|> Maybe.withDefault Http.emptyBody
, resolver = rawApiCallResolver (Json.decode data.coder) (getStatusCodes call.attributes)
, timeout = getTimeout call.attributes
}
logR : Request ( Error, List Log ) ( update, List Log )
logR =
{ method = call.method
, headers = getHeaders call.attributes
, url = getUrl call
, body =
getBody call.attributes
|> Maybe.map Http.jsonBody
|> Maybe.withDefault Http.emptyBody
, resolver =
rawApiCallResolver
(Json.decode data.coder
|> D.map
(\( out, logs ) ->
case data.toUpdate out of
( u, uLogs ) ->
( u, List.append logs uLogs )
)
)
(getStatusCodes call.attributes)
, timeout = getTimeout call.attributes
}
in
case data.logHttp logR of
( httpU, httpLogs ) ->
Http.task r
|> Task.map
(\( httpO, logs ) ->
case data.toUpdate httpO of
( u, uLogs ) ->
{ contextChange = data.toContextChange httpO
, logs = List.concat [ httpLogs, logs, uLogs ]
, messages = [ httpU, u ]
}
)
|> Task.mapError
(\( err, logs ) ->
{ error = err
, logs = List.append httpLogs logs
, messages = [ httpU ]
}
)
)
{-| Add more attributes to the API plan.
-}
withAttributes : List (Attribute a) -> ApiPlan a -> ApiPlan a
withAttributes attrs f context =
f context
|> (\data ->
{ data
| attributes =
attrs
|> List.map (\attr -> attr data.context)
|> List.append data.attributes
}
)

View File

@ -0,0 +1,180 @@
module Internal.Api.SendMessageEvent.Api exposing (Phantom, sendMessageEvent)
{-|
# Send message event
This module helps send message events to rooms on the Matrix API.
@docs Phantom, sendMessageEvent
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
{-| Send a message event to the Matrix room.
-}
sendMessageEvent : SendMessageEventInput -> A.TaskChain (Phantom a) (Phantom a)
sendMessageEvent =
A.startWithVersion "r0.0.0" sendMessageEventV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.forVersion "r0.6.1" sendMessageEventV2
|> A.forVersion "v1.1" sendMessageEventV3
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
{-| Context needed for sending a message event
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SendMessageEventInput =
{ content : Json.Value
, eventType : String
, roomId : String
, transactionId : String
}
type alias SendMessageEventInputV1 a =
{ a
| content : Json.Value
, eventType : String
, roomId : String
, transactionId : String
}
type alias SendMessageEventOutputV1 =
{ eventId : Maybe String }
type alias SendMessageEventOutputV2 =
{ eventId : String }
sendMessageEventV1 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendMessageEventV1 { content, eventType, roomId, transactionId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "send", eventType, transactionId ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
sendMessageEventV2 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendMessageEventV2 { content, eventType, roomId, transactionId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "send", eventType, transactionId ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
sendMessageEventV3 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendMessageEventV3 { content, eventType, roomId, transactionId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "send", eventType, transactionId ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
coderV1 : Json.Coder SendMessageEventOutputV1
coderV1 =
Json.object1
{ name = "EventResponse"
, description =
[ "This endpoint is used to send a message event to a room. Message events allow access to historical events and pagination, making them suited for \"once-off\" activity in a room."
, "The body of the request should be the content object of the event; the fields in this object will vary depending on the type of event."
, "https://spec.matrix.org/legacy/r0.0.0/client_server.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
]
, init = SendMessageEventOutputV1
}
(Json.field.optional.value
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)
coderV2 : Json.Coder SendMessageEventOutputV2
coderV2 =
Json.object1
{ name = "EventResponse"
, description =
[ "This endpoint is used to send a message event to a room. Message events allow access to historical events and pagination, making them suited for \"once-off\" activity in a room."
, "The body of the request should be the content object of the event; the fields in this object will vary depending on the type of event."
, "https://spec.matrix.org/legacy/client_server/r0.6.1.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
]
, init = SendMessageEventOutputV2
}
(Json.field.required
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)

View File

@ -0,0 +1,176 @@
module Internal.Api.SendStateEvent.Api exposing (..)
{-|
# Send state event
This module sends state events to Matrix rooms.
@docs Phantom, sendStateEvent
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
{-| Send a state event to a Matrix room.
-}
sendStateEvent : SendStateEventInput -> A.TaskChain (Phantom a) (Phantom a)
sendStateEvent =
A.startWithVersion "r0.0.0" sendStateEventV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.forVersion "r0.6.1" sendStateEventV2
|> A.forVersion "v1.1" sendStateEventV3
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
{-| Context needed for sending a state event
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SendStateEventInput =
{ content : Json.Value
, eventType : String
, roomId : String
, stateKey : String
}
type alias SendStateEventInputV1 a =
{ a
| content : Json.Value
, eventType : String
, roomId : String
, stateKey : String
}
type alias SendStateEventOutputV1 =
{ eventId : Maybe String }
type alias SendStateEventOutputV2 =
{ eventId : String }
sendStateEventV1 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendStateEventV1 { content, eventType, roomId, stateKey } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
sendStateEventV2 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendStateEventV2 { content, eventType, roomId, stateKey } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
sendStateEventV3 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendStateEventV3 { content, eventType, roomId, stateKey } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "rooms", roomId, "state", eventType, stateKey ]
, toUpdate =
\out ->
( E.More []
, out.eventId
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
}
coderV1 : Json.Coder SendStateEventOutputV1
coderV1 =
Json.object1
{ name = "EventResponse"
, description =
[ "This object is returned after a state event has been sent."
]
, init = SendStateEventOutputV1
}
(Json.field.optional.value
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)
coderV2 : Json.Coder SendStateEventOutputV2
coderV2 =
Json.object1
{ name = "EventResponse"
, description =
[ "This object is returned after a state event has been sent."
]
, init = SendStateEventOutputV2
}
(Json.field.required
{ fieldName = "event_id"
, toField = .eventId
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)

View File

@ -0,0 +1,107 @@
module Internal.Api.SetAccountData.Api exposing (Phantom, setAccountData)
{-|
# Set Account Data
This module allows the developer to set global account data.
@docs Phantom, setAccountData
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as R
import Internal.Values.Vault as V
setAccountData : SetAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
setAccountData =
A.startWithVersion "r0.0.0" setAccountDataV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" setAccountDataV2
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
{-| Context needed for setting global account data.
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SetAccountDataInput =
{ content : Json.Value, eventType : String, userId : String }
type alias SetAccountDataInputV1 a =
{ a | content : Json.Value, eventType : String, userId : String }
type alias SetAccountDataOutput =
()
setAccountDataV1 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setAccountDataV1 { content, eventType, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "user", userId, "account_data", eventType ]
, toUpdate =
\() ->
( V.SetAccountData eventType content
|> E.ContentUpdate
, []
)
}
setAccountDataV2 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setAccountDataV2 { content, eventType, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "user", userId, "account_data", eventType ]
, toUpdate =
\() ->
( V.SetAccountData eventType content
|> E.ContentUpdate
, []
)
}
coderV1 : Json.Coder SetAccountDataOutput
coderV1 =
Json.unit

View File

@ -0,0 +1,111 @@
module Internal.Api.SetRoomAccountData.Api exposing (..)
{-|
# Set Room Account Data
This module allows the developer to set account data to a Matrix room.
@docs Phantom, setRoomAccountData
-}
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as R
import Internal.Values.Vault as V
{-| Set account data to a Matrix room.
-}
setRoomAccountData : SetRoomAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
setRoomAccountData =
A.startWithVersion "r0.0.0" setRoomAccountDataV1
|> A.sameForVersion "r0.0.1"
|> A.sameForVersion "r0.1.0"
|> A.sameForVersion "r0.2.0"
|> A.sameForVersion "r0.3.0"
|> A.sameForVersion "r0.4.0"
|> A.sameForVersion "r0.5.0"
|> A.sameForVersion "r0.6.0"
|> A.sameForVersion "r0.6.1"
|> A.forVersion "v1.1" setRoomAccountDataV2
|> A.sameForVersion "v1.2"
|> A.sameForVersion "v1.3"
|> A.sameForVersion "v1.4"
|> A.sameForVersion "v1.5"
|> A.sameForVersion "v1.6"
|> A.sameForVersion "v1.7"
|> A.sameForVersion "v1.8"
|> A.sameForVersion "v1.9"
|> A.sameForVersion "v1.10"
|> A.sameForVersion "v1.11"
|> A.versionChain
{-| Context needed for setting account data on a room.
-}
type alias Phantom a =
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
{ a | accessToken : (), baseUrl : () }
type alias SetRoomAccountDataInput =
{ content : Json.Value, eventType : String, roomId : String, userId : String }
type alias SetRoomAccountDataInputV1 a =
{ a | content : Json.Value, eventType : String, roomId : String, userId : String }
type alias SetRoomAccountDataOutputV1 =
()
setRoomAccountDataV1 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setRoomAccountDataV1 { content, eventType, roomId, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "r0", "user", userId, "rooms", roomId, "account_data", eventType ]
, toUpdate =
\() ->
( R.SetAccountData eventType content
|> V.MapRoom roomId
|> E.ContentUpdate
, []
)
}
setRoomAccountDataV2 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
setRoomAccountDataV2 { content, eventType, roomId, userId } =
A.request
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
, path = [ "_matrix", "client", "v3", "user", userId, "rooms", roomId, "account_data", eventType ]
, toUpdate =
\() ->
( R.SetAccountData eventType content
|> V.MapRoom roomId
|> E.ContentUpdate
, []
)
}
coderV1 : Json.Coder SetRoomAccountDataOutputV1
coderV1 =
Json.unit

View File

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

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

File diff suppressed because it is too large Load Diff

View File

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

View File

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

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

File diff suppressed because it is too large Load Diff

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

@ -0,0 +1,318 @@
module Internal.Api.Task exposing
( Task, run, Backpack
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
)
{-|
# Task module
This module is used to define how API calls are made. These completed API tasks
can be directly converted to Cmd types that the end user of the SDK can access.
These tasks do not affect the `Vault` directly, but instead, return a
`VaultUpdate` type that the user can apply to keep their `Vault` type
up-to-date.
## Use
@docs Task, run, Backpack
## Tasks
@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
-}
import Internal.Api.BanUser.Api
import Internal.Api.BaseUrl.Api
import Internal.Api.Chain as C
import Internal.Api.InviteUser.Api
import Internal.Api.KickUser.Api
import Internal.Api.LoginWithUsernameAndPassword.Api
import Internal.Api.Now.Api
import Internal.Api.Request as Request
import Internal.Api.SendMessageEvent.Api
import Internal.Api.SendStateEvent.Api
import Internal.Api.SetAccountData.Api
import Internal.Api.SetRoomAccountData.Api
import Internal.Api.Sync.Api
import Internal.Api.Versions.Api
import Internal.Config.Log exposing (Log, log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (APIContext)
import Internal.Values.Envelope as E exposing (EnvelopeUpdate(..))
import Internal.Values.Room exposing (RoomUpdate(..))
import Internal.Values.User exposing (User)
import Internal.Values.Vault exposing (VaultUpdate(..))
import Task
{-| A Backpack is the ultimate message type that gets sent back by the Elm
runtime, which can be accessed, viewed and inspected.
-}
type alias Backpack =
{ messages : List (EnvelopeUpdate VaultUpdate), logs : List Log }
{-| A Task is a task that is ready to be sent to the outside world.
-}
type alias Task =
C.TaskChain Never (EnvelopeUpdate VaultUpdate) {} {}
{-| An UnFinished Task that is used somewhere else in this module to write a
complete Task type.
-}
type alias UFTask a b =
C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b
{-| Ban a user from a room.
-}
banUser : { reason : Maybe String, roomId : String, user : User } -> Task
banUser input =
makeVBA
|> C.andThen (Internal.Api.BanUser.Api.banUser input)
|> finishTask
{-| Get an access token to talk to the Matrix API
-}
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
getAccessToken c =
case Context.fromApiFormat c of
context ->
case ( Context.mostPopularToken context, context.username, context.password ) of
( Just a, _, _ ) ->
C.succeed
{ messages = []
, logs = [ log.debug "Using cached access token from Vault" ]
, contextChange = Context.setAccessToken a
}
c
( Nothing, Just u, Just p ) ->
Internal.Api.LoginWithUsernameAndPassword.Api.loginWithUsernameAndPassword
{ deviceId = Context.fromApiFormat c |> .deviceId
, enableRefreshToken = Just True -- TODO: Turn this into a setting
, initialDeviceDisplayName = Nothing -- TODO: Turn this into a setting
, password = p
, username = u
}
c
( Nothing, Nothing, _ ) ->
C.fail Request.MissingUsername c
( Nothing, Just _, Nothing ) ->
C.fail Request.MissingPassword c
{-| Get the base URL where the Matrix API can be accessed
-}
getBaseUrl : UFTask a { a | baseUrl : () }
getBaseUrl c =
case Context.fromApiFormat c |> .baseUrl of
Just b ->
C.succeed
{ messages = []
, logs = [ log.debug "Using cached baseURL from Vault" ]
, contextChange = Context.setBaseUrl b
}
c
Nothing ->
Internal.Api.BaseUrl.Api.baseUrl
{ url = Context.fromApiFormat c |> .serverName }
|> C.catchWith
(\_ ->
let
url : String
url =
Context.fromApiFormat c
|> .serverName
in
{ contextChange = Context.setBaseUrl url
, logs = [ log.warn (Text.logs.baseUrlFailed url) ]
, messages = [ E.SetBaseUrl url ]
}
)
|> (|>) c
{-| Get the current timestamp
-}
getNow : UFTask { a | baseUrl : () } { a | baseUrl : (), now : () }
getNow =
Internal.Api.Now.Api.getNow
{-| Get the versions that are potentially supported by the Matrix API
-}
getVersions : UFTask { a | baseUrl : () } { a | baseUrl : (), versions : () }
getVersions c =
case Context.fromApiFormat c |> .versions of
Just v ->
C.succeed
{ messages = []
, logs = [ log.debug "Using cached versions from Vault" ]
, contextChange = Context.setVersions v
}
c
Nothing ->
Internal.Api.Versions.Api.versions c
finishTask : UFTask {} b -> Task
finishTask uftask =
uftask
|> C.andThen
(C.succeed
{ messages = []
, logs = []
, contextChange = Context.reset
}
)
|> C.catchWith
(\e ->
case e of
Request.MissingPassword ->
{ messages = []
, logs = [ log.error "Cannot log in - password is missing" ]
, contextChange = Context.reset
}
Request.MissingUsername ->
{ messages = []
, logs = [ log.error "Cannot log in - username is missing" ]
, contextChange = Context.reset
}
Request.NoSupportedVersion ->
{ messages = []
, logs = [ log.error "No supported version is available to complete the API interaction." ]
, contextChange = Context.reset
}
Request.ServerReturnsBadJSON t ->
{ messages = []
, logs = [ log.error ("The server returned invalid JSON: " ++ t) ]
, contextChange = Context.reset
}
Request.ServerReturnsError name _ ->
{ messages = []
, logs = [ log.error ("The server returns an error: " ++ name) ]
, contextChange = Context.reset
}
_ ->
{ messages = [] -- TODO: Maybe categorize errors?
, logs = [ log.warn "Encountered unhandled error" ]
, contextChange = Context.reset
}
)
{-| Invite a user to a room.
-}
inviteUser : { reason : Maybe String, roomId : String, user : User } -> Task
inviteUser input =
makeVBA
|> C.andThen (Internal.Api.InviteUser.Api.inviteUser input)
|> finishTask
{-| Kick a user from a room.
-}
kickUser :
{ avatarUrl : Maybe String
, displayname : Maybe String
, reason : Maybe String
, roomId : String
, user : User
}
-> Task
kickUser input =
makeVBA
|> C.andThen (Internal.Api.KickUser.Api.kickUser input)
|> finishTask
{-| Establish a Task Chain context where the base URL and supported list of
versions are known.
-}
makeVB : UFTask a { a | baseUrl : (), versions : () }
makeVB =
C.andThen getVersions getBaseUrl
{-| Establish a Task Chain context where the base URL and supported list of
versions are known, and where an access token is available to make an
authenticated API call.
-}
makeVBA : UFTask a { a | accessToken : (), baseUrl : (), now : (), versions : () }
makeVBA =
makeVB
|> C.andThen getNow
|> C.andThen getAccessToken
{-| Send a message event to a room.
-}
sendMessageEvent : { content : Json.Value, eventType : String, roomId : String, transactionId : String } -> Task
sendMessageEvent input =
makeVBA
|> C.andThen (Internal.Api.SendMessageEvent.Api.sendMessageEvent input)
|> finishTask
{-| Send a state event to a room.
-}
sendStateEvent : { content : Json.Value, eventType : String, roomId : String, stateKey : String } -> Task
sendStateEvent input =
makeVBA
|> C.andThen (Internal.Api.SendStateEvent.Api.sendStateEvent input)
|> finishTask
{-| Set global account data.
-}
setAccountData : { content : Json.Value, eventType : String, userId : String } -> Task
setAccountData input =
makeVBA
|> C.andThen (Internal.Api.SetAccountData.Api.setAccountData input)
|> finishTask
{-| Set account data for a Matrix room.
-}
setRoomAccountData : { content : Json.Value, eventType : String, roomId : String, userId : String } -> Task
setRoomAccountData input =
makeVBA
|> C.andThen (Internal.Api.SetRoomAccountData.Api.setRoomAccountData input)
|> finishTask
{-| Sync with the Matrix API to stay up-to-date.
-}
sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task
sync input =
makeVBA
|> C.andThen (Internal.Api.Sync.Api.sync input)
|> finishTask
{-| Transform a completed task into a Cmd.
-}
run : (Backpack -> msg) -> Task -> APIContext {} -> Cmd msg
run toMsg task context =
context
|> C.toTask task
|> Task.perform toMsg

View File

@ -0,0 +1,90 @@
module Internal.Api.Versions.Api exposing (versions, Phantom)
{-|
# Versions
Ask the Matrix API which versions it supports.
@docs versions, Phantom
-}
import Dict
import Internal.Api.Api as A
import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (Versions)
import Internal.Values.Envelope as E
import Set
{-| Task chain to ask which spec versions the Matrix API supports.
-}
versions : A.TaskChain (Phantom ph) (Phantom { ph | versions : () })
versions =
A.request
{ attributes = []
, coder = versionsCoder
, contextChange = Context.setVersions
, method = "GET"
, path = [ "_matrix", "client", "versions" ]
, toUpdate = \v -> ( E.SetVersions v, [] )
}
{-| Context needed for asking the server's available spec versions
-}
type alias Phantom a =
{ a | baseUrl : () }
versionsCoder : Json.Coder Versions
versionsCoder =
Json.object2
{ name = "Versions"
, description =
[ "Gets the versions of the specification supported by the server."
, "Values will take the form vX.Y or rX.Y.Z in historical cases. See the Specification Versioning for more information."
, "The server may additionally advertise experimental features it supports through unstable_features. These features should be namespaced and may optionally include version information within their name if desired. Features listed here are not for optionally toggling parts of the Matrix specification and should only be used to advertise support for a feature which has not yet landed in the spec. For example, a feature currently undergoing the proposal process may appear here and eventually be taken off this list once the feature lands in the spec and the server deems it reasonable to do so. Servers can choose to enable some features only for some users, so clients should include authentication in the request to get all the features available for the logged-in user. If no authentication is provided, the server should only return the features available to all users. Servers may wish to keep advertising features here after theyve been released into the spec to give clients a chance to upgrade appropriately. Additionally, clients should avoid using unstable features in their stable releases."
]
, init = Versions
}
(Json.field.required
{ fieldName = "versions"
, toField = .versions
, description =
[ "The supported versions."
]
, coder = Json.list Json.string
}
)
(Json.field.optional.withDefault
{ fieldName = "unstable_features"
, toField = .unstableFeatures
, description =
[ "Experimental features the server supports. Features not listed here, or the lack of this property all together, indicate that a feature is not supported."
]
, coder =
Json.bool
|> Json.slowDict
|> Json.map
{ name = "Dict to set"
, description =
[ "Turn a dictionary of supported values into a set that contains only supported values"
]
, back = Set.foldl (\k d -> Dict.insert k True d) Dict.empty
, forth =
Dict.foldl
(\k v s ->
if v then
Set.insert k s
else
s
)
Set.empty
}
, default = ( Set.empty, [] )
}
)

View File

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

View File

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

105
src/Internal/Config/Log.elm Normal file
View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

1487
src/Internal/Tools/Json.elm Normal file

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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, [] )
}
)

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,20 +1,255 @@
module Matrix exposing (Vault)
{-| # Matrix SDK
module Matrix exposing
( 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
the public registry, but it is also generally quite unusual to exclusively
support a monolithic public registry. (:
## Vault
@docs Vault
@docs Vault, fromUserId, fromUsername
## Keeping the Vault up-to-date
@docs VaultUpdate, update, sync, logs
## Exploring the Vault
@docs rooms, fromRoomId
## Account data
@docs getAccountData, setAccountData
## Debugging
@docs addAccessToken, sendMessageEvent
-}
import Internal.Api.Main as Api
import Internal.Values.Envelope as Envelope
import Internal.Values.User as User
import Internal.Values.Vault as Internal
import Json.Encode as E
import Types exposing (Vault(..), VaultUpdate(..))
{-| The Vault type stores all relevant information about the Matrix API.
It currently supports no functionality and it will just stay here - for fun.
If you make sure that the data type stays up-to-date, you can use it to explore
the latest information about an account.
-}
type 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

144
src/Matrix/Event.elm Normal file
View File

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

214
src/Matrix/Room.elm Normal file
View File

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

153
src/Matrix/Settings.elm Normal file
View File

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

147
src/Matrix/User.elm Normal file
View File

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

54
src/Types.elm Normal file
View File

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

View File

@ -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, [] ))
)
]
]

View File

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

View File

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

View File

@ -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" []
]

View File

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

499
tests/Test/Tools/Json.elm Normal file
View File

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

View File

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

View File

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

17
tests/Test/Types.elm Normal file
View File

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

View File

@ -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, [] ))
-- )
-- ]

View File

@ -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, [] ))
-- )
-- ]
]

View File

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

105
tests/Test/Values/Room.elm Normal file
View File

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

View File

@ -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, [] ))
)
]
]

View File

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

View File

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

View File

@ -0,0 +1,13 @@
module Test.Values.User exposing (..)
import Fuzz exposing (Fuzzer)
import Internal.Grammar.ServerName as SN
import Internal.Values.User exposing (User)
fuzzer : Fuzzer User
fuzzer =
Fuzz.constant
{ localpart = "temporary"
, domain = { host = SN.DNS "matrix.org", port_ = Nothing }
}

View File

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