Compare commits
115 Commits
Author | SHA1 | Date |
---|---|---|
|
1701904144 | |
|
e42ff71809 | |
|
c6d388bff6 | |
|
a336c8b057 | |
|
8d28fe63b9 | |
|
a8d879afbb | |
|
61a8e18714 | |
|
a2582f36f9 | |
|
41bee45693 | |
|
3566d3ee7a | |
|
8b2db7bff6 | |
|
5319f47145 | |
|
87ebcbcd21 | |
|
0521ca2f3e | |
|
fee68f7e0f | |
|
7b615c6452 | |
|
07c34c3530 | |
|
1ed9fa7d22 | |
|
cacb876a95 | |
|
20504d4a8b | |
|
a401c25a47 | |
|
f3799add87 | |
|
eb8d90ab8b | |
|
1736679e0f | |
|
31817ed545 | |
|
899088d63c | |
|
48e5eae327 | |
|
90eb06f3a1 | |
|
a9e4a39e7f | |
|
d7a7fa385c | |
|
c7204c4c41 | |
|
c473d60161 | |
|
41ec76822f | |
|
458ea59425 | |
|
1eb07377fd | |
|
39f8021a8f | |
|
1aecb1116a | |
|
8a3b7efbf6 | |
|
005e103389 | |
|
4e378a5f50 | |
|
0978e43fc0 | |
|
632158f309 | |
|
c5d07f0a94 | |
|
b239eecc6b | |
|
e7d3a129b1 | |
|
e122a7b262 | |
|
29906ff976 | |
|
80bb05fd30 | |
|
1d0a9de7da | |
|
a95fbbb856 | |
|
95f0aa2934 | |
|
7ab21b4314 | |
|
0092f96a25 | |
|
6300d15edf | |
|
17a1d1af3e | |
|
61dad6c5e8 | |
|
693124aa15 | |
|
6783186c18 | |
|
0ded7ab6bd | |
|
f6a6bb535e | |
|
76cc6d46b9 | |
|
425d964af5 | |
|
21ae0ea376 | |
|
7b00a46ffa | |
|
f714438dd4 | |
|
a514497406 | |
|
306d8e2f93 | |
|
f7837a91c8 | |
|
d360c561f9 | |
|
acd4a07d5e | |
|
1de9566e1d | |
|
85d767414d | |
|
994c99af15 | |
|
b465ad1f47 | |
|
e8c0df004e | |
|
c5e546b25c | |
|
bec1ae4a3b | |
|
daf4bcb1b1 | |
|
b0026617cf | |
|
7fcef60ec6 | |
|
2b9370f0c2 | |
|
12c919b071 | |
|
567ac5596a | |
|
b32e0ef123 | |
|
9e761db4f9 | |
|
e335c150f0 | |
|
4349a14a87 | |
|
487c872d43 | |
|
42ca8f6c9c | |
|
e6257d8e38 | |
|
7a75bffbfb | |
|
4f08dd1176 | |
|
50b10c64ca | |
|
3b0b3264de | |
|
c84bb2a1ef | |
|
6e89371845 | |
|
77387ab492 | |
|
83043e73f4 | |
|
becd3bcdb1 | |
|
e786bebeb2 | |
|
3ee6debf44 | |
|
b6e4396138 | |
|
568afed458 | |
|
2714b53a2d | |
|
3fdd25d6d6 | |
|
e49a0e3dc3 | |
|
2e8185841a | |
|
9a6fcc5ad4 | |
|
ff8b6c043a | |
|
7935e112ed | |
|
2baf012345 | |
|
107233fbad | |
|
41d8503d7e | |
|
e3e765503f | |
|
5cf6b59602 |
|
@ -4,3 +4,10 @@ elm-stuff
|
||||||
repl-temp-*
|
repl-temp-*
|
||||||
# VScode settings
|
# VScode settings
|
||||||
.vscode/
|
.vscode/
|
||||||
|
|
||||||
|
# Elm output
|
||||||
|
index.html
|
||||||
|
elm.js
|
||||||
|
|
||||||
|
# Elm configurations
|
||||||
|
elm-*.json
|
||||||
|
|
|
@ -18,8 +18,9 @@ supported for which spec versions.
|
||||||
- ✅ **One way to do things** instead of having multiple functions that are
|
- ✅ **One way to do things** instead of having multiple functions that are
|
||||||
considered deprecated.
|
considered deprecated.
|
||||||
|
|
||||||
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) at
|
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) or join the
|
||||||
@elm_matrix_sdk@social.noordstar.me to stay up-to-date on the latest changes.
|
conversation on [Matrix](https://matrix.to/#/#elm-sdk:matrix.org) to stay
|
||||||
|
up-to-date on the latest changes.
|
||||||
|
|
||||||
## How to install
|
## How to install
|
||||||
|
|
||||||
|
|
Binary file not shown.
After Width: | Height: | Size: 7.7 KiB |
|
@ -0,0 +1,16 @@
|
||||||
|
<svg version="1.1" viewBox="0 0 27.9 32" xmlns="http://www.w3.org/2000/svg" xmlns:cc="http://creativecommons.org/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
|
||||||
|
<title>Matrix (protocol) logo</title>
|
||||||
|
<g transform="translate(-.095 .005)" fill="#040404">
|
||||||
|
<path d="m27.1 31.2v-30.5h-2.19v-0.732h3.04v32h-3.04v-0.732z"/>
|
||||||
|
<g transform="translate(13.95 16) scale(0.03,-0.03)">
|
||||||
|
<polygon fill="#F0AD00" points="-280,-90 0,190 280,-90" transform="translate(0 -210)"/>
|
||||||
|
<polygon fill="#7FD13B" points="-280,-90 0,190 280,-90" transform="translate(-210 0) rotate(-90)"/>
|
||||||
|
<polygon fill="#7FD13B" points="-198,-66 0,132 198,-66" transform="translate(207 207) rotate(-45)"/>
|
||||||
|
<polygon fill="#60B5CC" points="-130,0 0,-130 130,0 0,130" transform="translate(150 0)"/>
|
||||||
|
<polygon fill="#5A6378" points="-191,61 69,61 191,-61 -69,-61" transform="translate(-89 239)"/>
|
||||||
|
<polygon fill="#F0AD00" points="-130,-44 0,86 130,-44" transform="translate(0 106) rotate(-180)"/>
|
||||||
|
<polygon fill="#60B5CC" points="-130,-44 0,86 130,-44" transform="translate(256 -150) rotate(-270)"/>
|
||||||
|
</g>
|
||||||
|
<path d="m0.936 0.732v30.5h2.19v0.732h-3.04v-32h3.03v0.732z"/>
|
||||||
|
</g>
|
||||||
|
</svg>
|
After Width: | Height: | Size: 1.2 KiB |
7
elm.json
7
elm.json
|
@ -3,7 +3,7 @@
|
||||||
"name": "noordstar/elm-matrix-sdk-beta",
|
"name": "noordstar/elm-matrix-sdk-beta",
|
||||||
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
|
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
|
||||||
"license": "EUPL-1.1",
|
"license": "EUPL-1.1",
|
||||||
"version": "3.1.0",
|
"version": "3.5.0",
|
||||||
"exposed-modules": [
|
"exposed-modules": [
|
||||||
"Matrix",
|
"Matrix",
|
||||||
"Matrix.Event",
|
"Matrix.Event",
|
||||||
|
@ -14,11 +14,14 @@
|
||||||
"elm-version": "0.19.0 <= v < 0.20.0",
|
"elm-version": "0.19.0 <= v < 0.20.0",
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"elm/core": "1.0.0 <= v < 2.0.0",
|
"elm/core": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/http": "2.0.0 <= v < 3.0.0",
|
||||||
"elm/json": "1.0.0 <= v < 2.0.0",
|
"elm/json": "1.0.0 <= v < 2.0.0",
|
||||||
"elm/parser": "1.0.0 <= v < 2.0.0",
|
"elm/parser": "1.0.0 <= v < 2.0.0",
|
||||||
"elm/time": "1.0.0 <= v < 2.0.0",
|
"elm/time": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/url": "1.0.0 <= v < 2.0.0",
|
||||||
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
||||||
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0",
|
||||||
|
"noordstar/elm-iddict": "1.0.1 <= v < 2.0.0"
|
||||||
},
|
},
|
||||||
"test-dependencies": {
|
"test-dependencies": {
|
||||||
"elm-explorations/test": "2.1.2 <= v < 3.0.0"
|
"elm-explorations/test": "2.1.2 <= v < 3.0.0"
|
||||||
|
|
|
@ -0,0 +1,196 @@
|
||||||
|
module Internal.Api.Api exposing
|
||||||
|
( TaskChain, request
|
||||||
|
, VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API
|
||||||
|
|
||||||
|
The API module is a front-end for implementing API endpoints according to spec.
|
||||||
|
|
||||||
|
This module is imported by various API endpoint implementations to keep the
|
||||||
|
implementation simple and understandable.
|
||||||
|
|
||||||
|
@docs TaskChain, request
|
||||||
|
|
||||||
|
|
||||||
|
## Spec versions
|
||||||
|
|
||||||
|
To respect spec versions, there is often a variety of ways to communicate with
|
||||||
|
the homeserver. For this reason, users can differentiate spec versions using
|
||||||
|
these functions.
|
||||||
|
|
||||||
|
@docs VersionControl, startWithVersion, startWithUnstableFeature, forVersion, sameForVersion, forUnstableFeature, versionChain
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext, Versions)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
import Recursion
|
||||||
|
import Set
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChain helps create a chain of HTTP requests.
|
||||||
|
-}
|
||||||
|
type alias TaskChain ph1 ph2 =
|
||||||
|
C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) { ph1 | baseUrl : () } { ph2 | baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Make an HTTP request that adheres to the Matrix spec rules.
|
||||||
|
-}
|
||||||
|
request :
|
||||||
|
{ attributes : List (R.Attribute { ph1 | baseUrl : () })
|
||||||
|
, coder : Json.Coder returnValue
|
||||||
|
, contextChange : returnValue -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
|
||||||
|
, method : String
|
||||||
|
, path : List String
|
||||||
|
, toUpdate : returnValue -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
|
||||||
|
}
|
||||||
|
-> TaskChain ph1 ph2
|
||||||
|
request data =
|
||||||
|
R.toChain
|
||||||
|
{ logHttp =
|
||||||
|
\r ->
|
||||||
|
( E.HttpRequest r
|
||||||
|
, String.concat
|
||||||
|
-- TODO: Move this to Internal.Config.Text module
|
||||||
|
[ "Matrix HTTP: "
|
||||||
|
, r.method
|
||||||
|
, " "
|
||||||
|
, r.url
|
||||||
|
]
|
||||||
|
|> log.info
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
, coder = data.coder
|
||||||
|
, request =
|
||||||
|
R.callAPI
|
||||||
|
{ method = data.method
|
||||||
|
, path = data.path
|
||||||
|
}
|
||||||
|
|> R.withAttributes data.attributes
|
||||||
|
, toContextChange = data.contextChange
|
||||||
|
, toUpdate = data.toUpdate
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| This type allows different definitions for different spec versions,
|
||||||
|
allowing the Elm SDK to communicate differently to the server depending on
|
||||||
|
how up-to-date the server is.
|
||||||
|
-}
|
||||||
|
type VersionControl a ph1 ph2
|
||||||
|
= VC
|
||||||
|
{ name : VersionType
|
||||||
|
, chain : a -> TaskChain (WithV ph1) (WithV ph2)
|
||||||
|
, prev : Maybe (VersionControl a ph1 ph2)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type VersionType
|
||||||
|
= SpecVersion String
|
||||||
|
| UnstableFeature String
|
||||||
|
|
||||||
|
|
||||||
|
type alias WithV ph =
|
||||||
|
{ ph | versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Start with a given spec version supporting a given API endpoint.
|
||||||
|
-}
|
||||||
|
startWithVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
|
||||||
|
startWithVersion name chain =
|
||||||
|
VC
|
||||||
|
{ name = SpecVersion name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Start with a given unstable feature supporting a given API endpoint.
|
||||||
|
-}
|
||||||
|
startWithUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2
|
||||||
|
startWithUnstableFeature name chain =
|
||||||
|
VC
|
||||||
|
{ name = UnstableFeature name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Nothing
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new unstable feature that supports a different version of the API endpoint.
|
||||||
|
-}
|
||||||
|
forUnstableFeature : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
|
||||||
|
forUnstableFeature name chain prev =
|
||||||
|
VC
|
||||||
|
{ name = UnstableFeature name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Just prev
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a new spec version that supports a different version of the API endpoint.
|
||||||
|
-}
|
||||||
|
forVersion : String -> (a -> TaskChain (WithV ph1) (WithV ph2)) -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
|
||||||
|
forVersion name chain prev =
|
||||||
|
VC
|
||||||
|
{ name = SpecVersion name
|
||||||
|
, chain = chain
|
||||||
|
, prev = Just prev
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add another spec version that has the API endpoint defined the same as the previous API endpoint.
|
||||||
|
-}
|
||||||
|
sameForVersion : String -> VersionControl a ph1 ph2 -> VersionControl a ph1 ph2
|
||||||
|
sameForVersion name (VC data) =
|
||||||
|
VC
|
||||||
|
{ name = SpecVersion name
|
||||||
|
, chain = data.chain
|
||||||
|
, prev = Just (VC data)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
supportedVersion : Versions -> VersionType -> Bool
|
||||||
|
supportedVersion { versions, unstableFeatures } name =
|
||||||
|
case name of
|
||||||
|
SpecVersion n ->
|
||||||
|
List.member n versions
|
||||||
|
|
||||||
|
UnstableFeature n ->
|
||||||
|
Set.member n unstableFeatures
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- NOTE: Interesting detail! For some reason, I cannot add the `context`
|
||||||
|
-- NOTE: variable to the top line of the defined input values!
|
||||||
|
-- NOTE: Maybe this is a bug?
|
||||||
|
|
||||||
|
|
||||||
|
{-| Once you are done, turn a VersionControl type into a Task Chain.
|
||||||
|
-}
|
||||||
|
versionChain : VersionControl a ph1 ph2 -> a -> TaskChain (WithV ph1) (WithV ph2)
|
||||||
|
versionChain vc input =
|
||||||
|
\context ->
|
||||||
|
case Context.getVersions context of
|
||||||
|
versions ->
|
||||||
|
Recursion.runRecursion
|
||||||
|
(\mvc ->
|
||||||
|
case mvc of
|
||||||
|
Nothing ->
|
||||||
|
Recursion.base (C.fail R.NoSupportedVersion context)
|
||||||
|
|
||||||
|
Just (VC data) ->
|
||||||
|
if supportedVersion versions data.name then
|
||||||
|
Recursion.base (data.chain input context)
|
||||||
|
|
||||||
|
else
|
||||||
|
Recursion.recurse data.prev
|
||||||
|
)
|
||||||
|
(Just vc)
|
|
@ -0,0 +1,116 @@
|
||||||
|
module Internal.Api.BanUser.Api exposing (Phantom, banUser)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Ban user
|
||||||
|
|
||||||
|
This module helps to ban users from a room.
|
||||||
|
|
||||||
|
@docs Phantom, banUser
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Room as R
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
banUser : BanUserInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
banUser =
|
||||||
|
A.startWithVersion "r0.0.0" banUserV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" banUserV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias BanUserInput =
|
||||||
|
{ reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias BanUserInputV1 a =
|
||||||
|
{ a | reason : Maybe String, roomId : String, user : User }
|
||||||
|
|
||||||
|
|
||||||
|
type alias BanUserOutputV1 =
|
||||||
|
()
|
||||||
|
|
||||||
|
|
||||||
|
banUserV1 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
banUserV1 { reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "ban" ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( E.More []
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
banUserV2 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
banUserV2 { reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "ban" ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( E.More []
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder BanUserOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.unit
|
|
@ -0,0 +1,134 @@
|
||||||
|
module Internal.Api.BaseUrl.Api exposing (baseUrl)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Base URL
|
||||||
|
|
||||||
|
This module looks for the right homeserver address.
|
||||||
|
|
||||||
|
@docs baseUrl
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the homeserver base URL of a given server name.
|
||||||
|
-}
|
||||||
|
baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () }
|
||||||
|
baseUrl data =
|
||||||
|
R.toChain
|
||||||
|
{ logHttp =
|
||||||
|
\r ->
|
||||||
|
( E.HttpRequest r
|
||||||
|
, Text.logs.httpRequest r.method r.url
|
||||||
|
|> log.info
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
, coder = coder
|
||||||
|
, request =
|
||||||
|
\context ->
|
||||||
|
{ attributes = []
|
||||||
|
, baseUrl = data.url
|
||||||
|
, context = context
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ ".well-known", "matrix", "client" ]
|
||||||
|
}
|
||||||
|
, toContextChange = \info -> Context.setBaseUrl info.homeserver.baseUrl
|
||||||
|
, toUpdate =
|
||||||
|
\info ->
|
||||||
|
( E.SetBaseUrl info.homeserver.baseUrl
|
||||||
|
, Text.logs.baseUrlFound data.url info.homeserver.baseUrl
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias BaseUrlInput =
|
||||||
|
{ url : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias DiscoveryInformation =
|
||||||
|
{ homeserver : HomeserverInformation
|
||||||
|
, identityServer : Maybe IdentityServerInformation
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias HomeserverInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias IdentityServerInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
coder : Json.Coder DiscoveryInformation
|
||||||
|
coder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Discovery Information"
|
||||||
|
, description =
|
||||||
|
[ "Gets discovery information about the domain. The file may include additional keys, which MUST follow the Java package naming convention, e.g. com.example.myapp.property. This ensures property names are suitably namespaced for each application and reduces the risk of clashes."
|
||||||
|
, "Note that this endpoint is not necessarily handled by the homeserver, but by another webserver, to be used for discovering the homeserver URL."
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#getwell-knownmatrixclient"
|
||||||
|
]
|
||||||
|
, init = DiscoveryInformation
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "m.homeserver"
|
||||||
|
, toField = .homeserver
|
||||||
|
, coder =
|
||||||
|
Json.object1
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = HomeserverInformation
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "m.identity_server"
|
||||||
|
, toField = .identityServer
|
||||||
|
, coder =
|
||||||
|
Json.object1
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = IdentityServerInformation
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover identity server information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,203 @@
|
||||||
|
module Internal.Api.Chain exposing
|
||||||
|
( TaskChain, CompleteChain
|
||||||
|
, IdemChain, toTask
|
||||||
|
, fail, succeed, andThen, catchWith, maybe
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Task chains
|
||||||
|
|
||||||
|
Elm uses a `Task` type to avoid issues that JavaScript deals with, yet the same
|
||||||
|
**callback hell** issue might appear that JavaScript developers often deal with.
|
||||||
|
For this reason, this module helps chain different `Task` types together such
|
||||||
|
that all information is stored and values are dealt with appropriately.
|
||||||
|
|
||||||
|
Elm's type checking system helps making this system sufficiently rigorous to
|
||||||
|
avoid leaking values passing through the API in unexpected ways.
|
||||||
|
|
||||||
|
@docs TaskChain, CompleteChain
|
||||||
|
|
||||||
|
|
||||||
|
## Finished chain
|
||||||
|
|
||||||
|
@docs IdemChain, toTask
|
||||||
|
|
||||||
|
|
||||||
|
## Operations
|
||||||
|
|
||||||
|
@docs fail, succeed, andThen, catchWith, maybe
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Log exposing (Log)
|
||||||
|
import Internal.Values.Context exposing (APIContext)
|
||||||
|
import Task
|
||||||
|
|
||||||
|
|
||||||
|
type alias Backpacked u a =
|
||||||
|
{ a | messages : List u, logs : List Log }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The TaskChain is a piece in the long chain of tasks that need to be completed.
|
||||||
|
The type defines four variables:
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be returned
|
||||||
|
- `a` phantom type before executing the chain's context
|
||||||
|
- `b` phantom type after executing the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChain err u a b =
|
||||||
|
APIContext a -> Task.Task (FailedChainPiece err u) (TaskChainPiece u a b)
|
||||||
|
|
||||||
|
|
||||||
|
{-| An IdemChain is a TaskChain that does not influence the chain's context
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be executed
|
||||||
|
- `a` phantom type before, during and after the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias IdemChain err u a =
|
||||||
|
TaskChain err u a a
|
||||||
|
|
||||||
|
|
||||||
|
{-| A CompleteChain is a complete task chain where all necessary information
|
||||||
|
has been defined. In simple terms, whenever a Matrix API call is made, all
|
||||||
|
necessary information for that endpoint:
|
||||||
|
|
||||||
|
1. Was previously known and has been inserted, or
|
||||||
|
2. Was acquired before actually making the API call.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias CompleteChain u =
|
||||||
|
TaskChain Never u {} {}
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChainPiece is a piece that updates the chain's context.
|
||||||
|
|
||||||
|
Once a chain is executed, the process will add the `messages` value to its list
|
||||||
|
of updates, and it will update its context according to the `contextChange`
|
||||||
|
function.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChainPiece u a b =
|
||||||
|
Backpacked u { contextChange : APIContext a -> APIContext b }
|
||||||
|
|
||||||
|
|
||||||
|
{-| A FailedChainPiece initiates an early breakdown of a chain. Unless caught,
|
||||||
|
this halts execution of the chain. The process will add the `messages` value to
|
||||||
|
its list of updates, and it will return the given `err` value for a direct
|
||||||
|
explanation of what went wrong.
|
||||||
|
-}
|
||||||
|
type alias FailedChainPiece err u =
|
||||||
|
Backpacked u { error : err }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Chain two tasks together. The second task will only run if the first one
|
||||||
|
succeeds.
|
||||||
|
-}
|
||||||
|
andThen : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
|
||||||
|
andThen f2 f1 =
|
||||||
|
\context ->
|
||||||
|
f1 context
|
||||||
|
|> Task.andThen
|
||||||
|
(\old ->
|
||||||
|
context
|
||||||
|
|> old.contextChange
|
||||||
|
|> f2
|
||||||
|
|> Task.map
|
||||||
|
(\new ->
|
||||||
|
{ contextChange = old.contextChange >> new.contextChange
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\new ->
|
||||||
|
{ error = new.error
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error has occurred, "fix" it with an artificial task chain result.
|
||||||
|
-}
|
||||||
|
catchWith : (err -> TaskChainPiece u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
catchWith onErr f =
|
||||||
|
onError (\e -> succeed <| onErr e) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always fails.
|
||||||
|
-}
|
||||||
|
fail : err -> TaskChain err u a b
|
||||||
|
fail e _ =
|
||||||
|
Task.fail { error = e, logs = [], messages = [] }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Optionally run a task that doesn't need to succeed.
|
||||||
|
|
||||||
|
If the provided chain fails, it will be ignored. This way, the chain can be
|
||||||
|
executed without breaking the whole chain if it fails. This can be useful for:
|
||||||
|
|
||||||
|
1. Sending information to the Matrix API and not caring if it actually arrives
|
||||||
|
2. Gaining optional information that might be nice to know, but not necessary
|
||||||
|
|
||||||
|
Consequently, the optional chain cannot add any information that the rest of
|
||||||
|
the chain relies on.
|
||||||
|
|
||||||
|
-}
|
||||||
|
maybe : IdemChain err u a -> IdemChain err2 u a
|
||||||
|
maybe f =
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = []
|
||||||
|
, messages = []
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> always
|
||||||
|
|> onError
|
||||||
|
|> (|>) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error occurs, this function allows the task chain to go down a
|
||||||
|
similar but different route.
|
||||||
|
-}
|
||||||
|
onError : (err -> TaskChain err2 u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
onError onErr f =
|
||||||
|
\context ->
|
||||||
|
f context
|
||||||
|
|> Task.onError
|
||||||
|
(\old ->
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = old.logs -- TODO: Log caught errors
|
||||||
|
, messages = old.messages
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> andThen (onErr old.error)
|
||||||
|
|> (|>) context
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always succeeds.
|
||||||
|
-}
|
||||||
|
succeed : TaskChainPiece u a b -> TaskChain err u a b
|
||||||
|
succeed piece _ =
|
||||||
|
Task.succeed piece
|
||||||
|
|
||||||
|
|
||||||
|
{-| Once the chain is complete, turn it into a valid task.
|
||||||
|
-}
|
||||||
|
toTask : IdemChain Never u a -> APIContext a -> Task.Task Never (Backpacked u {})
|
||||||
|
toTask chain context =
|
||||||
|
chain context
|
||||||
|
|> Task.onError (\e -> Task.succeed <| never e.error)
|
||||||
|
|> Task.map
|
||||||
|
(\backpack ->
|
||||||
|
{ messages = backpack.messages
|
||||||
|
, logs = backpack.logs
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,247 @@
|
||||||
|
module Internal.Api.GetEvent.Api exposing (GetEventInput, getEvent)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Get event
|
||||||
|
|
||||||
|
Get a single event based on `roomId/eventId`. You must have permission to
|
||||||
|
retrieve this event e.g. by being a member in the room for this event.
|
||||||
|
|
||||||
|
@docs GetEventInput, getEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
|
import Internal.Values.Room as Room
|
||||||
|
import Internal.Values.User as User
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Input for getting an event.
|
||||||
|
-}
|
||||||
|
type alias GetEventInput =
|
||||||
|
{ eventId : String, roomId : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Standard input for version 1 of the GetEvent API endpoint.
|
||||||
|
-}
|
||||||
|
type alias GetEventInputV1 a =
|
||||||
|
{ a | eventId : String, roomId : String }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Universal phantom type encompassing all versions of this API endpoint.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
PhantomV1 { a | versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Phantom values necessary for version 1 of the GetEvent API endpoint.
|
||||||
|
-}
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an event based on a room id and event id.
|
||||||
|
-}
|
||||||
|
getEvent : GetEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
getEvent =
|
||||||
|
A.startWithVersion "r0.5.0" getEventV1
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" getEventV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Version 1 of the GetEvent API endpoint
|
||||||
|
-}
|
||||||
|
getEventV1 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
getEventV1 { eventId, roomId } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.onStatusCode 404 "M_NOT_FOUND"
|
||||||
|
]
|
||||||
|
, coder = getEventCoderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "event", eventId ]
|
||||||
|
, toUpdate =
|
||||||
|
\event ->
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
|
||||||
|
, event.eventId
|
||||||
|
|> Text.logs.getEventId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Version 2 of the GetEvent API endpoint
|
||||||
|
-}
|
||||||
|
getEventV2 : GetEventInputV1 input -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
getEventV2 { eventId, roomId } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.onStatusCode 404 "M_NOT_FOUND"
|
||||||
|
]
|
||||||
|
, coder = getEventCoderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "event", eventId ]
|
||||||
|
, toUpdate =
|
||||||
|
\event ->
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
|
||||||
|
, event.eventId
|
||||||
|
|> Text.logs.getEventId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
getEventCoderV1 : Json.Coder Event
|
||||||
|
getEventCoderV1 =
|
||||||
|
Json.object8
|
||||||
|
{ name = "ClientEvent"
|
||||||
|
, description =
|
||||||
|
[ "ClientEvent as described by the Matrix spec"
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||||
|
]
|
||||||
|
, init = Event
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "content"
|
||||||
|
, toField = .content
|
||||||
|
, description =
|
||||||
|
[ "The body of this event, as created by the client which sent it."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description =
|
||||||
|
[ "The globally unique identifier for this event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "origin_server_ts"
|
||||||
|
, toField = .originServerTs
|
||||||
|
, description =
|
||||||
|
[ "Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent."
|
||||||
|
]
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "room_id"
|
||||||
|
, toField = .roomId
|
||||||
|
, description =
|
||||||
|
[ "The ID of the room associated with this event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "sender"
|
||||||
|
, toField = .sender
|
||||||
|
, description =
|
||||||
|
[ "Contains the fully-qualified ID of the user who sent this event."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state_key"
|
||||||
|
, toField = .stateKey
|
||||||
|
, description =
|
||||||
|
[ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string."
|
||||||
|
, "State keys starting with an @ are reserved for referencing user IDs, such as room members. With the exception of a few events, state events set with a given user’s ID as the state key MUST only be set by that user."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "type"
|
||||||
|
, toField = .eventType
|
||||||
|
, description =
|
||||||
|
[ "The type of the event."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unsigned"
|
||||||
|
, toField = .unsigned
|
||||||
|
, description =
|
||||||
|
[ "Contains optional extra information about the event."
|
||||||
|
]
|
||||||
|
, coder =
|
||||||
|
Json.object4
|
||||||
|
{ name = "UnsignedData"
|
||||||
|
, description =
|
||||||
|
[ "UnsignedData as described by the Matrix spec"
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||||
|
]
|
||||||
|
, init = \a b c d -> Event.UnsignedData { age = a, membership = Nothing, prevContent = b, redactedBecause = c, transactionId = d }
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "age"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.age
|
||||||
|
, description =
|
||||||
|
[ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is."
|
||||||
|
]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "prev_content"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.prevContent
|
||||||
|
, description =
|
||||||
|
[ " The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content."
|
||||||
|
, "Changed in v1.2: Previously, this field was specified at the top level of returned events rather than in unsigned (with the exception of the GET .../notifications endpoint), though in practice no known server implementations honoured this."
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "redacted_because"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.redactedBecause
|
||||||
|
, description =
|
||||||
|
[ "The event that redacted this event, if any."
|
||||||
|
]
|
||||||
|
, coder = Json.lazy (\() -> getEventCoderV1)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "transaction_id"
|
||||||
|
, toField = \(Event.UnsignedData data) -> data.transactionId
|
||||||
|
, description =
|
||||||
|
[ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,128 @@
|
||||||
|
module Internal.Api.InviteUser.Api exposing (InviteInput, Phantom, inviteUser)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Invite
|
||||||
|
|
||||||
|
This API invites a user to participate in a particular room. They do not start
|
||||||
|
participating in the room until they actually join the room.
|
||||||
|
|
||||||
|
Only users currently in a particular room can invite other users to join that
|
||||||
|
room.
|
||||||
|
|
||||||
|
If the user was invited to the room, the homeserver will append a m.room.member
|
||||||
|
event to the room.
|
||||||
|
|
||||||
|
@docs InviteInput, Phantom, inviteUser
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Room as Room
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invite a user to a room.
|
||||||
|
-}
|
||||||
|
inviteUser : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
|
||||||
|
inviteUser =
|
||||||
|
A.startWithVersion "r0.0.0" inviteV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" inviteV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for inviting a user.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : () }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Input for inviting a user.
|
||||||
|
-}
|
||||||
|
type alias InviteInput =
|
||||||
|
{ reason : Maybe String, roomId : String, user : User }
|
||||||
|
|
||||||
|
|
||||||
|
type alias InviteInputV1 a =
|
||||||
|
{ a | roomId : String, user : User }
|
||||||
|
|
||||||
|
|
||||||
|
type alias InviteInputV2 a =
|
||||||
|
{ a | roomId : String, user : User, reason : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
inviteV1 : InviteInputV1 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
|
||||||
|
inviteV1 { roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "invite" ]
|
||||||
|
, toUpdate =
|
||||||
|
always
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
|
||||||
|
, Text.logs.invitedUser (User.toString user) roomId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
inviteV2 : InviteInputV2 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
|
||||||
|
inviteV2 { reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = Json.value
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "invite" ]
|
||||||
|
, toUpdate =
|
||||||
|
always
|
||||||
|
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
|
||||||
|
, Text.logs.invitedUser (User.toString user) roomId
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
|
@ -0,0 +1,178 @@
|
||||||
|
module Internal.Api.KickUser.Api exposing (Phantom, kickUser)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Kick user
|
||||||
|
|
||||||
|
This module helps to kick users from a room.
|
||||||
|
|
||||||
|
@docs Phantom, kickUser
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Room as R
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
kickUser : KickUserInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
kickUser =
|
||||||
|
A.startWithVersion "r0.0.0" kickUserV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
-- NOTE: Kicking a user was first added in r0.1.0
|
||||||
|
|> A.forVersion "r0.1.0" kickUserV2
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" kickUserV3
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias KickUserInput =
|
||||||
|
{ avatarUrl : Maybe String
|
||||||
|
, displayname : Maybe String
|
||||||
|
, reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias KickUserInputV1 a =
|
||||||
|
{ a
|
||||||
|
| avatarUrl : Maybe String
|
||||||
|
, displayname : Maybe String
|
||||||
|
, reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias KickUserInputV2 a =
|
||||||
|
{ a | reason : Maybe String, roomId : String, user : User }
|
||||||
|
|
||||||
|
|
||||||
|
type alias KickUserOutputV1 =
|
||||||
|
{ eventId : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias KickUserOutputV2 =
|
||||||
|
()
|
||||||
|
|
||||||
|
|
||||||
|
kickUserV1 : KickUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
kickUserV1 { avatarUrl, displayname, reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyString "membership" "kick"
|
||||||
|
, R.bodyOpString "avatar_url" avatarUrl
|
||||||
|
, R.bodyOpString "displayname" displayname
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
|
]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", "m.room.member", User.toString user ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, [ "The kick API endpoint does not exist before spec version r0.1.0 - falling back to sending state event directly."
|
||||||
|
|> log.debug
|
||||||
|
, out.eventId
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
]
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
kickUserV2 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
kickUserV2 { reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "kick" ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( E.More []
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
kickUserV3 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
kickUserV3 { reason, roomId, user } =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.bodyOpString "reason" reason
|
||||||
|
, R.bodyString "user_id" (User.toString user)
|
||||||
|
]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "kick" ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( E.More []
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder KickUserOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This object is returned after a state event has been sent."
|
||||||
|
]
|
||||||
|
, init = KickUserOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder KickUserOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.unit
|
|
@ -0,0 +1,935 @@
|
||||||
|
module Internal.Api.LoginWithUsernameAndPassword.Api exposing (Phantom, loginWithUsernameAndPassword)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Login
|
||||||
|
|
||||||
|
This module allows the user to log in using a username and password.
|
||||||
|
|
||||||
|
@docs Phantom, loginWithUsernameAndPassword
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
import Json.Encode as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Log in using a username and password.
|
||||||
|
-}
|
||||||
|
loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> A.TaskChain (Phantom a) (Phantom { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPassword =
|
||||||
|
A.startWithVersion "r0.0.0" loginWithUsernameAndPasswordV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.forVersion "r0.3.0" loginWithUsernameAndPasswordV2
|
||||||
|
|> A.forVersion "r0.4.0" loginWithUsernameAndPasswordV3
|
||||||
|
|> A.forVersion "r0.5.0" loginWithUsernameAndPasswordV4
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" loginWithUsernameAndPasswordV5
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.forVersion "v1.3" loginWithUsernameAndPasswordV6
|
||||||
|
|> A.forVersion "v1.4" loginWithUsernameAndPasswordV7
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for logging in with a username and password
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | baseUrl : (), now : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInput =
|
||||||
|
{ deviceId : Maybe String
|
||||||
|
, enableRefreshToken : Maybe Bool
|
||||||
|
, initialDeviceDisplayName : Maybe String
|
||||||
|
, password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInputV1 a =
|
||||||
|
{ a
|
||||||
|
| password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInputV2 a =
|
||||||
|
{ a
|
||||||
|
| deviceId : Maybe String
|
||||||
|
, initialDeviceDisplayName : Maybe String
|
||||||
|
, password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordInputV3 a =
|
||||||
|
{ a
|
||||||
|
| deviceId : Maybe String
|
||||||
|
, enableRefreshToken : Maybe Bool
|
||||||
|
, initialDeviceDisplayName : Maybe String
|
||||||
|
, password : String
|
||||||
|
, username : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV1 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, homeserver : String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV2 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, homeserver : String
|
||||||
|
, user : Maybe User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV3 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV4 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
, wellKnown : Maybe DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV5 =
|
||||||
|
{ accessToken : String -- Even though it is not required, we do not want it to be omitted.
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, expiresInMs : Maybe Int
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, user : Maybe User
|
||||||
|
, wellKnown : Maybe DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias LoginWithUsernameAndPasswordOutputV6 =
|
||||||
|
{ accessToken : String
|
||||||
|
, deviceId : String
|
||||||
|
, expiresInMs : Maybe Int
|
||||||
|
, homeserver : Maybe String
|
||||||
|
, refreshToken : Maybe String
|
||||||
|
, user : User
|
||||||
|
, wellKnown : Maybe DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias DiscoveryInformationV1 =
|
||||||
|
{ homeserver : HomeserverInformation
|
||||||
|
, identityServer : Maybe IdentityServerInformation
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias HomeserverInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias IdentityServerInformation =
|
||||||
|
{ baseUrl : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | baseUrl : (), now : () }
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV1 { username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
]
|
||||||
|
, coder = coderV1
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = out.refreshToken
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map E.SetUser
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV2 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "string" -- Yup. That's what it says.
|
||||||
|
]
|
||||||
|
, coder = coderV2
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map E.SetUser
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV3 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV3
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map E.SetUser
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV4 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV4
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "r0", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map E.SetUser
|
||||||
|
|> E.Optional
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV5 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV4
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = Nothing
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = Nothing
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map E.SetUser
|
||||||
|
|> E.Optional
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV6 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyOpBool "refresh_token" enableRefreshToken
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV5
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = out.expiresInMs
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = out.refreshToken
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, out.user
|
||||||
|
|> Maybe.map E.SetUser
|
||||||
|
|> E.Optional
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, out.deviceId
|
||||||
|
|> Maybe.map E.SetDeviceId
|
||||||
|
|> E.Optional
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
loginWithUsernameAndPasswordV7 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
|
||||||
|
loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
|
||||||
|
\context ->
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.bodyOpString "address" Nothing
|
||||||
|
, R.bodyOpString "device_id" deviceId
|
||||||
|
, R.bodyValue "identifier"
|
||||||
|
(E.object
|
||||||
|
[ ( "type", E.string "m.id.user" )
|
||||||
|
, ( "user", E.string username )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
|
||||||
|
, R.bodyString "password" password
|
||||||
|
, R.bodyOpBool "refresh_token" enableRefreshToken
|
||||||
|
, R.bodyString "type" "m.login.password"
|
||||||
|
, R.bodyString "user" username
|
||||||
|
, R.onStatusCode 400 "M_UNKNOWN"
|
||||||
|
, R.onStatusCode 403 "M_FORBIDDEN"
|
||||||
|
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
|
||||||
|
]
|
||||||
|
, coder = coderV6
|
||||||
|
, method = "POST"
|
||||||
|
, path = [ "_matrix", "client", "v3", "login" ]
|
||||||
|
, contextChange =
|
||||||
|
\out -> Context.setAccessToken out.accessToken
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More
|
||||||
|
[ E.SetAccessToken
|
||||||
|
{ created = Context.getNow context
|
||||||
|
, expiryMs = out.expiresInMs
|
||||||
|
, lastUsed = Context.getNow context
|
||||||
|
, refresh = out.refreshToken
|
||||||
|
, value = out.accessToken
|
||||||
|
}
|
||||||
|
, E.RemovePasswordIfNecessary
|
||||||
|
, E.SetUser out.user
|
||||||
|
, out.wellKnown
|
||||||
|
|> Maybe.map (.homeserver >> .baseUrl)
|
||||||
|
|> Maybe.map E.SetBaseUrl
|
||||||
|
|> E.Optional
|
||||||
|
, E.SetDeviceId out.deviceId
|
||||||
|
]
|
||||||
|
, Text.logs.loggedInAs username
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
context
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder LoginWithUsernameAndPasswordOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/r0.0.0/client_server.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests. The access token may expire at some point, and if so, it SHOULD come with a refresh_token. There is no specific error message to indicate that a request has failed because an access token has expired; instead, if a client has reason to believe its access token is valid, and it receives an auth error, they should attempt to refresh for a new token on failure, and retry the request with the new token."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh_token"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description =
|
||||||
|
[ "A refresh_token may be exchanged for a new access_token using the /tokenrefresh API endpoint."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder LoginWithUsernameAndPasswordOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.3.0.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV2
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV3 : Json.Coder LoginWithUsernameAndPasswordOutputV3
|
||||||
|
coderV3 =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.3.0.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV3
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV4 : Json.Coder LoginWithUsernameAndPasswordOutputV4
|
||||||
|
coderV4 =
|
||||||
|
Json.object5
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.5.0.html#post-matrix-client-r0-login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV4
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "well_known"
|
||||||
|
, toField = .wellKnown
|
||||||
|
, description =
|
||||||
|
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
|
||||||
|
]
|
||||||
|
, coder = disoveryInformationCoderV1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV5 : Json.Coder LoginWithUsernameAndPasswordOutputV5
|
||||||
|
coderV5 =
|
||||||
|
Json.object7
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/v1.3/client-server-api/#post_matrixclientv3login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV5
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "expires_in_ms"
|
||||||
|
, toField = .expiresInMs
|
||||||
|
, description =
|
||||||
|
[ "The lifetime of the access token, in milliseconds. Once the access token has expired a new access token can be obtained by using the provided refresh token. If no refresh token is provided, the client will need to re-log in to obtain a new access token. If not given, the client can assume that the access token will not expire. "
|
||||||
|
]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh_token"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description =
|
||||||
|
[ "A refresh token for the account. This token can be used to obtain a new access token when it expires by calling the /refresh endpoint."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "well_known"
|
||||||
|
, toField = .wellKnown
|
||||||
|
, description =
|
||||||
|
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
|
||||||
|
]
|
||||||
|
, coder = disoveryInformationCoderV1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV6 : Json.Coder LoginWithUsernameAndPasswordOutputV6
|
||||||
|
coderV6 =
|
||||||
|
Json.object7
|
||||||
|
{ name = "Login Response"
|
||||||
|
, description =
|
||||||
|
[ "Authenticates the user by password, and issues an access token they can use to authorize themself in subsequent requests."
|
||||||
|
, "https://spec.matrix.org/v1.3/client-server-api/#post_matrixclientv3login"
|
||||||
|
]
|
||||||
|
, init = LoginWithUsernameAndPasswordOutputV6
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "access_token"
|
||||||
|
, toField = .accessToken
|
||||||
|
, description =
|
||||||
|
[ "An access token for the account. This access token can then be used to authorize other requests."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "device_id"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description =
|
||||||
|
[ "ID of the logged-in device. Will be the same as the corresponding parameter in the request, if one was specified."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "expires_in_ms"
|
||||||
|
, toField = .expiresInMs
|
||||||
|
, description =
|
||||||
|
[ "The lifetime of the access token, in milliseconds. Once the access token has expired a new access token can be obtained by using the provided refresh token. If no refresh token is provided, the client will need to re-log in to obtain a new access token. If not given, the client can assume that the access token will not expire. "
|
||||||
|
]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "home_server"
|
||||||
|
, toField = .homeserver
|
||||||
|
, description =
|
||||||
|
[ "The hostname of the homeserver on which the account has been registered."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh_token"
|
||||||
|
, toField = .refreshToken
|
||||||
|
, description =
|
||||||
|
[ "A refresh token for the account. This token can be used to obtain a new access token when it expires by calling the /refresh endpoint."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "user_id"
|
||||||
|
, toField = .user
|
||||||
|
, description =
|
||||||
|
[ "The fully-qualified Matrix ID that has been registered."
|
||||||
|
]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "well_known"
|
||||||
|
, toField = .wellKnown
|
||||||
|
, description =
|
||||||
|
[ "Optional client configuration provided by the server. If present, clients SHOULD use the provided object to reconfigure themselves, optionally validating the URLs within. This object takes the same form as the one returned from .well-known autodiscovery."
|
||||||
|
]
|
||||||
|
, coder = disoveryInformationCoderV1
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
disoveryInformationCoderV1 : Json.Coder DiscoveryInformationV1
|
||||||
|
disoveryInformationCoderV1 =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Discovery Information"
|
||||||
|
, description =
|
||||||
|
[ "Gets discovery information about the domain. The file may include additional keys, which MUST follow the Java package naming convention, e.g. com.example.myapp.property. This ensures property names are suitably namespaced for each application and reduces the risk of clashes."
|
||||||
|
, "Note that this endpoint is not necessarily handled by the homeserver, but by another webserver, to be used for discovering the homeserver URL."
|
||||||
|
, "https://spec.matrix.org/v1.10/client-server-api/#getwell-knownmatrixclient"
|
||||||
|
]
|
||||||
|
, init = DiscoveryInformationV1
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "m.homeserver"
|
||||||
|
, toField = .homeserver
|
||||||
|
, coder =
|
||||||
|
Json.object1
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = HomeserverInformation
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "m.identity_server"
|
||||||
|
, toField = .identityServer
|
||||||
|
, coder =
|
||||||
|
Json.object1
|
||||||
|
{ name = "Homeserver Information"
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover homeserver information."
|
||||||
|
]
|
||||||
|
, init = HomeserverInformation
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "base_url"
|
||||||
|
, toField = .baseUrl
|
||||||
|
, description =
|
||||||
|
[ "The base URL for the homeserver for client-server connections."
|
||||||
|
]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
, description =
|
||||||
|
[ "Used by clients to discover identity server information."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,236 @@
|
||||||
|
module Internal.Api.Main exposing
|
||||||
|
( Msg
|
||||||
|
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Main API module
|
||||||
|
|
||||||
|
This module is used as reference for getting
|
||||||
|
|
||||||
|
|
||||||
|
## VaultUpdate
|
||||||
|
|
||||||
|
@docs Msg
|
||||||
|
|
||||||
|
|
||||||
|
## Actions
|
||||||
|
|
||||||
|
@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Task as ITask exposing (Backpack)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Update message type that is being returned.
|
||||||
|
-}
|
||||||
|
type alias Msg =
|
||||||
|
Backpack
|
||||||
|
|
||||||
|
|
||||||
|
{-| Ban a user from a room.
|
||||||
|
-}
|
||||||
|
banUser :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
banUser env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.banUser
|
||||||
|
{ reason = data.reason
|
||||||
|
, roomId = data.roomId
|
||||||
|
, user = data.user
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invite a user to a room.
|
||||||
|
-}
|
||||||
|
inviteUser :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
inviteUser env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.inviteUser
|
||||||
|
{ reason = data.reason
|
||||||
|
, roomId = data.roomId
|
||||||
|
, user = data.user
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Kick a user from a room.
|
||||||
|
-}
|
||||||
|
kickUser :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
kickUser env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.kickUser
|
||||||
|
{ avatarUrl = Nothing
|
||||||
|
, displayname = Nothing
|
||||||
|
, reason = data.reason
|
||||||
|
, roomId = data.roomId
|
||||||
|
, user = data.user
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event.
|
||||||
|
-}
|
||||||
|
sendMessageEvent :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
sendMessageEvent env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.sendMessageEvent
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, transactionId = data.transactionId
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a room.
|
||||||
|
-}
|
||||||
|
sendStateEvent :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, stateKey : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
sendStateEvent env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.sendStateEvent
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, stateKey = data.stateKey
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set global account data.
|
||||||
|
-}
|
||||||
|
setAccountData :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
setAccountData env data =
|
||||||
|
case env.context.user of
|
||||||
|
Just u ->
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.setAccountData
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, userId = User.toString u
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Cmd.none
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set the account data for a Matrix room.
|
||||||
|
-}
|
||||||
|
setRoomAccountData :
|
||||||
|
E.Envelope a
|
||||||
|
->
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, toMsg : Msg -> msg
|
||||||
|
}
|
||||||
|
-> Cmd msg
|
||||||
|
setRoomAccountData env data =
|
||||||
|
case env.context.user of
|
||||||
|
Just u ->
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.setRoomAccountData
|
||||||
|
{ content = data.content
|
||||||
|
, eventType = data.eventType
|
||||||
|
, roomId = data.roomId
|
||||||
|
, userId = User.toString u
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Cmd.none
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: Return error about lacking user capabilities
|
||||||
|
|
||||||
|
|
||||||
|
{-| Sync with the Matrix API to stay up-to-date.
|
||||||
|
-}
|
||||||
|
sync :
|
||||||
|
E.Envelope a
|
||||||
|
-> { toMsg : Msg -> msg }
|
||||||
|
-> Cmd msg
|
||||||
|
sync env data =
|
||||||
|
ITask.run
|
||||||
|
data.toMsg
|
||||||
|
(ITask.sync
|
||||||
|
{ fullState = Nothing
|
||||||
|
, presence = env.settings.presence
|
||||||
|
, since = env.context.nextBatch
|
||||||
|
, timeout = Just env.settings.syncTime
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Context.apiFormat env.context)
|
|
@ -0,0 +1,40 @@
|
||||||
|
module Internal.Api.Now.Api exposing (getNow)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Now
|
||||||
|
|
||||||
|
Get the current time.
|
||||||
|
|
||||||
|
@docs getNow
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Values.Context as Context
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Task
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the current time and place it in the context.
|
||||||
|
-}
|
||||||
|
getNow : A.TaskChain a { a | now : () }
|
||||||
|
getNow =
|
||||||
|
\_ ->
|
||||||
|
Task.map
|
||||||
|
(\now ->
|
||||||
|
{ messages = [ E.SetNow now ]
|
||||||
|
, logs =
|
||||||
|
now
|
||||||
|
|> Time.posixToMillis
|
||||||
|
|> Text.logs.getNow
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
, contextChange = Context.setNow now
|
||||||
|
}
|
||||||
|
)
|
||||||
|
Time.now
|
|
@ -0,0 +1,613 @@
|
||||||
|
module Internal.Api.Request exposing
|
||||||
|
( ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||||
|
, Request, Error(..)
|
||||||
|
, accessToken, timeout, onStatusCode
|
||||||
|
, fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
, queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API module
|
||||||
|
|
||||||
|
This module helps describe API requests.
|
||||||
|
|
||||||
|
|
||||||
|
## Plan
|
||||||
|
|
||||||
|
@docs ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||||
|
|
||||||
|
Sometimes, APIs might fail. As a result, you may receive an error.
|
||||||
|
|
||||||
|
@docs Request, Error
|
||||||
|
|
||||||
|
|
||||||
|
## API attributes
|
||||||
|
|
||||||
|
|
||||||
|
### General attributes
|
||||||
|
|
||||||
|
@docs accessToken, timeout, onStatusCode
|
||||||
|
|
||||||
|
|
||||||
|
### Body
|
||||||
|
|
||||||
|
@docs fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
|
||||||
|
|
||||||
|
### Query parameters
|
||||||
|
|
||||||
|
@docs queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Dict
|
||||||
|
import Http
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
|
import Task
|
||||||
|
import Url
|
||||||
|
import Url.Builder as UrlBuilder
|
||||||
|
|
||||||
|
|
||||||
|
{-| The API call is a plan that describes how an interaction is planned with
|
||||||
|
the Matrix API.
|
||||||
|
-}
|
||||||
|
type alias ApiCall ph =
|
||||||
|
{ attributes : List ContextAttr
|
||||||
|
, baseUrl : String
|
||||||
|
, context : APIContext ph
|
||||||
|
, method : String
|
||||||
|
, path : List String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Shortcut definition to define a function that bases an APICall on a given
|
||||||
|
APIContext.
|
||||||
|
-}
|
||||||
|
type alias ApiPlan a =
|
||||||
|
APIContext a -> ApiCall a
|
||||||
|
|
||||||
|
|
||||||
|
{-| An attribute maps a given context to an attribute for an API call.
|
||||||
|
-}
|
||||||
|
type alias Attribute a =
|
||||||
|
APIContext a -> ContextAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| A context attribute describes one aspect of the API call that is to be made.
|
||||||
|
-}
|
||||||
|
type ContextAttr
|
||||||
|
= BodyParam String Json.Value
|
||||||
|
| FullBody Json.Value
|
||||||
|
| Header Http.Header
|
||||||
|
| NoAttr
|
||||||
|
| QueryParam UrlBuilder.QueryParameter
|
||||||
|
| StatusCodeResponse Int ( Error, List Log )
|
||||||
|
| Timeout Float
|
||||||
|
|
||||||
|
|
||||||
|
{-| Error indicating that something went wrong.
|
||||||
|
-}
|
||||||
|
type Error
|
||||||
|
= InternetException Http.Error
|
||||||
|
| MissingUsername
|
||||||
|
| MissingPassword
|
||||||
|
| NoSupportedVersion
|
||||||
|
| ServerReturnsBadJSON String
|
||||||
|
| ServerReturnsError String Json.Value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Ordinary shape of an HTTP request.
|
||||||
|
-}
|
||||||
|
type alias Request x a =
|
||||||
|
{ headers : List Http.Header
|
||||||
|
, body : Http.Body
|
||||||
|
, method : String
|
||||||
|
, url : String
|
||||||
|
, resolver : Http.Resolver x a
|
||||||
|
, timeout : Maybe Float
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that requires an access token to be present
|
||||||
|
-}
|
||||||
|
accessToken : Attribute { a | accessToken : () }
|
||||||
|
accessToken =
|
||||||
|
Context.getAccessToken
|
||||||
|
>> (++) "Bearer "
|
||||||
|
>> Http.header "Authorization"
|
||||||
|
>> Header
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyBool : String -> Bool -> Attribute a
|
||||||
|
bodyBool key value =
|
||||||
|
bodyValue key <| Json.encode Json.bool value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyInt : String -> Int -> Attribute a
|
||||||
|
bodyInt key value =
|
||||||
|
bodyValue key <| Json.encode Json.int value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
bodyOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
bodyOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpString : String -> Maybe String -> Attribute a
|
||||||
|
bodyOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpValue : String -> Maybe Json.Value -> Attribute a
|
||||||
|
bodyOpValue key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyValue key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyString : String -> String -> Attribute a
|
||||||
|
bodyString key value =
|
||||||
|
bodyValue key <| Json.encode Json.string value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyValue : String -> Json.Value -> Attribute a
|
||||||
|
bodyValue key value _ =
|
||||||
|
BodyParam key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a plan to create an API call.
|
||||||
|
-}
|
||||||
|
callAPI : { method : String, path : List String } -> ApiPlan { a | baseUrl : () }
|
||||||
|
callAPI { method, path } context =
|
||||||
|
{ attributes = []
|
||||||
|
, baseUrl = Context.getBaseUrl context
|
||||||
|
, context = context
|
||||||
|
, method = method
|
||||||
|
, path = path
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode the server's response into (hopefully) something meaningful.
|
||||||
|
-}
|
||||||
|
decodeServerResponse : D.Decoder ( a, List Log ) -> String -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||||
|
decodeServerResponse decoder body statusCodeError =
|
||||||
|
case D.decodeString D.value body of
|
||||||
|
Err e ->
|
||||||
|
let
|
||||||
|
description : String
|
||||||
|
description =
|
||||||
|
D.errorToString e
|
||||||
|
in
|
||||||
|
Err
|
||||||
|
( ServerReturnsBadJSON description
|
||||||
|
, description
|
||||||
|
|> Text.logs.serverReturnedInvalidJSON
|
||||||
|
|> log.error
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
|
||||||
|
Ok v ->
|
||||||
|
decodeServerValue decoder v statusCodeError
|
||||||
|
|
||||||
|
|
||||||
|
{-| Decode the server's response, assuming that it parses correctly to
|
||||||
|
a JSON value.
|
||||||
|
-}
|
||||||
|
decodeServerValue : D.Decoder ( a, List Log ) -> Json.Value -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||||
|
decodeServerValue decoder value statusCodeError =
|
||||||
|
value
|
||||||
|
|> D.decodeValue decoder
|
||||||
|
|> Result.mapError
|
||||||
|
(\err ->
|
||||||
|
let
|
||||||
|
description : String
|
||||||
|
description =
|
||||||
|
D.errorToString err
|
||||||
|
|
||||||
|
-- TODO: Parse errors returned by Matrix API
|
||||||
|
error : Maybe ( Error, List Log )
|
||||||
|
error =
|
||||||
|
Nothing
|
||||||
|
in
|
||||||
|
case ( error, statusCodeError ) of
|
||||||
|
( Just e, _ ) ->
|
||||||
|
e
|
||||||
|
|
||||||
|
( Nothing, Just e ) ->
|
||||||
|
e
|
||||||
|
|
||||||
|
( Nothing, Nothing ) ->
|
||||||
|
( ServerReturnsBadJSON description
|
||||||
|
, description
|
||||||
|
|> Text.logs.serverReturnedUnknownJSON
|
||||||
|
|> log.error
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an empty attribute that does nothing.
|
||||||
|
-}
|
||||||
|
empty : Attribute a
|
||||||
|
empty =
|
||||||
|
always NoAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| Adds a JSON value as the HTTP body.
|
||||||
|
-}
|
||||||
|
fullBody : Json.Value -> Attribute a
|
||||||
|
fullBody value _ =
|
||||||
|
FullBody value
|
||||||
|
|
||||||
|
|
||||||
|
getBody : List ContextAttr -> Maybe Json.Value
|
||||||
|
getBody attributes =
|
||||||
|
attributes
|
||||||
|
|> List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
FullBody v ->
|
||||||
|
Just v
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|> List.reverse
|
||||||
|
|> List.head
|
||||||
|
|> (\fb ->
|
||||||
|
case fb of
|
||||||
|
Just _ ->
|
||||||
|
fb
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
case
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
BodyParam key value ->
|
||||||
|
Just ( key, value )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
attributes
|
||||||
|
of
|
||||||
|
[] ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
head :: tail ->
|
||||||
|
Just <| E.object (head :: tail)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getHeaders : List ContextAttr -> List Http.Header
|
||||||
|
getHeaders =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
Header h ->
|
||||||
|
Just h
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getQueryParams : List ContextAttr -> List UrlBuilder.QueryParameter
|
||||||
|
getQueryParams =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
QueryParam q ->
|
||||||
|
Just q
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
getStatusCodes : List ContextAttr -> Dict.Dict Int ( Error, List Log )
|
||||||
|
getStatusCodes =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
StatusCodeResponse code err ->
|
||||||
|
Just ( code, err )
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> Dict.fromList
|
||||||
|
|
||||||
|
|
||||||
|
getTimeout : List ContextAttr -> Maybe Float
|
||||||
|
getTimeout =
|
||||||
|
List.filterMap
|
||||||
|
(\attr ->
|
||||||
|
case attr of
|
||||||
|
Timeout f ->
|
||||||
|
Just f
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
>> List.reverse
|
||||||
|
>> List.head
|
||||||
|
|
||||||
|
|
||||||
|
getUrl : ApiCall a -> String
|
||||||
|
getUrl { attributes, baseUrl, path } =
|
||||||
|
UrlBuilder.crossOrigin
|
||||||
|
baseUrl
|
||||||
|
(List.map Url.percentEncode path)
|
||||||
|
(getQueryParams attributes)
|
||||||
|
|
||||||
|
|
||||||
|
{-| When the HTTP request cannot be deciphered but the status code is known,
|
||||||
|
return with a given default error.
|
||||||
|
-}
|
||||||
|
onStatusCode : Int -> String -> Attribute a
|
||||||
|
onStatusCode code err _ =
|
||||||
|
StatusCodeResponse code
|
||||||
|
( err
|
||||||
|
|> E.string
|
||||||
|
|> Tuple.pair "errcode"
|
||||||
|
|> List.singleton
|
||||||
|
|> E.object
|
||||||
|
|> ServerReturnsError err
|
||||||
|
, String.concat
|
||||||
|
-- TODO: Move to Internal.Config.Text
|
||||||
|
[ "Received an invalid HTTP response from Matrix server "
|
||||||
|
, "but managed to decode it using the status code "
|
||||||
|
, String.fromInt code
|
||||||
|
, ": Default to errcode "
|
||||||
|
, err
|
||||||
|
]
|
||||||
|
|> log.warn
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryBool : String -> Bool -> Attribute a
|
||||||
|
queryBool key value _ =
|
||||||
|
(if value then
|
||||||
|
"true"
|
||||||
|
|
||||||
|
else
|
||||||
|
"false"
|
||||||
|
)
|
||||||
|
|> UrlBuilder.string key
|
||||||
|
|> QueryParam
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryInt : String -> Int -> Attribute a
|
||||||
|
queryInt key value _ =
|
||||||
|
QueryParam <| UrlBuilder.int key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
queryOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
queryOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpString : String -> Maybe String -> Attribute a
|
||||||
|
queryOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryString : String -> String -> Attribute a
|
||||||
|
queryString key value _ =
|
||||||
|
QueryParam <| UrlBuilder.string key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Resolve the response of a Matrix API call.
|
||||||
|
-}
|
||||||
|
rawApiCallResolver : D.Decoder ( a, List Log ) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
|
||||||
|
rawApiCallResolver decoder statusCodeErrors =
|
||||||
|
Http.stringResolver
|
||||||
|
(\response ->
|
||||||
|
case response of
|
||||||
|
Http.BadUrl_ s ->
|
||||||
|
Http.BadUrl s
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error ("Encountered bad URL " ++ s) ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.Timeout_ ->
|
||||||
|
Http.Timeout
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error "Encountered timeout - maybe the server is down?" ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.NetworkError_ ->
|
||||||
|
Http.NetworkError
|
||||||
|
|> InternetException
|
||||||
|
|> Tuple.pair
|
||||||
|
|> (|>) [ log.error "Encountered a network error - the user might be offline" ]
|
||||||
|
|> Err
|
||||||
|
|
||||||
|
Http.BadStatus_ metadata body ->
|
||||||
|
statusCodeErrors
|
||||||
|
|> Dict.get metadata.statusCode
|
||||||
|
|> decodeServerResponse decoder body
|
||||||
|
|
||||||
|
Http.GoodStatus_ metadata body ->
|
||||||
|
statusCodeErrors
|
||||||
|
|> Dict.get metadata.statusCode
|
||||||
|
|> decodeServerResponse decoder body
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Configure the HTTP request to time out after a given expiry time.
|
||||||
|
-}
|
||||||
|
timeout : Float -> Attribute a
|
||||||
|
timeout f _ =
|
||||||
|
Timeout f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform an APICall to a TaskChain.
|
||||||
|
-}
|
||||||
|
toChain :
|
||||||
|
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
|
||||||
|
, coder : Json.Coder httpOut
|
||||||
|
, request : ApiPlan ph1
|
||||||
|
, toContextChange : httpOut -> (APIContext ph1 -> APIContext ph2)
|
||||||
|
, toUpdate : httpOut -> ( update, List Log )
|
||||||
|
}
|
||||||
|
-> C.TaskChain Error update ph1 ph2
|
||||||
|
toChain data apiContext =
|
||||||
|
data.request apiContext
|
||||||
|
|> (\call ->
|
||||||
|
let
|
||||||
|
r : Request ( Error, List Log ) ( httpOut, List Log )
|
||||||
|
r =
|
||||||
|
{ method = call.method
|
||||||
|
, headers = getHeaders call.attributes
|
||||||
|
, url = getUrl call
|
||||||
|
, body =
|
||||||
|
getBody call.attributes
|
||||||
|
|> Maybe.map Http.jsonBody
|
||||||
|
|> Maybe.withDefault Http.emptyBody
|
||||||
|
, resolver = rawApiCallResolver (Json.decode data.coder) (getStatusCodes call.attributes)
|
||||||
|
, timeout = getTimeout call.attributes
|
||||||
|
}
|
||||||
|
|
||||||
|
logR : Request ( Error, List Log ) ( update, List Log )
|
||||||
|
logR =
|
||||||
|
{ method = call.method
|
||||||
|
, headers = getHeaders call.attributes
|
||||||
|
, url = getUrl call
|
||||||
|
, body =
|
||||||
|
getBody call.attributes
|
||||||
|
|> Maybe.map Http.jsonBody
|
||||||
|
|> Maybe.withDefault Http.emptyBody
|
||||||
|
, resolver =
|
||||||
|
rawApiCallResolver
|
||||||
|
(Json.decode data.coder
|
||||||
|
|> D.map
|
||||||
|
(\( out, logs ) ->
|
||||||
|
case data.toUpdate out of
|
||||||
|
( u, uLogs ) ->
|
||||||
|
( u, List.append logs uLogs )
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(getStatusCodes call.attributes)
|
||||||
|
, timeout = getTimeout call.attributes
|
||||||
|
}
|
||||||
|
in
|
||||||
|
case data.logHttp logR of
|
||||||
|
( httpU, httpLogs ) ->
|
||||||
|
Http.task r
|
||||||
|
|> Task.map
|
||||||
|
(\( httpO, logs ) ->
|
||||||
|
case data.toUpdate httpO of
|
||||||
|
( u, uLogs ) ->
|
||||||
|
{ contextChange = data.toContextChange httpO
|
||||||
|
, logs = List.concat [ httpLogs, logs, uLogs ]
|
||||||
|
, messages = [ httpU, u ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\( err, logs ) ->
|
||||||
|
{ error = err
|
||||||
|
, logs = List.append httpLogs logs
|
||||||
|
, messages = [ httpU ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add more attributes to the API plan.
|
||||||
|
-}
|
||||||
|
withAttributes : List (Attribute a) -> ApiPlan a -> ApiPlan a
|
||||||
|
withAttributes attrs f context =
|
||||||
|
f context
|
||||||
|
|> (\data ->
|
||||||
|
{ data
|
||||||
|
| attributes =
|
||||||
|
attrs
|
||||||
|
|> List.map (\attr -> attr data.context)
|
||||||
|
|> List.append data.attributes
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,180 @@
|
||||||
|
module Internal.Api.SendMessageEvent.Api exposing (Phantom, sendMessageEvent)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Send message event
|
||||||
|
|
||||||
|
This module helps send message events to rooms on the Matrix API.
|
||||||
|
|
||||||
|
@docs Phantom, sendMessageEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event to the Matrix room.
|
||||||
|
-}
|
||||||
|
sendMessageEvent : SendMessageEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
sendMessageEvent =
|
||||||
|
A.startWithVersion "r0.0.0" sendMessageEventV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.forVersion "r0.6.1" sendMessageEventV2
|
||||||
|
|> A.forVersion "v1.1" sendMessageEventV3
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for sending a message event
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventInput =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventInputV1 a =
|
||||||
|
{ a
|
||||||
|
| content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, transactionId : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventOutputV1 =
|
||||||
|
{ eventId : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendMessageEventOutputV2 =
|
||||||
|
{ eventId : String }
|
||||||
|
|
||||||
|
|
||||||
|
sendMessageEventV1 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendMessageEventV1 { content, eventType, roomId, transactionId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "send", eventType, transactionId ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendMessageEventV2 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendMessageEventV2 { content, eventType, roomId, transactionId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "send", eventType, transactionId ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendMessageEventV3 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendMessageEventV3 { content, eventType, roomId, transactionId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "send", eventType, transactionId ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SendMessageEventOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This endpoint is used to send a message event to a room. Message events allow access to historical events and pagination, making them suited for \"once-off\" activity in a room."
|
||||||
|
, "The body of the request should be the content object of the event; the fields in this object will vary depending on the type of event."
|
||||||
|
, "https://spec.matrix.org/legacy/r0.0.0/client_server.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
|
||||||
|
]
|
||||||
|
, init = SendMessageEventOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder SendMessageEventOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This endpoint is used to send a message event to a room. Message events allow access to historical events and pagination, making them suited for \"once-off\" activity in a room."
|
||||||
|
, "The body of the request should be the content object of the event; the fields in this object will vary depending on the type of event."
|
||||||
|
, "https://spec.matrix.org/legacy/client_server/r0.6.1.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
|
||||||
|
]
|
||||||
|
, init = SendMessageEventOutputV2
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,176 @@
|
||||||
|
module Internal.Api.SendStateEvent.Api exposing (..)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Send state event
|
||||||
|
|
||||||
|
This module sends state events to Matrix rooms.
|
||||||
|
|
||||||
|
@docs Phantom, sendStateEvent
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a Matrix room.
|
||||||
|
-}
|
||||||
|
sendStateEvent : SendStateEventInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
sendStateEvent =
|
||||||
|
A.startWithVersion "r0.0.0" sendStateEventV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.forVersion "r0.6.1" sendStateEventV2
|
||||||
|
|> A.forVersion "v1.1" sendStateEventV3
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for sending a state event
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventInput =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, stateKey : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventInputV1 a =
|
||||||
|
{ a
|
||||||
|
| content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
, roomId : String
|
||||||
|
, stateKey : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventOutputV1 =
|
||||||
|
{ eventId : Maybe String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SendStateEventOutputV2 =
|
||||||
|
{ eventId : String }
|
||||||
|
|
||||||
|
|
||||||
|
sendStateEventV1 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendStateEventV1 { content, eventType, roomId, stateKey } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendStateEventV2 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendStateEventV2 { content, eventType, roomId, stateKey } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sendStateEventV3 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
sendStateEventV3 { content, eventType, roomId, stateKey } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV2
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "rooms", roomId, "state", eventType, stateKey ]
|
||||||
|
, toUpdate =
|
||||||
|
\out ->
|
||||||
|
( E.More []
|
||||||
|
, out.eventId
|
||||||
|
|> Maybe.Just
|
||||||
|
|> Text.logs.sendEvent
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SendStateEventOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This object is returned after a state event has been sent."
|
||||||
|
]
|
||||||
|
, init = SendStateEventOutputV1
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderV2 : Json.Coder SendStateEventOutputV2
|
||||||
|
coderV2 =
|
||||||
|
Json.object1
|
||||||
|
{ name = "EventResponse"
|
||||||
|
, description =
|
||||||
|
[ "This object is returned after a state event has been sent."
|
||||||
|
]
|
||||||
|
, init = SendStateEventOutputV2
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "A unique identifier for the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
|
@ -0,0 +1,107 @@
|
||||||
|
module Internal.Api.SetAccountData.Api exposing (Phantom, setAccountData)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Set Account Data
|
||||||
|
|
||||||
|
This module allows the developer to set global account data.
|
||||||
|
|
||||||
|
@docs Phantom, setAccountData
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Room as R
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
setAccountData : SetAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
setAccountData =
|
||||||
|
A.startWithVersion "r0.0.0" setAccountDataV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" setAccountDataV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for setting global account data.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetAccountDataInput =
|
||||||
|
{ content : Json.Value, eventType : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetAccountDataInputV1 a =
|
||||||
|
{ a | content : Json.Value, eventType : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetAccountDataOutput =
|
||||||
|
()
|
||||||
|
|
||||||
|
|
||||||
|
setAccountDataV1 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setAccountDataV1 { content, eventType, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "user", userId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( V.SetAccountData eventType content
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
setAccountDataV2 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setAccountDataV2 { content, eventType, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "user", userId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( V.SetAccountData eventType content
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SetAccountDataOutput
|
||||||
|
coderV1 =
|
||||||
|
Json.unit
|
|
@ -0,0 +1,111 @@
|
||||||
|
module Internal.Api.SetRoomAccountData.Api exposing (..)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Set Room Account Data
|
||||||
|
|
||||||
|
This module allows the developer to set account data to a Matrix room.
|
||||||
|
|
||||||
|
@docs Phantom, setRoomAccountData
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Config.Log exposing (log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Room as R
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set account data to a Matrix room.
|
||||||
|
-}
|
||||||
|
setRoomAccountData : SetRoomAccountDataInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
setRoomAccountData =
|
||||||
|
A.startWithVersion "r0.0.0" setRoomAccountDataV1
|
||||||
|
|> A.sameForVersion "r0.0.1"
|
||||||
|
|> A.sameForVersion "r0.1.0"
|
||||||
|
|> A.sameForVersion "r0.2.0"
|
||||||
|
|> A.sameForVersion "r0.3.0"
|
||||||
|
|> A.sameForVersion "r0.4.0"
|
||||||
|
|> A.sameForVersion "r0.5.0"
|
||||||
|
|> A.sameForVersion "r0.6.0"
|
||||||
|
|> A.sameForVersion "r0.6.1"
|
||||||
|
|> A.forVersion "v1.1" setRoomAccountDataV2
|
||||||
|
|> A.sameForVersion "v1.2"
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.sameForVersion "v1.4"
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.sameForVersion "v1.11"
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for setting account data on a room.
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetRoomAccountDataInput =
|
||||||
|
{ content : Json.Value, eventType : String, roomId : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetRoomAccountDataInputV1 a =
|
||||||
|
{ a | content : Json.Value, eventType : String, roomId : String, userId : String }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SetRoomAccountDataOutputV1 =
|
||||||
|
()
|
||||||
|
|
||||||
|
|
||||||
|
setRoomAccountDataV1 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setRoomAccountDataV1 { content, eventType, roomId, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "r0", "user", userId, "rooms", roomId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( R.SetAccountData eventType content
|
||||||
|
|> V.MapRoom roomId
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
setRoomAccountDataV2 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
setRoomAccountDataV2 { content, eventType, roomId, userId } =
|
||||||
|
A.request
|
||||||
|
{ attributes = [ R.accessToken, R.fullBody content ]
|
||||||
|
, coder = coderV1
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "PUT"
|
||||||
|
, path = [ "_matrix", "client", "v3", "user", userId, "rooms", roomId, "account_data", eventType ]
|
||||||
|
, toUpdate =
|
||||||
|
\() ->
|
||||||
|
( R.SetAccountData eventType content
|
||||||
|
|> V.MapRoom roomId
|
||||||
|
|> E.ContentUpdate
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderV1 : Json.Coder SetRoomAccountDataOutputV1
|
||||||
|
coderV1 =
|
||||||
|
Json.unit
|
|
@ -0,0 +1,176 @@
|
||||||
|
module Internal.Api.Sync.Api exposing (sync, Phantom)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Sync
|
||||||
|
|
||||||
|
The sync module might be one of the most crucial parts of the Elm SDK. It offers
|
||||||
|
users the guarantee that the `Vault` type remains up-to-date, and it helps
|
||||||
|
communicate with the Matrix server about the Vault's needs.
|
||||||
|
|
||||||
|
@docs sync, Phantom
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Api.Request as R
|
||||||
|
import Internal.Api.Sync.V1 as V1
|
||||||
|
import Internal.Api.Sync.V2 as V2
|
||||||
|
import Internal.Api.Sync.V3 as V3
|
||||||
|
import Internal.Api.Sync.V4 as V4
|
||||||
|
import Internal.Filter.Timeline as Filter
|
||||||
|
|
||||||
|
|
||||||
|
{-| Sync with the Matrix API.
|
||||||
|
-}
|
||||||
|
sync : SyncInput -> A.TaskChain (Phantom a) (Phantom a)
|
||||||
|
sync =
|
||||||
|
A.startWithVersion "v1.1" syncV1
|
||||||
|
|> A.forVersion "v1.2" syncV2
|
||||||
|
|> A.sameForVersion "v1.3"
|
||||||
|
|> A.forVersion "v1.4" syncV3
|
||||||
|
|> A.sameForVersion "v1.5"
|
||||||
|
|> A.sameForVersion "v1.6"
|
||||||
|
|> A.sameForVersion "v1.7"
|
||||||
|
|> A.sameForVersion "v1.8"
|
||||||
|
|> A.sameForVersion "v1.9"
|
||||||
|
|> A.sameForVersion "v1.10"
|
||||||
|
|> A.forVersion "v1.11" syncV4
|
||||||
|
|> A.versionChain
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- For simplicity, we will not use a filter for now
|
||||||
|
-- and assume that every client always wants to receive all events.
|
||||||
|
-- type FilterV1
|
||||||
|
-- = FilterV1 Filter
|
||||||
|
-- | FilterIdV1 String Filter
|
||||||
|
-- | NoFilter
|
||||||
|
|
||||||
|
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | accessToken : (), baseUrl : (), versions : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias PhantomV1 a =
|
||||||
|
{ a | accessToken : (), baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
type alias SyncInput =
|
||||||
|
{ -- filter : FilterV1,
|
||||||
|
fullState : Maybe Bool
|
||||||
|
, presence : Maybe String
|
||||||
|
, since : Maybe String
|
||||||
|
, timeout : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias SyncInputV1 a =
|
||||||
|
{ a
|
||||||
|
| -- filter : FilterV1 ,
|
||||||
|
since : Maybe String
|
||||||
|
, fullState : Maybe Bool
|
||||||
|
, presence : Maybe String
|
||||||
|
, timeout : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
presenceFromOptions : List String -> Maybe String -> Maybe String
|
||||||
|
presenceFromOptions options =
|
||||||
|
Maybe.andThen
|
||||||
|
(\v ->
|
||||||
|
if List.member v options then
|
||||||
|
Just v
|
||||||
|
|
||||||
|
else
|
||||||
|
Nothing
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
syncV1 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
syncV1 data =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.queryOpString "filter" Nothing -- FILTER HERE
|
||||||
|
, R.queryOpBool "full_state" data.fullState
|
||||||
|
, data.presence
|
||||||
|
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|
||||||
|
|> R.queryOpString "set_presence"
|
||||||
|
, R.queryOpString "since" data.since
|
||||||
|
, R.queryOpInt "timeout" data.timeout
|
||||||
|
]
|
||||||
|
, coder = V1.coderSyncResponse
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
|
, toUpdate =
|
||||||
|
V1.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
syncV2 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
syncV2 data =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.queryOpString "filter" Nothing
|
||||||
|
, R.queryOpBool "full_state" data.fullState
|
||||||
|
, data.presence
|
||||||
|
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|
||||||
|
|> R.queryOpString "set_presence"
|
||||||
|
, R.queryOpString "since" data.since
|
||||||
|
, R.queryOpInt "timeout" data.timeout
|
||||||
|
]
|
||||||
|
, coder = V2.coderSyncResponse
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
|
, toUpdate =
|
||||||
|
V2.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
syncV3 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
syncV3 data =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.queryOpString "filter" Nothing
|
||||||
|
, R.queryOpBool "full_state" data.fullState
|
||||||
|
, data.presence
|
||||||
|
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|
||||||
|
|> R.queryOpString "set_presence"
|
||||||
|
, R.queryOpString "since" data.since
|
||||||
|
, R.queryOpInt "timeout" data.timeout
|
||||||
|
]
|
||||||
|
, coder = V3.coderSyncResponse
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
|
, toUpdate =
|
||||||
|
V3.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
syncV4 : SyncInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
|
||||||
|
syncV4 data =
|
||||||
|
A.request
|
||||||
|
{ attributes =
|
||||||
|
[ R.accessToken
|
||||||
|
, R.queryOpString "filter" Nothing
|
||||||
|
, R.queryOpBool "full_state" data.fullState
|
||||||
|
, data.presence
|
||||||
|
|> presenceFromOptions [ "offline", "online", "unavailable" ]
|
||||||
|
|> R.queryOpString "set_presence"
|
||||||
|
, R.queryOpString "since" data.since
|
||||||
|
, R.queryOpInt "timeout" data.timeout
|
||||||
|
]
|
||||||
|
, coder = V4.coderSyncResponse
|
||||||
|
, contextChange = always identity
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "v3", "sync" ]
|
||||||
|
, toUpdate =
|
||||||
|
V4.updateSyncResponse { filter = Filter.pass, since = data.since }
|
||||||
|
}
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,797 @@
|
||||||
|
module Internal.Api.Sync.V2 exposing (..)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Sync response
|
||||||
|
|
||||||
|
This API module represents the /sync endpoint on Matrix spec version v1.2 and
|
||||||
|
v1.3.
|
||||||
|
|
||||||
|
<https://spec.matrix.org/v1.2/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.3/client-server-api/#syncing>
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Api.Sync.V1 as PV
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Filter.Timeline exposing (Filter)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Internal.Values.Room as R
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
import Recursion
|
||||||
|
|
||||||
|
|
||||||
|
type alias SyncResponse =
|
||||||
|
{ accountData : Maybe AccountData
|
||||||
|
, deviceLists : Maybe DeviceLists
|
||||||
|
, deviceOneTimeKeysCount : Maybe (Dict String Int)
|
||||||
|
, deviceUnusedFallbackKeyTypes : List String
|
||||||
|
, nextBatch : String
|
||||||
|
, presence : Maybe Presence
|
||||||
|
, rooms : Maybe Rooms
|
||||||
|
, toDevice : Maybe ToDevice
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias AccountData =
|
||||||
|
{ events : Maybe (List Event) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias Event =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Presence =
|
||||||
|
{ events : Maybe (List Event) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias Rooms =
|
||||||
|
{ invite : Maybe (Dict String InvitedRoom)
|
||||||
|
, join : Maybe (Dict String JoinedRoom)
|
||||||
|
, knock : Maybe (Dict String KnockedRoom)
|
||||||
|
, leave : Maybe (Dict String LeftRoom)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias InvitedRoom =
|
||||||
|
{ inviteState : Maybe InviteState }
|
||||||
|
|
||||||
|
|
||||||
|
type alias InviteState =
|
||||||
|
{ events : Maybe (List StrippedStateEvent) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias StrippedStateEvent =
|
||||||
|
{ content : Json.Value
|
||||||
|
, sender : User
|
||||||
|
, stateKey : String
|
||||||
|
, eventType : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias JoinedRoom =
|
||||||
|
{ accountData : Maybe AccountData
|
||||||
|
, ephemeral : Maybe Ephemeral
|
||||||
|
, state : Maybe State
|
||||||
|
, summary : Maybe RoomSummary
|
||||||
|
, timeline : Maybe Timeline
|
||||||
|
, unreadNotifications : Maybe UnreadNotificationCounts
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Ephemeral =
|
||||||
|
{ events : Maybe (List Event) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias State =
|
||||||
|
{ events : Maybe (List ClientEventWithoutRoomID) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias ClientEventWithoutRoomID =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventId : String
|
||||||
|
, originServerTs : Timestamp
|
||||||
|
, sender : User
|
||||||
|
, stateKey : Maybe String
|
||||||
|
, eventType : String
|
||||||
|
, unsigned : Maybe UnsignedData
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type UnsignedData
|
||||||
|
= UnsignedData
|
||||||
|
{ age : Maybe Int
|
||||||
|
, prevContent : Maybe Json.Value
|
||||||
|
, redactedBecause : Maybe ClientEventWithoutRoomID
|
||||||
|
, transactionId : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias RoomSummary =
|
||||||
|
{ mHeroes : Maybe (List String)
|
||||||
|
, mInvitedMemberCount : Maybe Int
|
||||||
|
, mJoinedMemberCount : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Timeline =
|
||||||
|
{ events : List ClientEventWithoutRoomID
|
||||||
|
, limited : Maybe Bool
|
||||||
|
, prevBatch : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias UnreadNotificationCounts =
|
||||||
|
{ highlightCount : Maybe Int
|
||||||
|
, notificationCount : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias KnockedRoom =
|
||||||
|
{ knockState : Maybe KnockState }
|
||||||
|
|
||||||
|
|
||||||
|
type alias KnockState =
|
||||||
|
{ events : Maybe (List StrippedStateEvent) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias LeftRoom =
|
||||||
|
{ accountData : Maybe AccountData
|
||||||
|
, state : Maybe State
|
||||||
|
, timeline : Maybe Timeline
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias DeviceLists =
|
||||||
|
{ changed : Maybe (List String)
|
||||||
|
, left : Maybe (List String)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias ToDevice =
|
||||||
|
{ events : Maybe (List ToDeviceEvent) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias ToDeviceEvent =
|
||||||
|
{ content : Maybe Json.Value
|
||||||
|
, sender : Maybe User
|
||||||
|
, eventType : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderSyncResponse : Json.Coder SyncResponse
|
||||||
|
coderSyncResponse =
|
||||||
|
Json.object8
|
||||||
|
{ name = "SyncResponse"
|
||||||
|
, description = [ "An event that is part of a response." ]
|
||||||
|
, init = SyncResponse
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "account_data"
|
||||||
|
, toField = .accountData
|
||||||
|
, description = [ "The global private data created by this user." ]
|
||||||
|
, coder = coderAccountData
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_lists"
|
||||||
|
, toField = .deviceLists
|
||||||
|
, description = [ "Information on end-to-end device updates, as specified in End-to-end encryption." ]
|
||||||
|
, coder = coderDeviceLists
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_one_time_keys_count"
|
||||||
|
, toField = .deviceOneTimeKeysCount
|
||||||
|
, description = [ "Information on end-to-end encryption keys, as specified in End-to-end encryption." ]
|
||||||
|
, coder = Json.fastDict Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "device_unused_fallback_key_types"
|
||||||
|
, toField = .deviceUnusedFallbackKeyTypes
|
||||||
|
, description = [ "The unused fallback key algorithms." ]
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "next_batch"
|
||||||
|
, toField = .nextBatch
|
||||||
|
, description = [ "Required: The batch token to supply in the since param of the next /sync request." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "presence"
|
||||||
|
, toField = .presence
|
||||||
|
, description = [ "The updates to the presence status of other users." ]
|
||||||
|
, coder = coderPresence
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "rooms"
|
||||||
|
, toField = .rooms
|
||||||
|
, description = [ "Updates to rooms." ]
|
||||||
|
, coder = coderRooms
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "to_device"
|
||||||
|
, toField = .toDevice
|
||||||
|
, description = [ "Information on the send-to-device messages for the client device, as defined in Send-to-Device messaging." ]
|
||||||
|
, coder = coderToDevice
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderAccountData : Json.Coder AccountData
|
||||||
|
coderAccountData =
|
||||||
|
PV.coderAccountData
|
||||||
|
|
||||||
|
|
||||||
|
coderEvent : Json.Coder Event
|
||||||
|
coderEvent =
|
||||||
|
PV.coderEvent
|
||||||
|
|
||||||
|
|
||||||
|
coderPresence : Json.Coder Presence
|
||||||
|
coderPresence =
|
||||||
|
PV.coderPresence
|
||||||
|
|
||||||
|
|
||||||
|
coderRooms : Json.Coder Rooms
|
||||||
|
coderRooms =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Rooms"
|
||||||
|
, description = [ "Updates to rooms." ]
|
||||||
|
, init = Rooms
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "invite"
|
||||||
|
, toField = .invite
|
||||||
|
, description = [ "The rooms that the user has been invited to, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderInvitedRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "join"
|
||||||
|
, toField = .join
|
||||||
|
, description = [ "The rooms that the user has joined, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderJoinedRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "knock"
|
||||||
|
, toField = .knock
|
||||||
|
, description = [ "The rooms that the user has knocked upon, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderKnockedRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "leave"
|
||||||
|
, toField = .leave
|
||||||
|
, description = [ "The rooms that the user has left or been banned from, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderLeftRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderInvitedRoom : Json.Coder InvitedRoom
|
||||||
|
coderInvitedRoom =
|
||||||
|
PV.coderInvitedRoom
|
||||||
|
|
||||||
|
|
||||||
|
coderInviteState : Json.Coder InviteState
|
||||||
|
coderInviteState =
|
||||||
|
PV.coderInviteState
|
||||||
|
|
||||||
|
|
||||||
|
coderStrippedStateEvent : Json.Coder StrippedStateEvent
|
||||||
|
coderStrippedStateEvent =
|
||||||
|
PV.coderStrippedState
|
||||||
|
|
||||||
|
|
||||||
|
coderJoinedRoom : Json.Coder JoinedRoom
|
||||||
|
coderJoinedRoom =
|
||||||
|
Json.object6
|
||||||
|
{ name = "JoinedRoom"
|
||||||
|
, description = [ "The rooms that the user has joined." ]
|
||||||
|
, init = JoinedRoom
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "account_data"
|
||||||
|
, toField = .accountData
|
||||||
|
, description = [ "The private data that this user has attached to this room." ]
|
||||||
|
, coder = coderAccountData
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "ephemeral"
|
||||||
|
, toField = .ephemeral
|
||||||
|
, description = [ "The ephemeral events in the room that aren’t recorded in the timeline or state of the room. e.g. typing." ]
|
||||||
|
, coder = coderEphemeral
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state"
|
||||||
|
, toField = .state
|
||||||
|
, description = [ "Updates to the state, between the time indicated by the since parameter, and the start of the timeline (or all state up to the start of the timeline, if since is not given, or full_state is true).", "N.B. state updates for m.room.member events will be incomplete if lazy_load_members is enabled in the /sync filter, and only return the member events required to display the senders of the timeline events in this response." ]
|
||||||
|
, coder = coderState
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "summary"
|
||||||
|
, toField = .summary
|
||||||
|
, description = [ "Information about the room which clients may need to correctly render it to users." ]
|
||||||
|
, coder = coderRoomSummary
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "timeline"
|
||||||
|
, toField = .timeline
|
||||||
|
, description = [ "The timeline of messages and state changes in the room." ]
|
||||||
|
, coder = coderTimeline
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unread_notifications"
|
||||||
|
, toField = .unreadNotifications
|
||||||
|
, description = [ "Counts of unread notifications for this room. See the Receiving notifications section for more information on how these are calculated." ]
|
||||||
|
, coder = coderUnreadNotificationCounts
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderEphemeral : Json.Coder Ephemeral
|
||||||
|
coderEphemeral =
|
||||||
|
PV.coderEphemeral
|
||||||
|
|
||||||
|
|
||||||
|
coderState : Json.Coder State
|
||||||
|
coderState =
|
||||||
|
Json.object1
|
||||||
|
{ name = "State"
|
||||||
|
, description = [ "Updates to the state." ]
|
||||||
|
, init = State
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "events"
|
||||||
|
, toField = .events
|
||||||
|
, description = [ "List of events." ]
|
||||||
|
, coder = Json.list coderClientEventWithoutRoomID
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderClientEventWithoutRoomID : Json.Coder ClientEventWithoutRoomID
|
||||||
|
coderClientEventWithoutRoomID =
|
||||||
|
Json.object7
|
||||||
|
{ name = "ClientEventWithoutRoomID"
|
||||||
|
, description = [ "An event without a room ID." ]
|
||||||
|
, init = ClientEventWithoutRoomID
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "content"
|
||||||
|
, toField = .content
|
||||||
|
, description = [ "Required: The body of this event, as created by the client which sent it." ]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "event_id"
|
||||||
|
, toField = .eventId
|
||||||
|
, description = [ "Required: The globally unique identifier for this event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "origin_server_ts"
|
||||||
|
, toField = .originServerTs
|
||||||
|
, description = [ "Required: Timestamp (in milliseconds since the unix epoch) on originating homeserver when this event was sent." ]
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "sender"
|
||||||
|
, toField = .sender
|
||||||
|
, description = [ "Required: Contains the fully-qualified ID of the user who sent this event." ]
|
||||||
|
, coder = User.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state_key"
|
||||||
|
, toField = .stateKey
|
||||||
|
, description = [ "Present if, and only if, this event is a state event. The key making this piece of state unique in the room. Note that it is often an empty string." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "type"
|
||||||
|
, toField = .eventType
|
||||||
|
, description = [ "Required: The type of the event." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unsigned"
|
||||||
|
, toField = .unsigned
|
||||||
|
, description = [ "Contains optional extra information about the event." ]
|
||||||
|
, coder = coderUnsignedData
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderUnsignedData : Json.Coder UnsignedData
|
||||||
|
coderUnsignedData =
|
||||||
|
Json.object4
|
||||||
|
{ name = "UnsignedData"
|
||||||
|
, description = [ "Contains optional extra information about the event." ]
|
||||||
|
, init =
|
||||||
|
\a b c d ->
|
||||||
|
UnsignedData
|
||||||
|
{ age = a
|
||||||
|
, prevContent = b
|
||||||
|
, redactedBecause = c
|
||||||
|
, transactionId = d
|
||||||
|
}
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "age"
|
||||||
|
, toField = \(UnsignedData u) -> u.age
|
||||||
|
, description = [ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is." ]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "prev_content"
|
||||||
|
, toField = \(UnsignedData u) -> u.prevContent
|
||||||
|
, description = [ "The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content.", "Changed in v1.2: Previously, this field was specified at the top level of returned events rather than in unsigned (with the exception of the GET .../notifications endpoint), though in practice no known server implementations honoured this." ]
|
||||||
|
, coder = Json.value
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "redacted_because"
|
||||||
|
, toField = \(UnsignedData u) -> u.redactedBecause
|
||||||
|
, description = [ "The event that redacted this event, if any." ]
|
||||||
|
, coder = Json.lazy (\_ -> coderClientEventWithoutRoomID)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "transaction_id"
|
||||||
|
, toField = \(UnsignedData u) -> u.transactionId
|
||||||
|
, description = [ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderRoomSummary : Json.Coder RoomSummary
|
||||||
|
coderRoomSummary =
|
||||||
|
PV.coderRoomSummary
|
||||||
|
|
||||||
|
|
||||||
|
coderTimeline : Json.Coder Timeline
|
||||||
|
coderTimeline =
|
||||||
|
Json.object3
|
||||||
|
{ name = "Timeline"
|
||||||
|
, description = [ "The timeline of messages and state changes in the room." ]
|
||||||
|
, init = Timeline
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "events"
|
||||||
|
, toField = .events
|
||||||
|
, description = [ "Required: List of events." ]
|
||||||
|
, coder = Json.list coderClientEventWithoutRoomID
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "limited"
|
||||||
|
, toField = .limited
|
||||||
|
, description = [ "True if the number of events returned was limited by the limit on the filter." ]
|
||||||
|
, coder = Json.bool
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "prev_batch"
|
||||||
|
, toField = .prevBatch
|
||||||
|
, description = [ "A token that can be supplied to the from parameter of the /rooms/<room_id>/messages endpoint in order to retrieve earlier events. If no earlier events are available, this property may be omitted from the response." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderUnreadNotificationCounts : Json.Coder UnreadNotificationCounts
|
||||||
|
coderUnreadNotificationCounts =
|
||||||
|
PV.coderUnreadNotificationCounts
|
||||||
|
|
||||||
|
|
||||||
|
coderKnockedRoom : Json.Coder KnockedRoom
|
||||||
|
coderKnockedRoom =
|
||||||
|
PV.coderKnockedRoom
|
||||||
|
|
||||||
|
|
||||||
|
coderKnockState : Json.Coder KnockState
|
||||||
|
coderKnockState =
|
||||||
|
PV.coderKnockState
|
||||||
|
|
||||||
|
|
||||||
|
coderLeftRoom : Json.Coder LeftRoom
|
||||||
|
coderLeftRoom =
|
||||||
|
Json.object3
|
||||||
|
{ name = "LeftRoom"
|
||||||
|
, description = [ "The rooms that the user has left or been banned from." ]
|
||||||
|
, init = LeftRoom
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "account_data"
|
||||||
|
, toField = .accountData
|
||||||
|
, description = [ "The private data that this user has attached to this room." ]
|
||||||
|
, coder = coderAccountData
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state"
|
||||||
|
, toField = .state
|
||||||
|
, description = [ "The state updates for the room up to the start of the timeline." ]
|
||||||
|
, coder = coderState
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "timeline"
|
||||||
|
, toField = .timeline
|
||||||
|
, description = [ "The timeline of messages and state changes in the room up to the point when the user left." ]
|
||||||
|
, coder = coderTimeline
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderDeviceLists : Json.Coder DeviceLists
|
||||||
|
coderDeviceLists =
|
||||||
|
PV.coderDeviceLists
|
||||||
|
|
||||||
|
|
||||||
|
coderToDevice : Json.Coder ToDevice
|
||||||
|
coderToDevice =
|
||||||
|
PV.coderToDevice
|
||||||
|
|
||||||
|
|
||||||
|
coderToDeviceEvent : Json.Coder ToDeviceEvent
|
||||||
|
coderToDeviceEvent =
|
||||||
|
PV.coderToDeviceEvent
|
||||||
|
|
||||||
|
|
||||||
|
updateSyncResponse : { filter : Filter, since : Maybe String } -> SyncResponse -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
|
||||||
|
updateSyncResponse { filter, since } response =
|
||||||
|
-- Account data
|
||||||
|
[ response.accountData
|
||||||
|
|> Maybe.andThen .events
|
||||||
|
|> Maybe.map (List.map (\e -> V.SetAccountData e.eventType e.content))
|
||||||
|
|> Maybe.map
|
||||||
|
(\x ->
|
||||||
|
( E.ContentUpdate <| V.More x
|
||||||
|
, if List.length x > 0 then
|
||||||
|
List.length x
|
||||||
|
|> Text.logs.syncAccountDataFound
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
-- TODO: Add device lists
|
||||||
|
-- Next batch
|
||||||
|
, Just ( E.SetNextBatch response.nextBatch, [] )
|
||||||
|
|
||||||
|
-- TODO: Add presence
|
||||||
|
-- Rooms
|
||||||
|
, Maybe.map
|
||||||
|
(updateRooms { filter = filter, nextBatch = response.nextBatch, since = since }
|
||||||
|
>> Tuple.mapFirst E.ContentUpdate
|
||||||
|
)
|
||||||
|
response.rooms
|
||||||
|
|
||||||
|
-- TODO: Add to_device
|
||||||
|
]
|
||||||
|
|> List.filterMap identity
|
||||||
|
|> List.unzip
|
||||||
|
|> Tuple.mapFirst E.More
|
||||||
|
|> Tuple.mapSecond List.concat
|
||||||
|
|
||||||
|
|
||||||
|
updateRooms : { filter : Filter, nextBatch : String, since : Maybe String } -> Rooms -> ( V.VaultUpdate, List Log )
|
||||||
|
updateRooms { filter, nextBatch, since } rooms =
|
||||||
|
let
|
||||||
|
( roomUpdate, roomLogs ) =
|
||||||
|
rooms.join
|
||||||
|
|> Maybe.withDefault Dict.empty
|
||||||
|
|> Dict.toList
|
||||||
|
|> List.map
|
||||||
|
(\( roomId, room ) ->
|
||||||
|
let
|
||||||
|
( u, l ) =
|
||||||
|
updateJoinedRoom
|
||||||
|
{ filter = filter
|
||||||
|
, nextBatch = nextBatch
|
||||||
|
, roomId = roomId
|
||||||
|
, since = since
|
||||||
|
}
|
||||||
|
room
|
||||||
|
in
|
||||||
|
( V.MapRoom roomId u, l )
|
||||||
|
)
|
||||||
|
|> List.unzip
|
||||||
|
|> Tuple.mapBoth V.More List.concat
|
||||||
|
in
|
||||||
|
( V.More
|
||||||
|
-- Add rooms
|
||||||
|
[ rooms.join
|
||||||
|
|> Maybe.withDefault Dict.empty
|
||||||
|
|> Dict.keys
|
||||||
|
|> List.map V.CreateRoomIfNotExists
|
||||||
|
|> V.More
|
||||||
|
|
||||||
|
-- Update rooms
|
||||||
|
, roomUpdate
|
||||||
|
|
||||||
|
-- TODO: Add invited rooms
|
||||||
|
-- TODO: Add knocked rooms
|
||||||
|
-- TODO: Add left rooms
|
||||||
|
]
|
||||||
|
, roomLogs
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
updateJoinedRoom : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> JoinedRoom -> ( R.RoomUpdate, List Log )
|
||||||
|
updateJoinedRoom data room =
|
||||||
|
( R.More
|
||||||
|
[ room.accountData
|
||||||
|
|> Maybe.andThen .events
|
||||||
|
|> Maybe.map
|
||||||
|
(\events ->
|
||||||
|
events
|
||||||
|
|> List.map (\e -> R.SetAccountData e.eventType e.content)
|
||||||
|
|> R.More
|
||||||
|
)
|
||||||
|
|> R.Optional
|
||||||
|
, room.ephemeral
|
||||||
|
|> Maybe.andThen .events
|
||||||
|
|> Maybe.map R.SetEphemeral
|
||||||
|
|> R.Optional
|
||||||
|
|
||||||
|
-- TODO: Add state
|
||||||
|
-- TODO: Add RoomSummary
|
||||||
|
, room.timeline
|
||||||
|
|> Maybe.map (updateTimeline data)
|
||||||
|
|> R.Optional
|
||||||
|
|
||||||
|
-- TODO: Add unread notifications
|
||||||
|
]
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
updateTimeline : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> Timeline -> R.RoomUpdate
|
||||||
|
updateTimeline { filter, nextBatch, roomId, since } timeline =
|
||||||
|
let
|
||||||
|
limited : Bool
|
||||||
|
limited =
|
||||||
|
Maybe.withDefault False timeline.limited
|
||||||
|
|
||||||
|
newEvents : List Event.Event
|
||||||
|
newEvents =
|
||||||
|
List.map (toEvent roomId) timeline.events
|
||||||
|
in
|
||||||
|
case ( limited, timeline.prevBatch ) of
|
||||||
|
( False, Just p ) ->
|
||||||
|
if timeline.prevBatch == since then
|
||||||
|
R.AddSync
|
||||||
|
{ events = newEvents
|
||||||
|
, filter = filter
|
||||||
|
, start = Just p
|
||||||
|
, end = nextBatch
|
||||||
|
}
|
||||||
|
|
||||||
|
else
|
||||||
|
R.More
|
||||||
|
[ R.AddSync
|
||||||
|
{ events = []
|
||||||
|
, filter = filter
|
||||||
|
, start = since
|
||||||
|
, end = p
|
||||||
|
}
|
||||||
|
, R.AddSync
|
||||||
|
{ events = newEvents
|
||||||
|
, filter = filter
|
||||||
|
, start = Just p
|
||||||
|
, end = nextBatch
|
||||||
|
}
|
||||||
|
]
|
||||||
|
|
||||||
|
( False, Nothing ) ->
|
||||||
|
R.AddSync
|
||||||
|
{ events = newEvents
|
||||||
|
, filter = filter
|
||||||
|
, start = since
|
||||||
|
, end = nextBatch
|
||||||
|
}
|
||||||
|
|
||||||
|
( True, _ ) ->
|
||||||
|
R.AddSync
|
||||||
|
{ events = newEvents
|
||||||
|
, filter = filter
|
||||||
|
, start = timeline.prevBatch
|
||||||
|
, end = nextBatch
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
toEvent : String -> ClientEventWithoutRoomID -> Event.Event
|
||||||
|
toEvent roomId event =
|
||||||
|
Recursion.runRecursion
|
||||||
|
(\ev ->
|
||||||
|
case Maybe.andThen (\(UnsignedData u) -> u.redactedBecause) ev.unsigned of
|
||||||
|
Just e ->
|
||||||
|
Recursion.recurseThen e
|
||||||
|
(\eo ->
|
||||||
|
Recursion.base
|
||||||
|
{ content = ev.content
|
||||||
|
, eventId = ev.eventId
|
||||||
|
, originServerTs = ev.originServerTs
|
||||||
|
, roomId = roomId
|
||||||
|
, sender = ev.sender
|
||||||
|
, stateKey = ev.stateKey
|
||||||
|
, eventType = ev.eventType
|
||||||
|
, unsigned = toUnsigned (Just eo) ev.unsigned
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Recursion.base
|
||||||
|
{ content = ev.content
|
||||||
|
, eventId = ev.eventId
|
||||||
|
, originServerTs = ev.originServerTs
|
||||||
|
, roomId = roomId
|
||||||
|
, sender = ev.sender
|
||||||
|
, stateKey = ev.stateKey
|
||||||
|
, eventType = ev.eventType
|
||||||
|
, unsigned = toUnsigned Nothing ev.unsigned
|
||||||
|
}
|
||||||
|
)
|
||||||
|
event
|
||||||
|
|
||||||
|
|
||||||
|
toUnsigned : Maybe Event.Event -> Maybe UnsignedData -> Maybe Event.UnsignedData
|
||||||
|
toUnsigned ev unsigned =
|
||||||
|
case ( ev, unsigned ) of
|
||||||
|
( Nothing, Nothing ) ->
|
||||||
|
Nothing
|
||||||
|
|
||||||
|
( Just e, Nothing ) ->
|
||||||
|
{ age = Nothing
|
||||||
|
, membership = Nothing
|
||||||
|
, prevContent = Nothing
|
||||||
|
, redactedBecause = Just e
|
||||||
|
, transactionId = Nothing
|
||||||
|
}
|
||||||
|
|> Event.UnsignedData
|
||||||
|
|> Just
|
||||||
|
|
||||||
|
( _, Just (UnsignedData u) ) ->
|
||||||
|
{ age = u.age
|
||||||
|
, membership = Nothing
|
||||||
|
, prevContent = u.prevContent
|
||||||
|
, redactedBecause = ev
|
||||||
|
, transactionId = u.transactionId
|
||||||
|
}
|
||||||
|
|> Event.UnsignedData
|
||||||
|
|> Just
|
|
@ -0,0 +1,580 @@
|
||||||
|
module Internal.Api.Sync.V3 exposing (..)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Sync response
|
||||||
|
|
||||||
|
This API module represents the /sync endpoint on the following Matrix spec
|
||||||
|
versions:
|
||||||
|
|
||||||
|
<https://spec.matrix.org/v1.4/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.5/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.6/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.7/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.8/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.9/client-server-api/#syncing>
|
||||||
|
<https://spec.matrix.org/v1.10/client-server-api/#syncing>
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Api.Sync.V2 as PV
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Filter.Timeline exposing (Filter)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp exposing (Timestamp)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Internal.Values.Event as Event
|
||||||
|
import Internal.Values.Room as R
|
||||||
|
import Internal.Values.User exposing (User)
|
||||||
|
import Internal.Values.Vault as V
|
||||||
|
|
||||||
|
|
||||||
|
type alias SyncResponse =
|
||||||
|
{ accountData : Maybe AccountData
|
||||||
|
, deviceLists : Maybe DeviceLists
|
||||||
|
, deviceOneTimeKeysCount : Maybe (Dict String Int)
|
||||||
|
, deviceUnusedFallbackKeyTypes : List String
|
||||||
|
, nextBatch : String
|
||||||
|
, presence : Maybe Presence
|
||||||
|
, rooms : Maybe Rooms
|
||||||
|
, toDevice : Maybe ToDevice
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias AccountData =
|
||||||
|
{ events : Maybe (List Event) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias Event =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventType : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Presence =
|
||||||
|
{ events : Maybe (List Event) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias Rooms =
|
||||||
|
{ invite : Maybe (Dict String InvitedRoom)
|
||||||
|
, join : Maybe (Dict String JoinedRoom)
|
||||||
|
, knock : Maybe (Dict String KnockedRoom)
|
||||||
|
, leave : Maybe (Dict String LeftRoom)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias InvitedRoom =
|
||||||
|
{ inviteState : Maybe InviteState }
|
||||||
|
|
||||||
|
|
||||||
|
type alias InviteState =
|
||||||
|
{ events : Maybe (List StrippedStateEvent) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias StrippedStateEvent =
|
||||||
|
{ content : Json.Value
|
||||||
|
, sender : User
|
||||||
|
, stateKey : String
|
||||||
|
, eventType : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias JoinedRoom =
|
||||||
|
{ accountData : Maybe AccountData
|
||||||
|
, ephemeral : Maybe Ephemeral
|
||||||
|
, state : Maybe State
|
||||||
|
, summary : Maybe RoomSummary
|
||||||
|
, timeline : Maybe Timeline
|
||||||
|
, unreadNotifications : Maybe UnreadNotificationCounts
|
||||||
|
, unreadThreadNotifications : Maybe (Dict String ThreadNotificationCounts)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Ephemeral =
|
||||||
|
{ events : Maybe (List Event) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias State =
|
||||||
|
{ events : Maybe (List ClientEventWithoutRoomID) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias ClientEventWithoutRoomID =
|
||||||
|
{ content : Json.Value
|
||||||
|
, eventId : String
|
||||||
|
, originServerTs : Timestamp
|
||||||
|
, sender : User
|
||||||
|
, stateKey : Maybe String
|
||||||
|
, eventType : String
|
||||||
|
, unsigned : Maybe UnsignedData
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias UnsignedData =
|
||||||
|
PV.UnsignedData
|
||||||
|
|
||||||
|
|
||||||
|
type alias RoomSummary =
|
||||||
|
{ mHeroes : Maybe (List String)
|
||||||
|
, mInvitedMemberCount : Maybe Int
|
||||||
|
, mJoinedMemberCount : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Timeline =
|
||||||
|
{ events : List ClientEventWithoutRoomID
|
||||||
|
, limited : Maybe Bool
|
||||||
|
, prevBatch : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias UnreadNotificationCounts =
|
||||||
|
{ highlightCount : Maybe Int
|
||||||
|
, notificationCount : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias ThreadNotificationCounts =
|
||||||
|
{ highlightCount : Maybe Int
|
||||||
|
, notificationCount : Maybe Int
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias KnockedRoom =
|
||||||
|
{ knockState : Maybe KnockState }
|
||||||
|
|
||||||
|
|
||||||
|
type alias KnockState =
|
||||||
|
{ events : Maybe (List StrippedStateEvent) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias LeftRoom =
|
||||||
|
{ accountData : Maybe AccountData
|
||||||
|
, state : Maybe State
|
||||||
|
, timeline : Maybe Timeline
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias DeviceLists =
|
||||||
|
{ changed : Maybe (List String)
|
||||||
|
, left : Maybe (List String)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias ToDevice =
|
||||||
|
{ events : Maybe (List ToDeviceEvent) }
|
||||||
|
|
||||||
|
|
||||||
|
type alias ToDeviceEvent =
|
||||||
|
{ content : Maybe Json.Value
|
||||||
|
, sender : Maybe User
|
||||||
|
, eventType : Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
coderSyncResponse : Json.Coder SyncResponse
|
||||||
|
coderSyncResponse =
|
||||||
|
Json.object8
|
||||||
|
{ name = "SyncResponse"
|
||||||
|
, description = [ "The response for a sync request." ]
|
||||||
|
, init = SyncResponse
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "account_data"
|
||||||
|
, toField = .accountData
|
||||||
|
, description = [ "The global private data created by this user." ]
|
||||||
|
, coder = coderAccountData
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_lists"
|
||||||
|
, toField = .deviceLists
|
||||||
|
, description = [ "Information on end-to-end device updates, as specified in End-to-end encryption." ]
|
||||||
|
, coder = coderDeviceLists
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "device_one_time_keys_count"
|
||||||
|
, toField = .deviceOneTimeKeysCount
|
||||||
|
, description = [ "Information on end-to-end encryption keys, as specified in End-to-end encryption." ]
|
||||||
|
, coder = Json.fastDict Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "device_unused_fallback_key_types"
|
||||||
|
, toField = .deviceUnusedFallbackKeyTypes
|
||||||
|
, description = [ "The unused fallback key algorithms." ]
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "next_batch"
|
||||||
|
, toField = .nextBatch
|
||||||
|
, description = [ "The batch token to supply in the since param of the next /sync request." ]
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "presence"
|
||||||
|
, toField = .presence
|
||||||
|
, description = [ "The updates to the presence status of other users." ]
|
||||||
|
, coder = coderPresence
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "rooms"
|
||||||
|
, toField = .rooms
|
||||||
|
, description = [ "Updates to rooms." ]
|
||||||
|
, coder = coderRooms
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "to_device"
|
||||||
|
, toField = .toDevice
|
||||||
|
, description = [ "Information on the send-to-device messages for the client device, as defined in Send-to-Device messaging." ]
|
||||||
|
, coder = coderToDevice
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderAccountData : Json.Coder AccountData
|
||||||
|
coderAccountData =
|
||||||
|
PV.coderAccountData
|
||||||
|
|
||||||
|
|
||||||
|
coderEvent : Json.Coder Event
|
||||||
|
coderEvent =
|
||||||
|
PV.coderEvent
|
||||||
|
|
||||||
|
|
||||||
|
coderPresence : Json.Coder Presence
|
||||||
|
coderPresence =
|
||||||
|
PV.coderPresence
|
||||||
|
|
||||||
|
|
||||||
|
coderRooms : Json.Coder Rooms
|
||||||
|
coderRooms =
|
||||||
|
Json.object4
|
||||||
|
{ name = "Rooms"
|
||||||
|
, description = [ "Updates to rooms." ]
|
||||||
|
, init = Rooms
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "invite"
|
||||||
|
, toField = .invite
|
||||||
|
, description = [ "The rooms that the user has been invited to, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderInvitedRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "join"
|
||||||
|
, toField = .join
|
||||||
|
, description = [ "The rooms that the user has joined, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderJoinedRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "knock"
|
||||||
|
, toField = .knock
|
||||||
|
, description = [ "The rooms that the user has knocked upon, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderKnockedRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "leave"
|
||||||
|
, toField = .leave
|
||||||
|
, description = [ "The rooms that the user has left or been banned from, mapped as room ID to room information." ]
|
||||||
|
, coder = Json.fastDict coderLeftRoom
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderInvitedRoom : Json.Coder InvitedRoom
|
||||||
|
coderInvitedRoom =
|
||||||
|
PV.coderInvitedRoom
|
||||||
|
|
||||||
|
|
||||||
|
coderInviteState : Json.Coder InviteState
|
||||||
|
coderInviteState =
|
||||||
|
PV.coderInviteState
|
||||||
|
|
||||||
|
|
||||||
|
coderStrippedStateEvent : Json.Coder StrippedStateEvent
|
||||||
|
coderStrippedStateEvent =
|
||||||
|
PV.coderStrippedStateEvent
|
||||||
|
|
||||||
|
|
||||||
|
coderJoinedRoom : Json.Coder JoinedRoom
|
||||||
|
coderJoinedRoom =
|
||||||
|
Json.object7
|
||||||
|
{ name = "JoinedRoom"
|
||||||
|
, description = [ "Information about a room the user has joined." ]
|
||||||
|
, init = JoinedRoom
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "account_data"
|
||||||
|
, toField = .accountData
|
||||||
|
, description = [ "The private data that this user has attached to this room." ]
|
||||||
|
, coder = coderAccountData
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "ephemeral"
|
||||||
|
, toField = .ephemeral
|
||||||
|
, description = [ "The ephemeral events in the room that aren’t recorded in the timeline or state of the room. e.g. typing." ]
|
||||||
|
, coder = coderEphemeral
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "state"
|
||||||
|
, toField = .state
|
||||||
|
, description = [ "Updates to the state, between the time indicated by the since parameter, and the start of the timeline (or all state up to the start of the timeline, if since is not given, or full_state is true).", "N.B. state updates for m.room.member events will be incomplete if lazy_load_members is enabled in the /sync filter, and only return the member events required to display the senders of the timeline events in this response." ]
|
||||||
|
, coder = coderState
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "summary"
|
||||||
|
, toField = .summary
|
||||||
|
, description = [ "Information about the room which clients may need to correctly render it to users." ]
|
||||||
|
, coder = coderRoomSummary
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "timeline"
|
||||||
|
, toField = .timeline
|
||||||
|
, description = [ "The timeline of messages and state changes in the room." ]
|
||||||
|
, coder = coderTimeline
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unread_notifications"
|
||||||
|
, toField = .unreadNotifications
|
||||||
|
, description = [ "Counts of unread notifications for this room. See the Receiving notifications section for more information on how these are calculated.", "If unread_thread_notifications was specified as true on the RoomEventFilter, these counts will only be for the main timeline rather than all events in the room. See the threading module for more information.", "Changed in v1.4: Updated to reflect behaviour of having unread_thread_notifications as true in the RoomEventFilter for /sync." ]
|
||||||
|
, coder = coderUnreadNotificationCounts
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "unread_thread_notifications"
|
||||||
|
, toField = .unreadThreadNotifications
|
||||||
|
, description = [ "If unread_thread_notifications was specified as true on the RoomEventFilter, the notification counts for each thread in this room. The object is keyed by thread root ID, with values matching unread_notifications.", "If a thread does not have any notifications it can be omitted from this object. If no threads have notification counts, this whole object can be omitted.", "Added in v1.4" ]
|
||||||
|
, coder = Json.fastDict coderThreadNotificationCounts
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderEphemeral : Json.Coder Ephemeral
|
||||||
|
coderEphemeral =
|
||||||
|
PV.coderEphemeral
|
||||||
|
|
||||||
|
|
||||||
|
coderState : Json.Coder State
|
||||||
|
coderState =
|
||||||
|
PV.coderState
|
||||||
|
|
||||||
|
|
||||||
|
coderClientEventWithoutRoomID : Json.Coder ClientEventWithoutRoomID
|
||||||
|
coderClientEventWithoutRoomID =
|
||||||
|
PV.coderClientEventWithoutRoomID
|
||||||
|
|
||||||
|
|
||||||
|
coderUnsignedData : Json.Coder UnsignedData
|
||||||
|
coderUnsignedData =
|
||||||
|
PV.coderUnsignedData
|
||||||
|
|
||||||
|
|
||||||
|
coderRoomSummary : Json.Coder RoomSummary
|
||||||
|
coderRoomSummary =
|
||||||
|
PV.coderRoomSummary
|
||||||
|
|
||||||
|
|
||||||
|
coderTimeline : Json.Coder Timeline
|
||||||
|
coderTimeline =
|
||||||
|
PV.coderTimeline
|
||||||
|
|
||||||
|
|
||||||
|
coderUnreadNotificationCounts : Json.Coder UnreadNotificationCounts
|
||||||
|
coderUnreadNotificationCounts =
|
||||||
|
PV.coderUnreadNotificationCounts
|
||||||
|
|
||||||
|
|
||||||
|
coderThreadNotificationCounts : Json.Coder ThreadNotificationCounts
|
||||||
|
coderThreadNotificationCounts =
|
||||||
|
Json.object2
|
||||||
|
{ name = "ThreadNotificationCounts"
|
||||||
|
, description = [ "The notification counts for each thread in this room." ]
|
||||||
|
, init = ThreadNotificationCounts
|
||||||
|
}
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "highlight_count"
|
||||||
|
, toField = .highlightCount
|
||||||
|
, description = [ "The number of unread notifications for this thread with the highlight flag set." ]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "notification_count"
|
||||||
|
, toField = .notificationCount
|
||||||
|
, description = [ "The total number of unread notifications for this thread." ]
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
coderKnockedRoom : Json.Coder KnockedRoom
|
||||||
|
coderKnockedRoom =
|
||||||
|
PV.coderKnockedRoom
|
||||||
|
|
||||||
|
|
||||||
|
coderKnockState : Json.Coder KnockState
|
||||||
|
coderKnockState =
|
||||||
|
PV.coderKnockState
|
||||||
|
|
||||||
|
|
||||||
|
coderLeftRoom : Json.Coder LeftRoom
|
||||||
|
coderLeftRoom =
|
||||||
|
PV.coderLeftRoom
|
||||||
|
|
||||||
|
|
||||||
|
coderDeviceLists : Json.Coder DeviceLists
|
||||||
|
coderDeviceLists =
|
||||||
|
PV.coderDeviceLists
|
||||||
|
|
||||||
|
|
||||||
|
coderToDevice : Json.Coder ToDevice
|
||||||
|
coderToDevice =
|
||||||
|
PV.coderToDevice
|
||||||
|
|
||||||
|
|
||||||
|
coderToDeviceEvent : Json.Coder ToDeviceEvent
|
||||||
|
coderToDeviceEvent =
|
||||||
|
PV.coderToDeviceEvent
|
||||||
|
|
||||||
|
|
||||||
|
updateSyncResponse : { filter : Filter, since : Maybe String } -> SyncResponse -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
|
||||||
|
updateSyncResponse { filter, since } response =
|
||||||
|
-- Account data
|
||||||
|
[ response.accountData
|
||||||
|
|> Maybe.andThen .events
|
||||||
|
|> Maybe.map (List.map (\e -> V.SetAccountData e.eventType e.content))
|
||||||
|
|> Maybe.map
|
||||||
|
(\x ->
|
||||||
|
( E.ContentUpdate <| V.More x
|
||||||
|
, if List.length x > 0 then
|
||||||
|
List.length x
|
||||||
|
|> Text.logs.syncAccountDataFound
|
||||||
|
|> log.debug
|
||||||
|
|> List.singleton
|
||||||
|
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
-- TODO: Add device lists
|
||||||
|
-- Next batch
|
||||||
|
, Just ( E.SetNextBatch response.nextBatch, [] )
|
||||||
|
|
||||||
|
-- TODO: Add presence
|
||||||
|
-- Rooms
|
||||||
|
, Maybe.map
|
||||||
|
(updateRooms { filter = filter, nextBatch = response.nextBatch, since = since }
|
||||||
|
>> Tuple.mapFirst E.ContentUpdate
|
||||||
|
)
|
||||||
|
response.rooms
|
||||||
|
|
||||||
|
-- TODO: Add to_device
|
||||||
|
]
|
||||||
|
|> List.filterMap identity
|
||||||
|
|> List.unzip
|
||||||
|
|> Tuple.mapFirst E.More
|
||||||
|
|> Tuple.mapSecond List.concat
|
||||||
|
|
||||||
|
|
||||||
|
updateRooms : { filter : Filter, nextBatch : String, since : Maybe String } -> Rooms -> ( V.VaultUpdate, List Log )
|
||||||
|
updateRooms { filter, nextBatch, since } rooms =
|
||||||
|
let
|
||||||
|
( roomUpdate, roomLogs ) =
|
||||||
|
rooms.join
|
||||||
|
|> Maybe.withDefault Dict.empty
|
||||||
|
|> Dict.toList
|
||||||
|
|> List.map
|
||||||
|
(\( roomId, room ) ->
|
||||||
|
let
|
||||||
|
( u, l ) =
|
||||||
|
updateJoinedRoom
|
||||||
|
{ filter = filter
|
||||||
|
, nextBatch = nextBatch
|
||||||
|
, roomId = roomId
|
||||||
|
, since = since
|
||||||
|
}
|
||||||
|
room
|
||||||
|
in
|
||||||
|
( V.MapRoom roomId u, l )
|
||||||
|
)
|
||||||
|
|> List.unzip
|
||||||
|
|> Tuple.mapBoth V.More List.concat
|
||||||
|
in
|
||||||
|
( V.More
|
||||||
|
-- Add rooms
|
||||||
|
[ rooms.join
|
||||||
|
|> Maybe.withDefault Dict.empty
|
||||||
|
|> Dict.keys
|
||||||
|
|> List.map V.CreateRoomIfNotExists
|
||||||
|
|> V.More
|
||||||
|
|
||||||
|
-- Update rooms
|
||||||
|
, roomUpdate
|
||||||
|
|
||||||
|
-- TODO: Add invited rooms
|
||||||
|
-- TODO: Add knocked rooms
|
||||||
|
-- TODO: Add left rooms
|
||||||
|
]
|
||||||
|
, roomLogs
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
updateJoinedRoom : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> JoinedRoom -> ( R.RoomUpdate, List Log )
|
||||||
|
updateJoinedRoom data room =
|
||||||
|
( R.More
|
||||||
|
[ room.accountData
|
||||||
|
|> Maybe.andThen .events
|
||||||
|
|> Maybe.map
|
||||||
|
(\events ->
|
||||||
|
events
|
||||||
|
|> List.map (\e -> R.SetAccountData e.eventType e.content)
|
||||||
|
|> R.More
|
||||||
|
)
|
||||||
|
|> R.Optional
|
||||||
|
, room.ephemeral
|
||||||
|
|> Maybe.andThen .events
|
||||||
|
|> Maybe.map R.SetEphemeral
|
||||||
|
|> R.Optional
|
||||||
|
|
||||||
|
-- TODO: Add state
|
||||||
|
-- TODO: Add RoomSummary
|
||||||
|
, room.timeline
|
||||||
|
|> Maybe.map (updateTimeline data)
|
||||||
|
|> R.Optional
|
||||||
|
|
||||||
|
-- TODO: Add unread notifications
|
||||||
|
-- TODO: Add unread thread notifications
|
||||||
|
]
|
||||||
|
, []
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
updateTimeline : { filter : Filter, nextBatch : String, roomId : String, since : Maybe String } -> Timeline -> R.RoomUpdate
|
||||||
|
updateTimeline =
|
||||||
|
PV.updateTimeline
|
||||||
|
|
||||||
|
|
||||||
|
toEvent : String -> ClientEventWithoutRoomID -> Event.Event
|
||||||
|
toEvent =
|
||||||
|
PV.toEvent
|
||||||
|
|
||||||
|
|
||||||
|
toUnsigned : Maybe Event.Event -> Maybe UnsignedData -> Maybe Event.UnsignedData
|
||||||
|
toUnsigned =
|
||||||
|
PV.toUnsigned
|
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,318 @@
|
||||||
|
module Internal.Api.Task exposing
|
||||||
|
( Task, run, Backpack
|
||||||
|
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Task module
|
||||||
|
|
||||||
|
This module is used to define how API calls are made. These completed API tasks
|
||||||
|
can be directly converted to Cmd types that the end user of the SDK can access.
|
||||||
|
|
||||||
|
These tasks do not affect the `Vault` directly, but instead, return a
|
||||||
|
`VaultUpdate` type that the user can apply to keep their `Vault` type
|
||||||
|
up-to-date.
|
||||||
|
|
||||||
|
|
||||||
|
## Use
|
||||||
|
|
||||||
|
@docs Task, run, Backpack
|
||||||
|
|
||||||
|
|
||||||
|
## Tasks
|
||||||
|
|
||||||
|
@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.BanUser.Api
|
||||||
|
import Internal.Api.BaseUrl.Api
|
||||||
|
import Internal.Api.Chain as C
|
||||||
|
import Internal.Api.InviteUser.Api
|
||||||
|
import Internal.Api.KickUser.Api
|
||||||
|
import Internal.Api.LoginWithUsernameAndPassword.Api
|
||||||
|
import Internal.Api.Now.Api
|
||||||
|
import Internal.Api.Request as Request
|
||||||
|
import Internal.Api.SendMessageEvent.Api
|
||||||
|
import Internal.Api.SendStateEvent.Api
|
||||||
|
import Internal.Api.SetAccountData.Api
|
||||||
|
import Internal.Api.SetRoomAccountData.Api
|
||||||
|
import Internal.Api.Sync.Api
|
||||||
|
import Internal.Api.Versions.Api
|
||||||
|
import Internal.Config.Log exposing (Log, log)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Internal.Values.Envelope as E exposing (EnvelopeUpdate(..))
|
||||||
|
import Internal.Values.Room exposing (RoomUpdate(..))
|
||||||
|
import Internal.Values.User exposing (User)
|
||||||
|
import Internal.Values.Vault exposing (VaultUpdate(..))
|
||||||
|
import Task
|
||||||
|
|
||||||
|
|
||||||
|
{-| A Backpack is the ultimate message type that gets sent back by the Elm
|
||||||
|
runtime, which can be accessed, viewed and inspected.
|
||||||
|
-}
|
||||||
|
type alias Backpack =
|
||||||
|
{ messages : List (EnvelopeUpdate VaultUpdate), logs : List Log }
|
||||||
|
|
||||||
|
|
||||||
|
{-| A Task is a task that is ready to be sent to the outside world.
|
||||||
|
-}
|
||||||
|
type alias Task =
|
||||||
|
C.TaskChain Never (EnvelopeUpdate VaultUpdate) {} {}
|
||||||
|
|
||||||
|
|
||||||
|
{-| An UnFinished Task that is used somewhere else in this module to write a
|
||||||
|
complete Task type.
|
||||||
|
-}
|
||||||
|
type alias UFTask a b =
|
||||||
|
C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b
|
||||||
|
|
||||||
|
|
||||||
|
{-| Ban a user from a room.
|
||||||
|
-}
|
||||||
|
banUser : { reason : Maybe String, roomId : String, user : User } -> Task
|
||||||
|
banUser input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.BanUser.Api.banUser input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an access token to talk to the Matrix API
|
||||||
|
-}
|
||||||
|
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
|
||||||
|
getAccessToken c =
|
||||||
|
case Context.fromApiFormat c of
|
||||||
|
context ->
|
||||||
|
case ( Context.mostPopularToken context, context.username, context.password ) of
|
||||||
|
( Just a, _, _ ) ->
|
||||||
|
C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.debug "Using cached access token from Vault" ]
|
||||||
|
, contextChange = Context.setAccessToken a
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
( Nothing, Just u, Just p ) ->
|
||||||
|
Internal.Api.LoginWithUsernameAndPassword.Api.loginWithUsernameAndPassword
|
||||||
|
{ deviceId = Context.fromApiFormat c |> .deviceId
|
||||||
|
, enableRefreshToken = Just True -- TODO: Turn this into a setting
|
||||||
|
, initialDeviceDisplayName = Nothing -- TODO: Turn this into a setting
|
||||||
|
, password = p
|
||||||
|
, username = u
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
( Nothing, Nothing, _ ) ->
|
||||||
|
C.fail Request.MissingUsername c
|
||||||
|
|
||||||
|
( Nothing, Just _, Nothing ) ->
|
||||||
|
C.fail Request.MissingPassword c
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the base URL where the Matrix API can be accessed
|
||||||
|
-}
|
||||||
|
getBaseUrl : UFTask a { a | baseUrl : () }
|
||||||
|
getBaseUrl c =
|
||||||
|
case Context.fromApiFormat c |> .baseUrl of
|
||||||
|
Just b ->
|
||||||
|
C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.debug "Using cached baseURL from Vault" ]
|
||||||
|
, contextChange = Context.setBaseUrl b
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Internal.Api.BaseUrl.Api.baseUrl
|
||||||
|
{ url = Context.fromApiFormat c |> .serverName }
|
||||||
|
|> C.catchWith
|
||||||
|
(\_ ->
|
||||||
|
let
|
||||||
|
url : String
|
||||||
|
url =
|
||||||
|
Context.fromApiFormat c
|
||||||
|
|> .serverName
|
||||||
|
in
|
||||||
|
{ contextChange = Context.setBaseUrl url
|
||||||
|
, logs = [ log.warn (Text.logs.baseUrlFailed url) ]
|
||||||
|
, messages = [ E.SetBaseUrl url ]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> (|>) c
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the current timestamp
|
||||||
|
-}
|
||||||
|
getNow : UFTask { a | baseUrl : () } { a | baseUrl : (), now : () }
|
||||||
|
getNow =
|
||||||
|
Internal.Api.Now.Api.getNow
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the versions that are potentially supported by the Matrix API
|
||||||
|
-}
|
||||||
|
getVersions : UFTask { a | baseUrl : () } { a | baseUrl : (), versions : () }
|
||||||
|
getVersions c =
|
||||||
|
case Context.fromApiFormat c |> .versions of
|
||||||
|
Just v ->
|
||||||
|
C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.debug "Using cached versions from Vault" ]
|
||||||
|
, contextChange = Context.setVersions v
|
||||||
|
}
|
||||||
|
c
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
Internal.Api.Versions.Api.versions c
|
||||||
|
|
||||||
|
|
||||||
|
finishTask : UFTask {} b -> Task
|
||||||
|
finishTask uftask =
|
||||||
|
uftask
|
||||||
|
|> C.andThen
|
||||||
|
(C.succeed
|
||||||
|
{ messages = []
|
||||||
|
, logs = []
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> C.catchWith
|
||||||
|
(\e ->
|
||||||
|
case e of
|
||||||
|
Request.MissingPassword ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error "Cannot log in - password is missing" ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.MissingUsername ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error "Cannot log in - username is missing" ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.NoSupportedVersion ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error "No supported version is available to complete the API interaction." ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.ServerReturnsBadJSON t ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error ("The server returned invalid JSON: " ++ t) ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
Request.ServerReturnsError name _ ->
|
||||||
|
{ messages = []
|
||||||
|
, logs = [ log.error ("The server returns an error: " ++ name) ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
{ messages = [] -- TODO: Maybe categorize errors?
|
||||||
|
, logs = [ log.warn "Encountered unhandled error" ]
|
||||||
|
, contextChange = Context.reset
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Invite a user to a room.
|
||||||
|
-}
|
||||||
|
inviteUser : { reason : Maybe String, roomId : String, user : User } -> Task
|
||||||
|
inviteUser input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.InviteUser.Api.inviteUser input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Kick a user from a room.
|
||||||
|
-}
|
||||||
|
kickUser :
|
||||||
|
{ avatarUrl : Maybe String
|
||||||
|
, displayname : Maybe String
|
||||||
|
, reason : Maybe String
|
||||||
|
, roomId : String
|
||||||
|
, user : User
|
||||||
|
}
|
||||||
|
-> Task
|
||||||
|
kickUser input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.KickUser.Api.kickUser input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Establish a Task Chain context where the base URL and supported list of
|
||||||
|
versions are known.
|
||||||
|
-}
|
||||||
|
makeVB : UFTask a { a | baseUrl : (), versions : () }
|
||||||
|
makeVB =
|
||||||
|
C.andThen getVersions getBaseUrl
|
||||||
|
|
||||||
|
|
||||||
|
{-| Establish a Task Chain context where the base URL and supported list of
|
||||||
|
versions are known, and where an access token is available to make an
|
||||||
|
authenticated API call.
|
||||||
|
-}
|
||||||
|
makeVBA : UFTask a { a | accessToken : (), baseUrl : (), now : (), versions : () }
|
||||||
|
makeVBA =
|
||||||
|
makeVB
|
||||||
|
|> C.andThen getNow
|
||||||
|
|> C.andThen getAccessToken
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a message event to a room.
|
||||||
|
-}
|
||||||
|
sendMessageEvent : { content : Json.Value, eventType : String, roomId : String, transactionId : String } -> Task
|
||||||
|
sendMessageEvent input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SendMessageEvent.Api.sendMessageEvent input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Send a state event to a room.
|
||||||
|
-}
|
||||||
|
sendStateEvent : { content : Json.Value, eventType : String, roomId : String, stateKey : String } -> Task
|
||||||
|
sendStateEvent input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SendStateEvent.Api.sendStateEvent input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set global account data.
|
||||||
|
-}
|
||||||
|
setAccountData : { content : Json.Value, eventType : String, userId : String } -> Task
|
||||||
|
setAccountData input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SetAccountData.Api.setAccountData input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Set account data for a Matrix room.
|
||||||
|
-}
|
||||||
|
setRoomAccountData : { content : Json.Value, eventType : String, roomId : String, userId : String } -> Task
|
||||||
|
setRoomAccountData input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.SetRoomAccountData.Api.setRoomAccountData input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Sync with the Matrix API to stay up-to-date.
|
||||||
|
-}
|
||||||
|
sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task
|
||||||
|
sync input =
|
||||||
|
makeVBA
|
||||||
|
|> C.andThen (Internal.Api.Sync.Api.sync input)
|
||||||
|
|> finishTask
|
||||||
|
|
||||||
|
|
||||||
|
{-| Transform a completed task into a Cmd.
|
||||||
|
-}
|
||||||
|
run : (Backpack -> msg) -> Task -> APIContext {} -> Cmd msg
|
||||||
|
run toMsg task context =
|
||||||
|
context
|
||||||
|
|> C.toTask task
|
||||||
|
|> Task.perform toMsg
|
|
@ -0,0 +1,90 @@
|
||||||
|
module Internal.Api.Versions.Api exposing (versions, Phantom)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Versions
|
||||||
|
|
||||||
|
Ask the Matrix API which versions it supports.
|
||||||
|
|
||||||
|
@docs versions, Phantom
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Dict
|
||||||
|
import Internal.Api.Api as A
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (Versions)
|
||||||
|
import Internal.Values.Envelope as E
|
||||||
|
import Set
|
||||||
|
|
||||||
|
|
||||||
|
{-| Task chain to ask which spec versions the Matrix API supports.
|
||||||
|
-}
|
||||||
|
versions : A.TaskChain (Phantom ph) (Phantom { ph | versions : () })
|
||||||
|
versions =
|
||||||
|
A.request
|
||||||
|
{ attributes = []
|
||||||
|
, coder = versionsCoder
|
||||||
|
, contextChange = Context.setVersions
|
||||||
|
, method = "GET"
|
||||||
|
, path = [ "_matrix", "client", "versions" ]
|
||||||
|
, toUpdate = \v -> ( E.SetVersions v, [] )
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Context needed for asking the server's available spec versions
|
||||||
|
-}
|
||||||
|
type alias Phantom a =
|
||||||
|
{ a | baseUrl : () }
|
||||||
|
|
||||||
|
|
||||||
|
versionsCoder : Json.Coder Versions
|
||||||
|
versionsCoder =
|
||||||
|
Json.object2
|
||||||
|
{ name = "Versions"
|
||||||
|
, description =
|
||||||
|
[ "Gets the versions of the specification supported by the server."
|
||||||
|
, "Values will take the form vX.Y or rX.Y.Z in historical cases. See the Specification Versioning for more information."
|
||||||
|
, "The server may additionally advertise experimental features it supports through unstable_features. These features should be namespaced and may optionally include version information within their name if desired. Features listed here are not for optionally toggling parts of the Matrix specification and should only be used to advertise support for a feature which has not yet landed in the spec. For example, a feature currently undergoing the proposal process may appear here and eventually be taken off this list once the feature lands in the spec and the server deems it reasonable to do so. Servers can choose to enable some features only for some users, so clients should include authentication in the request to get all the features available for the logged-in user. If no authentication is provided, the server should only return the features available to all users. Servers may wish to keep advertising features here after they’ve been released into the spec to give clients a chance to upgrade appropriately. Additionally, clients should avoid using unstable features in their stable releases."
|
||||||
|
]
|
||||||
|
, init = Versions
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "versions"
|
||||||
|
, toField = .versions
|
||||||
|
, description =
|
||||||
|
[ "The supported versions."
|
||||||
|
]
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "unstable_features"
|
||||||
|
, toField = .unstableFeatures
|
||||||
|
, description =
|
||||||
|
[ "Experimental features the server supports. Features not listed here, or the lack of this property all together, indicate that a feature is not supported."
|
||||||
|
]
|
||||||
|
, coder =
|
||||||
|
Json.bool
|
||||||
|
|> Json.slowDict
|
||||||
|
|> Json.map
|
||||||
|
{ name = "Dict to set"
|
||||||
|
, description =
|
||||||
|
[ "Turn a dictionary of supported values into a set that contains only supported values"
|
||||||
|
]
|
||||||
|
, back = Set.foldl (\k d -> Dict.insert k True d) Dict.empty
|
||||||
|
, forth =
|
||||||
|
Dict.foldl
|
||||||
|
(\k v s ->
|
||||||
|
if v then
|
||||||
|
Set.insert k s
|
||||||
|
|
||||||
|
else
|
||||||
|
s
|
||||||
|
)
|
||||||
|
Set.empty
|
||||||
|
}
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
|
@ -1,6 +1,7 @@
|
||||||
module Internal.Config.Default exposing
|
module Internal.Config.Default exposing
|
||||||
( currentVersion, deviceName
|
( currentVersion, deviceName
|
||||||
, syncTime
|
, syncTime
|
||||||
|
, removePasswordOnLogin
|
||||||
)
|
)
|
||||||
|
|
||||||
{-| This module hosts all default settings and configurations that the Vault
|
{-| This module hosts all default settings and configurations that the Vault
|
||||||
|
@ -16,6 +17,11 @@ will assume until overriden by the user.
|
||||||
|
|
||||||
@docs syncTime
|
@docs syncTime
|
||||||
|
|
||||||
|
|
||||||
|
## Security
|
||||||
|
|
||||||
|
@docs removePasswordOnLogin
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
|
||||||
|
@ -23,7 +29,7 @@ will assume until overriden by the user.
|
||||||
-}
|
-}
|
||||||
currentVersion : String
|
currentVersion : String
|
||||||
currentVersion =
|
currentVersion =
|
||||||
"beta 3.1.0"
|
"beta 3.5.0"
|
||||||
|
|
||||||
|
|
||||||
{-| The default device name that is being communicated with the Matrix API.
|
{-| The default device name that is being communicated with the Matrix API.
|
||||||
|
@ -52,3 +58,13 @@ The value is in miliseconds, so it is set at 30,000.
|
||||||
syncTime : Int
|
syncTime : Int
|
||||||
syncTime =
|
syncTime =
|
||||||
30 * 1000
|
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
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
module Internal.Config.Leaks exposing
|
module Internal.Config.Leaks exposing
|
||||||
( accessToken, baseUrl, transaction, versions
|
( accessToken, baseUrl, field, transaction, versions
|
||||||
, allLeaks
|
, allLeaks
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -30,7 +30,7 @@ know 100% sure that the value isn't `Nothing`.
|
||||||
|
|
||||||
Just 5 |> Maybe.withDefault Leaks.number
|
Just 5 |> Maybe.withDefault Leaks.number
|
||||||
|
|
||||||
@docs accessToken, baseUrl, transaction, versions
|
@docs accessToken, baseUrl, field, transaction, versions
|
||||||
|
|
||||||
For safety purposes, all leaking values are stored in the following value:
|
For safety purposes, all leaking values are stored in the following value:
|
||||||
|
|
||||||
|
@ -52,14 +52,15 @@ accessToken =
|
||||||
-}
|
-}
|
||||||
allLeaks : Set String
|
allLeaks : Set String
|
||||||
allLeaks =
|
allLeaks =
|
||||||
Set.union
|
Set.fromList
|
||||||
(Set.fromList versions)
|
[ accessToken
|
||||||
(Set.fromList
|
, baseUrl
|
||||||
[ accessToken
|
, field
|
||||||
, baseUrl
|
, transaction
|
||||||
, transaction
|
, "elm-sdk-placeholder-versions-leaks" -- Old leaking value
|
||||||
]
|
]
|
||||||
)
|
|> Set.union (Set.fromList versions.versions)
|
||||||
|
|> Set.union versions.unstableFeatures
|
||||||
|
|
||||||
|
|
||||||
{-| Placeholder base URL.
|
{-| Placeholder base URL.
|
||||||
|
@ -69,6 +70,13 @@ baseUrl =
|
||||||
"elm-sdk-placeholder-baseurl-leaks.example.org"
|
"elm-sdk-placeholder-baseurl-leaks.example.org"
|
||||||
|
|
||||||
|
|
||||||
|
{-| Placeholder JSON field.
|
||||||
|
-}
|
||||||
|
field : String
|
||||||
|
field =
|
||||||
|
"elm-sdk-placeholder-json-field"
|
||||||
|
|
||||||
|
|
||||||
{-| Placeholder transaction id.
|
{-| Placeholder transaction id.
|
||||||
-}
|
-}
|
||||||
transaction : String
|
transaction : String
|
||||||
|
@ -78,6 +86,8 @@ transaction =
|
||||||
|
|
||||||
{-| Placeholder versions list.
|
{-| Placeholder versions list.
|
||||||
-}
|
-}
|
||||||
versions : List String
|
versions : { versions : List String, unstableFeatures : Set String }
|
||||||
versions =
|
versions =
|
||||||
[ "elm-sdk-placeholder-versions-leaks" ]
|
{ versions = [ "elm-sdk-placeholder-versions-versions-leaks" ]
|
||||||
|
, unstableFeatures = Set.singleton "elm-sdk-placeholder-versions-unstableFeatures-leaks"
|
||||||
|
}
|
||||||
|
|
|
@ -112,23 +112,32 @@ decodedDictSize from to =
|
||||||
{-| Documentation used for all functions and data types in JSON coders
|
{-| Documentation used for all functions and data types in JSON coders
|
||||||
-}
|
-}
|
||||||
docs :
|
docs :
|
||||||
{ context : TypeDocs
|
{ accessToken : TypeDocs
|
||||||
|
, context : TypeDocs
|
||||||
, envelope : TypeDocs
|
, envelope : TypeDocs
|
||||||
, event : TypeDocs
|
, event : TypeDocs
|
||||||
, hashdict : TypeDocs
|
, hashdict : TypeDocs
|
||||||
, ibatch : TypeDocs
|
, ibatch : TypeDocs
|
||||||
, iddict : TypeDocs
|
|
||||||
, itoken : TypeDocs
|
, itoken : TypeDocs
|
||||||
, mashdict : TypeDocs
|
, mashdict : TypeDocs
|
||||||
, room : TypeDocs
|
, room : TypeDocs
|
||||||
, settings : TypeDocs
|
, settings : TypeDocs
|
||||||
, stateManager : TypeDocs
|
, stateManager : TypeDocs
|
||||||
|
, strippedEvent : TypeDocs
|
||||||
, timeline : TypeDocs
|
, timeline : TypeDocs
|
||||||
, timelineFilter : TypeDocs
|
, timelineFilter : TypeDocs
|
||||||
, unsigned : TypeDocs
|
, unsigned : TypeDocs
|
||||||
|
, vault : TypeDocs
|
||||||
|
, versions : TypeDocs
|
||||||
}
|
}
|
||||||
docs =
|
docs =
|
||||||
{ context =
|
{ accessToken =
|
||||||
|
{ name = "Access Token"
|
||||||
|
, description =
|
||||||
|
[ "The Access Token type stores information about an access token - its value, when it expires, and how one may get a new access token when the current value expires."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, context =
|
||||||
{ name = "Context"
|
{ name = "Context"
|
||||||
, description =
|
, description =
|
||||||
[ "The Context is the set of variables that the user (mostly) cannot control."
|
[ "The Context is the set of variables that the user (mostly) cannot control."
|
||||||
|
@ -160,12 +169,6 @@ docs =
|
||||||
[ "The internal batch tracks a patch of events on the Matrix timeline."
|
[ "The internal batch tracks a patch of events on the Matrix timeline."
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
, iddict =
|
|
||||||
{ name = "Iddict"
|
|
||||||
, description =
|
|
||||||
[ "An iddict automatically handles creating appropriate keys by incrementally assiging a new key to new values."
|
|
||||||
]
|
|
||||||
}
|
|
||||||
, itoken =
|
, itoken =
|
||||||
{ name = "IToken"
|
{ name = "IToken"
|
||||||
, description =
|
, description =
|
||||||
|
@ -197,6 +200,12 @@ docs =
|
||||||
, "Instead of making the user loop through the room's timeline of events, the StateManager offers the user a dictionary-like experience to navigate through the Matrix room state."
|
, "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 =
|
, timeline =
|
||||||
{ name = "Timeline"
|
{ name = "Timeline"
|
||||||
, description =
|
, description =
|
||||||
|
@ -216,6 +225,18 @@ docs =
|
||||||
, "This information is often supportive but not necessary to the context."
|
, "This information is often supportive but not necessary to the context."
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
, vault =
|
||||||
|
{ name = "Vault"
|
||||||
|
, description =
|
||||||
|
[ "Main type storing all relevant information from the Matrix API."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, versions =
|
||||||
|
{ name = "Versions"
|
||||||
|
, description =
|
||||||
|
[ "Versions type describing the supported spec versions and MSC properties."
|
||||||
|
]
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -237,13 +258,27 @@ failures =
|
||||||
what they do and what they are for.
|
what they do and what they are for.
|
||||||
-}
|
-}
|
||||||
fields :
|
fields :
|
||||||
{ context :
|
{ accessToken :
|
||||||
|
{ created : Desc
|
||||||
|
, expiryMs : Desc
|
||||||
|
, lastUsed : Desc
|
||||||
|
, refresh : Desc
|
||||||
|
, value : Desc
|
||||||
|
}
|
||||||
|
, context :
|
||||||
{ accessToken : Desc
|
{ accessToken : Desc
|
||||||
, baseUrl : Desc
|
, baseUrl : Desc
|
||||||
|
, deviceId : Desc
|
||||||
|
, experimental : Desc
|
||||||
|
, nextBatch : Desc
|
||||||
|
, now : Desc
|
||||||
, password : Desc
|
, password : Desc
|
||||||
, refreshToken : Desc
|
, refreshToken : Desc
|
||||||
, username : Desc
|
, username : Desc
|
||||||
|
, serverName : Desc
|
||||||
|
, suggestedAccessToken : Desc
|
||||||
, transaction : Desc
|
, transaction : Desc
|
||||||
|
, user : Desc
|
||||||
, versions : Desc
|
, versions : Desc
|
||||||
}
|
}
|
||||||
, envelope :
|
, envelope :
|
||||||
|
@ -280,6 +315,7 @@ fields :
|
||||||
}
|
}
|
||||||
, room :
|
, room :
|
||||||
{ accountData : Desc
|
{ accountData : Desc
|
||||||
|
, ephemeral : Desc
|
||||||
, events : Desc
|
, events : Desc
|
||||||
, roomId : Desc
|
, roomId : Desc
|
||||||
, state : Desc
|
, state : Desc
|
||||||
|
@ -288,6 +324,8 @@ fields :
|
||||||
, settings :
|
, settings :
|
||||||
{ currentVersion : Desc
|
{ currentVersion : Desc
|
||||||
, deviceName : Desc
|
, deviceName : Desc
|
||||||
|
, presence : Desc
|
||||||
|
, removePasswordOnLogin : Desc
|
||||||
, syncTime : Desc
|
, syncTime : Desc
|
||||||
}
|
}
|
||||||
, timeline :
|
, timeline :
|
||||||
|
@ -305,31 +343,76 @@ fields :
|
||||||
}
|
}
|
||||||
, unsigned :
|
, unsigned :
|
||||||
{ age : Desc
|
{ age : Desc
|
||||||
|
, membership : Desc
|
||||||
, prevContent : Desc
|
, prevContent : Desc
|
||||||
, redactedBecause : Desc
|
, redactedBecause : Desc
|
||||||
, transactionId : Desc
|
, transactionId : Desc
|
||||||
}
|
}
|
||||||
|
, vault :
|
||||||
|
{ accountData : Desc
|
||||||
|
, nextBatch : Desc
|
||||||
|
, rooms : Desc
|
||||||
|
, user : Desc
|
||||||
|
}
|
||||||
|
, versions :
|
||||||
|
{ unstableFeatures : Desc
|
||||||
|
, versions : Desc
|
||||||
|
}
|
||||||
}
|
}
|
||||||
fields =
|
fields =
|
||||||
{ context =
|
{ accessToken =
|
||||||
|
{ created =
|
||||||
|
[ "Timestamp of when the access token was received." ]
|
||||||
|
, expiryMs =
|
||||||
|
[ "Given time in milliseconds of when the access token might expire." ]
|
||||||
|
, lastUsed =
|
||||||
|
[ "Timestamp of when the access token was last used." ]
|
||||||
|
, refresh =
|
||||||
|
[ "Refresh token used to gain a new access token." ]
|
||||||
|
, value =
|
||||||
|
[ "Secret access token value." ]
|
||||||
|
}
|
||||||
|
, context =
|
||||||
{ accessToken =
|
{ accessToken =
|
||||||
[ "The access token used for authentication with the Matrix server."
|
[ "The access token used for authentication with the Matrix server."
|
||||||
]
|
]
|
||||||
, baseUrl =
|
, baseUrl =
|
||||||
[ "The base URL of the Matrix server."
|
[ "The base URL of the Matrix server."
|
||||||
]
|
]
|
||||||
|
, deviceId =
|
||||||
|
[ "The reported device ID according to the API."
|
||||||
|
]
|
||||||
|
, experimental =
|
||||||
|
[ "Experimental features supported by the homeserver."
|
||||||
|
]
|
||||||
|
, nextBatch =
|
||||||
|
[ "The batch token to supply in the since param of the next /sync request."
|
||||||
|
]
|
||||||
|
, now =
|
||||||
|
[ "The most recently found timestamp."
|
||||||
|
]
|
||||||
, password =
|
, password =
|
||||||
[ "The user's password for authentication purposes."
|
[ "The user's password for authentication purposes."
|
||||||
]
|
]
|
||||||
, refreshToken =
|
, refreshToken =
|
||||||
[ "The token used to obtain a new access token upon expiration of the current access token."
|
[ "The token used to obtain a new access token upon expiration of the current access token."
|
||||||
]
|
]
|
||||||
|
, suggestedAccessToken =
|
||||||
|
[ "An access token provided with no context by the user."
|
||||||
|
]
|
||||||
, username =
|
, username =
|
||||||
[ "The username of the Matrix account."
|
[ "The username of the Matrix account."
|
||||||
]
|
]
|
||||||
|
, serverName =
|
||||||
|
[ "The homeserver that the user is trying to communicate with."
|
||||||
|
, "This name doesn't need to be the address. For example, the name might be `matrix.org` even though the homeserver is at a different location."
|
||||||
|
]
|
||||||
, transaction =
|
, transaction =
|
||||||
[ "A unique identifier for a transaction initiated by the user."
|
[ "A unique identifier for a transaction initiated by the user."
|
||||||
]
|
]
|
||||||
|
, user =
|
||||||
|
[ "The Matrix user the Vault is representing."
|
||||||
|
]
|
||||||
, versions =
|
, versions =
|
||||||
[ "The versions of the Matrix protocol that are supported by the server."
|
[ "The versions of the Matrix protocol that are supported by the server."
|
||||||
]
|
]
|
||||||
|
@ -415,6 +498,9 @@ fields =
|
||||||
, room =
|
, room =
|
||||||
{ accountData =
|
{ accountData =
|
||||||
[ "Room account data tracking the user's private storage about this room." ]
|
[ "Room account data tracking the user's private storage about this room." ]
|
||||||
|
, ephemeral =
|
||||||
|
[ "Ephemeral events that were sent recently in this room."
|
||||||
|
]
|
||||||
, events =
|
, events =
|
||||||
[ "Database containing events that were sent in this room." ]
|
[ "Database containing events that were sent in this room." ]
|
||||||
, roomId =
|
, roomId =
|
||||||
|
@ -431,6 +517,12 @@ fields =
|
||||||
, deviceName =
|
, deviceName =
|
||||||
[ "Indicates the device name that is communicated to the Matrix API."
|
[ "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 =
|
, syncTime =
|
||||||
[ "Indicates the frequency in miliseconds with which the Elm SDK should long-poll the /sync endpoint."
|
[ "Indicates the frequency in miliseconds with which the Elm SDK should long-poll the /sync endpoint."
|
||||||
]
|
]
|
||||||
|
@ -473,6 +565,9 @@ fields =
|
||||||
{ age =
|
{ 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."
|
[ "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 =
|
, 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."
|
[ "The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content."
|
||||||
]
|
]
|
||||||
|
@ -483,6 +578,27 @@ fields =
|
||||||
[ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it."
|
[ "The client-supplied transaction ID, for example, provided via PUT /_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}, if the client being given the event is the same one which sent it."
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
, vault =
|
||||||
|
{ accountData =
|
||||||
|
[ "The account's global private data."
|
||||||
|
]
|
||||||
|
, nextBatch =
|
||||||
|
[ "The next batch that can be used to sync with the Matrix API."
|
||||||
|
]
|
||||||
|
, rooms =
|
||||||
|
[ "Directory of joined rooms that the user is a member of."
|
||||||
|
]
|
||||||
|
, user =
|
||||||
|
[ "User that the Vault is logging in as."
|
||||||
|
]
|
||||||
|
}
|
||||||
|
, versions =
|
||||||
|
{ unstableFeatures =
|
||||||
|
[ "Unstable features such as experimental MSCs that are supported by a homeserver."
|
||||||
|
]
|
||||||
|
, versions =
|
||||||
|
[ "Spec versions supported by a homeserver." ]
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -516,15 +632,60 @@ leakingValueFound leaking_value =
|
||||||
happened. Most of these unexpected results, are taken account of by the Elm SDK,
|
happened. Most of these unexpected results, are taken account of by the Elm SDK,
|
||||||
but logged so that the programmer can do something about it.
|
but logged so that the programmer can do something about it.
|
||||||
-}
|
-}
|
||||||
logs : { keyIsNotAnInt : String -> String }
|
logs :
|
||||||
|
{ 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 =
|
logs =
|
||||||
{ keyIsNotAnInt =
|
{ baseUrlFailed =
|
||||||
|
(++) "Failed to find .well-known, using default server address: "
|
||||||
|
, baseUrlFound =
|
||||||
|
\url baseUrl ->
|
||||||
|
String.concat [ "Found baseURL of ", url, " at address ", baseUrl ]
|
||||||
|
, getEventId = (++) "Received event with id = "
|
||||||
|
, getNow =
|
||||||
|
\now ->
|
||||||
|
String.concat
|
||||||
|
[ "Identified current time at Unix time "
|
||||||
|
, String.fromInt now
|
||||||
|
]
|
||||||
|
, httpRequest =
|
||||||
|
\method url -> String.concat [ "Matrix HTTP: ", method, " ", url ]
|
||||||
|
, invitedUser =
|
||||||
|
\userId roomId ->
|
||||||
|
String.concat [ "Invited user ", userId, " to room ", roomId ]
|
||||||
|
, keyIsNotAnInt =
|
||||||
\key ->
|
\key ->
|
||||||
String.concat
|
String.concat
|
||||||
[ "Encountered a key `"
|
[ "Encountered a key `"
|
||||||
, key
|
, key
|
||||||
, "` that cannot be converted to an Int"
|
, "` that cannot be converted to an Int"
|
||||||
]
|
]
|
||||||
|
, loggedInAs =
|
||||||
|
\username ->
|
||||||
|
String.concat [ "Successfully logged in as user ", username ]
|
||||||
|
, sendEvent =
|
||||||
|
\eventId ->
|
||||||
|
case eventId of
|
||||||
|
Just e ->
|
||||||
|
"Sent event, received event id " ++ e
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
"Sent event, event id not known - make sure to check transaction id"
|
||||||
|
, serverReturnedInvalidJSON = (++) "The server returned invalid JSON: "
|
||||||
|
, serverReturnedUnknownJSON = (++) "The server returned JSON that doesn't seem to live up to spec rules: "
|
||||||
|
, syncAccountDataFound =
|
||||||
|
\n -> String.concat [ "Found ", String.fromInt n, " account data updates" ]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -50,8 +50,6 @@ for interacting with the Matrix API.
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
import Internal.Grammar.UserId as U
|
import Internal.Grammar.UserId as U
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Json.Decode as D
|
|
||||||
import Json.Encode as E
|
|
||||||
import Set exposing (Set)
|
import Set exposing (Set)
|
||||||
|
|
||||||
|
|
||||||
|
@ -185,7 +183,6 @@ coder =
|
||||||
, description = Text.fields.timelineFilter.senders
|
, description = Text.fields.timelineFilter.senders
|
||||||
, coder = Json.set Json.string
|
, coder = Json.set Json.string
|
||||||
, default = ( Set.empty, [] )
|
, default = ( Set.empty, [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.required
|
(Json.field.required
|
||||||
|
@ -201,7 +198,6 @@ coder =
|
||||||
, description = Text.fields.timelineFilter.types
|
, description = Text.fields.timelineFilter.types
|
||||||
, coder = Json.set Json.string
|
, coder = Json.set Json.string
|
||||||
, default = ( Set.empty, [] )
|
, default = ( Set.empty, [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.required
|
(Json.field.required
|
||||||
|
|
|
@ -189,21 +189,20 @@ ipv6RightParser n =
|
||||||
|. P.symbol ":"
|
|. 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
|
-- {-| Convert an IPv6 address to a readable string format
|
||||||
back
|
-- -}
|
||||||
|
-- ipv6ToString : IPv6Address -> String
|
||||||
else
|
-- ipv6ToString { front, back } =
|
||||||
List.concat [ front, [ "" ], back ]
|
-- (if List.length front == 8 then
|
||||||
)
|
-- front
|
||||||
|> List.intersperse ":"
|
-- else if List.length back == 8 then
|
||||||
|> String.concat
|
-- back
|
||||||
|
-- else
|
||||||
|
-- List.concat [ front, [ "" ], back ]
|
||||||
|
-- )
|
||||||
|
-- |> List.intersperse ":"
|
||||||
|
-- |> String.concat
|
||||||
|
|
||||||
|
|
||||||
portParser : Parser Int
|
portParser : Parser Int
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Internal.Tools.DecodeExtra exposing
|
module Internal.Tools.DecodeExtra exposing
|
||||||
( opField, opFieldWithDefault
|
( opField, opFieldWithDefault
|
||||||
, map9, map10, map11
|
, map9, map10, map11, map12, map13
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -18,7 +18,7 @@ This module contains helper functions that help decode JSON.
|
||||||
|
|
||||||
## Extended map functions
|
## Extended map functions
|
||||||
|
|
||||||
@docs map9, map10, map11
|
@docs map9, map10, map11, map12, map13
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
@ -153,3 +153,68 @@ map11 func da db dc dd de df dg dh di dj dk =
|
||||||
(D.map2 Tuple.pair df dg)
|
(D.map2 Tuple.pair df dg)
|
||||||
(D.map2 Tuple.pair dh di)
|
(D.map2 Tuple.pair dh di)
|
||||||
(D.map2 Tuple.pair dj dk)
|
(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)
|
||||||
|
|
|
@ -3,7 +3,7 @@ module Internal.Tools.Hashdict exposing
|
||||||
, empty, singleton, insert, remove, removeKey
|
, empty, singleton, insert, remove, removeKey
|
||||||
, isEmpty, member, memberKey, get, size, isEqual
|
, isEmpty, member, memberKey, get, size, isEqual
|
||||||
, keys, values, toList, fromList
|
, keys, values, toList, fromList
|
||||||
, rehash, union, map
|
, rehash, union, map, update
|
||||||
, coder, encode, decoder, softDecoder
|
, coder, encode, decoder, softDecoder
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -35,7 +35,7 @@ This allows you to store values based on an externally defined identifier.
|
||||||
|
|
||||||
## Transform
|
## Transform
|
||||||
|
|
||||||
@docs rehash, union, map
|
@docs rehash, union, map, update
|
||||||
|
|
||||||
|
|
||||||
## JSON coders
|
## JSON coders
|
||||||
|
@ -321,6 +321,23 @@ union (Hashdict h1) hd2 =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Update a dict to maybe contain a value (or not). If the output does not
|
||||||
|
have the originally expected key, it is not updated.
|
||||||
|
-}
|
||||||
|
update : String -> (Maybe a -> Maybe a) -> Hashdict a -> Hashdict a
|
||||||
|
update key f ((Hashdict h) as hd) =
|
||||||
|
case f (get key hd) of
|
||||||
|
Just v ->
|
||||||
|
if h.hash v == key then
|
||||||
|
insert v hd
|
||||||
|
|
||||||
|
else
|
||||||
|
hd
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
removeKey key hd
|
||||||
|
|
||||||
|
|
||||||
{-| Get all values stored in the hashdict, in the order of their keys.
|
{-| Get all values stored in the hashdict, in the order of their keys.
|
||||||
-}
|
-}
|
||||||
values : Hashdict a -> List a
|
values : Hashdict a -> List a
|
||||||
|
|
|
@ -1,198 +0,0 @@
|
||||||
module Internal.Tools.Iddict exposing
|
|
||||||
( Iddict
|
|
||||||
, empty, singleton, insert, map, remove
|
|
||||||
, isEmpty, member, get, size
|
|
||||||
, keys, values
|
|
||||||
, coder, encode, decoder
|
|
||||||
)
|
|
||||||
|
|
||||||
{-| The id-dict is a data type that lets us store values in a dictionary using
|
|
||||||
unique identifiers. This can be used as a dictionary where the keys do not
|
|
||||||
matter.
|
|
||||||
|
|
||||||
The benefit of the iddict is that it generates the keys FOR you. This way, you
|
|
||||||
do not need to generate identifiers yourself.
|
|
||||||
|
|
||||||
|
|
||||||
## Id-dict
|
|
||||||
|
|
||||||
@docs Iddict
|
|
||||||
|
|
||||||
|
|
||||||
## Build
|
|
||||||
|
|
||||||
@docs empty, singleton, insert, map, remove
|
|
||||||
|
|
||||||
|
|
||||||
## Query
|
|
||||||
|
|
||||||
@docs isEmpty, member, get, size
|
|
||||||
|
|
||||||
|
|
||||||
## Lists
|
|
||||||
|
|
||||||
@docs keys, values
|
|
||||||
|
|
||||||
|
|
||||||
## JSON coders
|
|
||||||
|
|
||||||
@docs coder, encode, decoder
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
import FastDict as Dict exposing (Dict)
|
|
||||||
import Internal.Config.Text as Text
|
|
||||||
import Internal.Tools.Json as Json
|
|
||||||
|
|
||||||
|
|
||||||
{-| The Iddict data type.
|
|
||||||
-}
|
|
||||||
type Iddict a
|
|
||||||
= Iddict
|
|
||||||
{ cursor : Int
|
|
||||||
, dict : Dict Int a
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
{-| Define how an Iddict can be encoded and decoded to and from a JSON value.
|
|
||||||
-}
|
|
||||||
coder : Json.Coder a -> Json.Coder (Iddict a)
|
|
||||||
coder x =
|
|
||||||
Json.object2
|
|
||||||
{ name = Text.docs.iddict.name
|
|
||||||
, description = Text.docs.iddict.description
|
|
||||||
, init =
|
|
||||||
\c d ->
|
|
||||||
Iddict
|
|
||||||
{ cursor =
|
|
||||||
Dict.keys d
|
|
||||||
|> List.maximum
|
|
||||||
|> Maybe.map ((+) 1)
|
|
||||||
|> Maybe.withDefault 0
|
|
||||||
|> max (Dict.size d)
|
|
||||||
|> max c
|
|
||||||
, dict = d
|
|
||||||
}
|
|
||||||
}
|
|
||||||
(Json.field.optional.withDefault
|
|
||||||
{ fieldName = "cursor"
|
|
||||||
, toField = \(Iddict i) -> i.cursor
|
|
||||||
, description = Text.fields.iddict.cursor
|
|
||||||
, coder = Json.int
|
|
||||||
, default = ( 0, [] )
|
|
||||||
, defaultToString = String.fromInt
|
|
||||||
}
|
|
||||||
)
|
|
||||||
(Json.field.required
|
|
||||||
{ fieldName = "dict"
|
|
||||||
, toField = \(Iddict i) -> i.dict
|
|
||||||
, description = Text.fields.iddict.dict
|
|
||||||
, coder = Json.fastIntDict x
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
{-| Decode an id-dict from a JSON value.
|
|
||||||
-}
|
|
||||||
decoder : Json.Coder a -> Json.Decoder (Iddict a)
|
|
||||||
decoder x =
|
|
||||||
Json.decode (coder x)
|
|
||||||
|
|
||||||
|
|
||||||
{-| Create an empty id-dict.
|
|
||||||
-}
|
|
||||||
empty : Iddict a
|
|
||||||
empty =
|
|
||||||
Iddict
|
|
||||||
{ cursor = 0
|
|
||||||
, dict = Dict.empty
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
{-| Encode an id-dict to a JSON value.
|
|
||||||
-}
|
|
||||||
encode : Json.Coder a -> Json.Encoder (Iddict a)
|
|
||||||
encode x =
|
|
||||||
Json.encode (coder x)
|
|
||||||
|
|
||||||
|
|
||||||
{-| Get a value from the id-dict using its key.
|
|
||||||
-}
|
|
||||||
get : Int -> Iddict a -> Maybe a
|
|
||||||
get k (Iddict { dict }) =
|
|
||||||
Dict.get k dict
|
|
||||||
|
|
||||||
|
|
||||||
{-| Insert a new value into the id-dict. Given that the id-dict generates its
|
|
||||||
key, the function returns both the updated id-dict as the newly generated key.
|
|
||||||
|
|
||||||
x = empty |> insert "hello" -- ( 0, <Iddict with value "hello"> )
|
|
||||||
|
|
||||||
case x of
|
|
||||||
( _, iddict ) ->
|
|
||||||
get 0 iddict -- Just "hello"
|
|
||||||
|
|
||||||
-}
|
|
||||||
insert : a -> Iddict a -> ( Int, Iddict a )
|
|
||||||
insert v (Iddict d) =
|
|
||||||
( d.cursor
|
|
||||||
, Iddict { cursor = d.cursor + 1, dict = Dict.insert d.cursor v d.dict }
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
{-| Determine if an id-dict is empty.
|
|
||||||
-}
|
|
||||||
isEmpty : Iddict a -> Bool
|
|
||||||
isEmpty (Iddict d) =
|
|
||||||
Dict.isEmpty d.dict
|
|
||||||
|
|
||||||
|
|
||||||
{-| Get all of the keys from the id-dict, sorted from lowest to highest.
|
|
||||||
-}
|
|
||||||
keys : Iddict a -> List Int
|
|
||||||
keys (Iddict { dict }) =
|
|
||||||
Dict.keys dict
|
|
||||||
|
|
||||||
|
|
||||||
{-| Map an existing value at a given key, if it exists. If it does not exist,
|
|
||||||
the operation does nothing.
|
|
||||||
-}
|
|
||||||
map : Int -> (a -> a) -> Iddict a -> Iddict a
|
|
||||||
map k f (Iddict d) =
|
|
||||||
Iddict { d | dict = Dict.update k (Maybe.map f) d.dict }
|
|
||||||
|
|
||||||
|
|
||||||
{-| Determine if a key is in an id-dict.
|
|
||||||
-}
|
|
||||||
member : Int -> Iddict a -> Bool
|
|
||||||
member k (Iddict d) =
|
|
||||||
k < d.cursor && Dict.member k d.dict
|
|
||||||
|
|
||||||
|
|
||||||
{-| Remove a key-value pair from the id-dict. If the key is not found, no
|
|
||||||
changes are made.
|
|
||||||
-}
|
|
||||||
remove : Int -> Iddict a -> Iddict a
|
|
||||||
remove k (Iddict d) =
|
|
||||||
Iddict { d | dict = Dict.remove k d.dict }
|
|
||||||
|
|
||||||
|
|
||||||
{-| Create an id-dict with a single value.
|
|
||||||
-}
|
|
||||||
singleton : a -> ( Int, Iddict a )
|
|
||||||
singleton v =
|
|
||||||
insert v empty
|
|
||||||
|
|
||||||
|
|
||||||
{-| Determine the number of key-value pairs in the id-dict.
|
|
||||||
-}
|
|
||||||
size : Iddict a -> Int
|
|
||||||
size (Iddict d) =
|
|
||||||
Dict.size d.dict
|
|
||||||
|
|
||||||
|
|
||||||
{-| Get all of the values from an id-dict, in the order of their keys.
|
|
||||||
-}
|
|
||||||
values : Iddict a -> List a
|
|
||||||
values (Iddict { dict }) =
|
|
||||||
Dict.values dict
|
|
|
@ -1,11 +1,11 @@
|
||||||
module Internal.Tools.Json exposing
|
module Internal.Tools.Json exposing
|
||||||
( Coder, string, bool, int, float, value
|
( Coder, string, bool, int, float, value, unit
|
||||||
, Encoder, encode, Decoder, decode, Value
|
, Encoder, encode, Decoder, decode, Value
|
||||||
, succeed, fail, andThen, lazy, map
|
, succeed, fail, andThen, lazy, map
|
||||||
, Docs(..), RequiredField(..), toDocs
|
, Docs(..), RequiredField(..), toDocs
|
||||||
, list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe
|
, list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
|
||||||
, Field, field, parser
|
, Field, field, parser
|
||||||
, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
|
, object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -29,7 +29,7 @@ data types. Because this module uses dynamic builder types, this also means it
|
||||||
is relatively easy to write documentation for any data type that uses this
|
is relatively easy to write documentation for any data type that uses this
|
||||||
module to build its encoders and decoders.
|
module to build its encoders and decoders.
|
||||||
|
|
||||||
@docs Coder, string, bool, int, float, value
|
@docs Coder, string, bool, int, float, value, unit
|
||||||
|
|
||||||
|
|
||||||
## JSON Coding
|
## JSON Coding
|
||||||
|
@ -49,7 +49,7 @@ module to build its encoders and decoders.
|
||||||
|
|
||||||
## Data types
|
## Data types
|
||||||
|
|
||||||
@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe
|
@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
|
||||||
|
|
||||||
|
|
||||||
## Objects
|
## Objects
|
||||||
|
@ -62,12 +62,13 @@ first.
|
||||||
|
|
||||||
Once all fields are constructed, the user can create JSON objects.
|
Once all fields are constructed, the user can create JSON objects.
|
||||||
|
|
||||||
@docs object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
|
@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Dict as SlowDict
|
import Dict as SlowDict
|
||||||
import FastDict
|
import FastDict
|
||||||
|
import Iddict exposing (Iddict)
|
||||||
import Internal.Config.Log as Log exposing (Log)
|
import Internal.Config.Log as Log exposing (Log)
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
import Internal.Tools.DecodeExtra as D
|
import Internal.Tools.DecodeExtra as D
|
||||||
|
@ -141,6 +142,7 @@ type Docs
|
||||||
= DocsBool
|
= DocsBool
|
||||||
| DocsDict Docs
|
| DocsDict Docs
|
||||||
| DocsFloat
|
| DocsFloat
|
||||||
|
| DocsIddict Docs
|
||||||
| DocsInt
|
| DocsInt
|
||||||
| DocsIntDict Docs
|
| DocsIntDict Docs
|
||||||
| DocsLazy (() -> Docs)
|
| DocsLazy (() -> Docs)
|
||||||
|
@ -163,6 +165,7 @@ type Docs
|
||||||
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
|
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
|
||||||
| DocsSet Docs
|
| DocsSet Docs
|
||||||
| DocsString
|
| DocsString
|
||||||
|
| DocsUnit
|
||||||
| DocsValue
|
| DocsValue
|
||||||
|
|
||||||
|
|
||||||
|
@ -362,7 +365,7 @@ then the following field type would be used:
|
||||||
, coder = string
|
, coder = string
|
||||||
}
|
}
|
||||||
|
|
||||||
Suppose the JSO isn't obligated to provide a list of hobbies, and the list would
|
Suppose the JSON isn't obligated to provide a list of hobbies, and the list would
|
||||||
by default be overriden with an empty list, then we would use the following
|
by default be overriden with an empty list, then we would use the following
|
||||||
field type:
|
field type:
|
||||||
|
|
||||||
|
@ -373,8 +376,7 @@ field type:
|
||||||
[ "The hobbies of the person. Can be omitted."
|
[ "The hobbies of the person. Can be omitted."
|
||||||
]
|
]
|
||||||
, coder = list string
|
, coder = list string
|
||||||
, default = ( [], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default
|
, default = ( [ "football" ], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default
|
||||||
, defaultToString = always "[]" -- Default converted to a string
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
@ -382,7 +384,7 @@ field :
|
||||||
{ required : { fieldName : String, toField : object -> a, description : List String, coder : Coder a } -> Field a object
|
{ required : { fieldName : String, toField : object -> a, description : List String, coder : Coder a } -> Field a object
|
||||||
, optional :
|
, optional :
|
||||||
{ value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : Coder a } -> Field (Maybe a) object
|
{ value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : Coder a } -> Field (Maybe a) object
|
||||||
, withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object
|
, withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ) } -> Field a object
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
field =
|
field =
|
||||||
|
@ -425,7 +427,7 @@ field =
|
||||||
, requiredness = OptionalField
|
, requiredness = OptionalField
|
||||||
}
|
}
|
||||||
, withDefault =
|
, withDefault =
|
||||||
\{ fieldName, toField, description, coder, default, defaultToString } ->
|
\{ fieldName, toField, description, coder, default } ->
|
||||||
case coder of
|
case coder of
|
||||||
Coder { encoder, decoder, docs } ->
|
Coder { encoder, decoder, docs } ->
|
||||||
Field
|
Field
|
||||||
|
@ -449,7 +451,8 @@ field =
|
||||||
, requiredness =
|
, requiredness =
|
||||||
default
|
default
|
||||||
|> Tuple.first
|
|> Tuple.first
|
||||||
|> defaultToString
|
|> encoder
|
||||||
|
|> E.encode 0
|
||||||
|> OptionalFieldWithDefault
|
|> OptionalFieldWithDefault
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -467,6 +470,26 @@ float =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define an Iddict as defined in
|
||||||
|
[noordstar/elm-iddict](https://package.elm-lang.org/packages/noordstar/elm-iddict/latest/).
|
||||||
|
-}
|
||||||
|
iddict : Coder a -> Coder (Iddict a)
|
||||||
|
iddict (Coder old) =
|
||||||
|
Coder
|
||||||
|
{ encoder = Iddict.encode old.encoder
|
||||||
|
, decoder =
|
||||||
|
Iddict.decoder old.decoder
|
||||||
|
|> D.map
|
||||||
|
(\out ->
|
||||||
|
( Iddict.map (always Tuple.first) out
|
||||||
|
, Iddict.values out
|
||||||
|
|> List.concatMap Tuple.second
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, docs = DocsIddict old.docs
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Define an int value.
|
{-| Define an int value.
|
||||||
-}
|
-}
|
||||||
int : Coder Int
|
int : Coder Int
|
||||||
|
@ -596,6 +619,23 @@ objectEncoder items object =
|
||||||
|> E.maybeObject
|
|> E.maybeObject
|
||||||
|
|
||||||
|
|
||||||
|
object1 :
|
||||||
|
Descriptive { init : a -> object }
|
||||||
|
-> Field a object
|
||||||
|
-> Coder object
|
||||||
|
object1 { name, description, init } fa =
|
||||||
|
Coder
|
||||||
|
{ encoder = objectEncoder [ toEncodeField fa ]
|
||||||
|
, decoder = D.map (Tuple.mapFirst init) (toDecoderField fa)
|
||||||
|
, docs =
|
||||||
|
DocsObject
|
||||||
|
{ name = name
|
||||||
|
, description = description
|
||||||
|
, keys = [ toDocsField fa ]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Define an object with 2 keys
|
{-| Define an object with 2 keys
|
||||||
|
|
||||||
type alias Human =
|
type alias Human =
|
||||||
|
@ -1158,6 +1198,160 @@ object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define an object with 12 keys
|
||||||
|
-}
|
||||||
|
object12 :
|
||||||
|
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> object }
|
||||||
|
-> Field a object
|
||||||
|
-> Field b object
|
||||||
|
-> Field c object
|
||||||
|
-> Field d object
|
||||||
|
-> Field e object
|
||||||
|
-> Field f object
|
||||||
|
-> Field g object
|
||||||
|
-> Field h object
|
||||||
|
-> Field i object
|
||||||
|
-> Field j object
|
||||||
|
-> Field k object
|
||||||
|
-> Field l object
|
||||||
|
-> Coder object
|
||||||
|
object12 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl =
|
||||||
|
Coder
|
||||||
|
{ encoder =
|
||||||
|
objectEncoder
|
||||||
|
[ toEncodeField fa
|
||||||
|
, toEncodeField fb
|
||||||
|
, toEncodeField fc
|
||||||
|
, toEncodeField fd
|
||||||
|
, toEncodeField fe
|
||||||
|
, toEncodeField ff
|
||||||
|
, toEncodeField fg
|
||||||
|
, toEncodeField fh
|
||||||
|
, toEncodeField fi
|
||||||
|
, toEncodeField fj
|
||||||
|
, toEncodeField fk
|
||||||
|
, toEncodeField fl
|
||||||
|
]
|
||||||
|
, decoder =
|
||||||
|
D.map12
|
||||||
|
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ->
|
||||||
|
( init a b c d e f g h i j k l
|
||||||
|
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll ]
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(toDecoderField fa)
|
||||||
|
(toDecoderField fb)
|
||||||
|
(toDecoderField fc)
|
||||||
|
(toDecoderField fd)
|
||||||
|
(toDecoderField fe)
|
||||||
|
(toDecoderField ff)
|
||||||
|
(toDecoderField fg)
|
||||||
|
(toDecoderField fh)
|
||||||
|
(toDecoderField fi)
|
||||||
|
(toDecoderField fj)
|
||||||
|
(toDecoderField fk)
|
||||||
|
(toDecoderField fl)
|
||||||
|
, docs =
|
||||||
|
DocsObject
|
||||||
|
{ name = name
|
||||||
|
, description = description
|
||||||
|
, keys =
|
||||||
|
[ toDocsField fa
|
||||||
|
, toDocsField fb
|
||||||
|
, toDocsField fc
|
||||||
|
, toDocsField fd
|
||||||
|
, toDocsField fe
|
||||||
|
, toDocsField ff
|
||||||
|
, toDocsField fg
|
||||||
|
, toDocsField fh
|
||||||
|
, toDocsField fi
|
||||||
|
, toDocsField fj
|
||||||
|
, toDocsField fk
|
||||||
|
, toDocsField fl
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Define an object with 13 keys
|
||||||
|
-}
|
||||||
|
object13 :
|
||||||
|
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> object }
|
||||||
|
-> Field a object
|
||||||
|
-> Field b object
|
||||||
|
-> Field c object
|
||||||
|
-> Field d object
|
||||||
|
-> Field e object
|
||||||
|
-> Field f object
|
||||||
|
-> Field g object
|
||||||
|
-> Field h object
|
||||||
|
-> Field i object
|
||||||
|
-> Field j object
|
||||||
|
-> Field k object
|
||||||
|
-> Field l object
|
||||||
|
-> Field m object
|
||||||
|
-> Coder object
|
||||||
|
object13 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl fm =
|
||||||
|
Coder
|
||||||
|
{ encoder =
|
||||||
|
objectEncoder
|
||||||
|
[ toEncodeField fa
|
||||||
|
, toEncodeField fb
|
||||||
|
, toEncodeField fc
|
||||||
|
, toEncodeField fd
|
||||||
|
, toEncodeField fe
|
||||||
|
, toEncodeField ff
|
||||||
|
, toEncodeField fg
|
||||||
|
, toEncodeField fh
|
||||||
|
, toEncodeField fi
|
||||||
|
, toEncodeField fj
|
||||||
|
, toEncodeField fk
|
||||||
|
, toEncodeField fl
|
||||||
|
, toEncodeField fm
|
||||||
|
]
|
||||||
|
, decoder =
|
||||||
|
D.map13
|
||||||
|
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ( m, lm ) ->
|
||||||
|
( init a b c d e f g h i j k l m
|
||||||
|
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll, lm ]
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(toDecoderField fa)
|
||||||
|
(toDecoderField fb)
|
||||||
|
(toDecoderField fc)
|
||||||
|
(toDecoderField fd)
|
||||||
|
(toDecoderField fe)
|
||||||
|
(toDecoderField ff)
|
||||||
|
(toDecoderField fg)
|
||||||
|
(toDecoderField fh)
|
||||||
|
(toDecoderField fi)
|
||||||
|
(toDecoderField fj)
|
||||||
|
(toDecoderField fk)
|
||||||
|
(toDecoderField fl)
|
||||||
|
(toDecoderField fm)
|
||||||
|
, docs =
|
||||||
|
DocsObject
|
||||||
|
{ name = name
|
||||||
|
, description = description
|
||||||
|
, keys =
|
||||||
|
[ toDocsField fa
|
||||||
|
, toDocsField fb
|
||||||
|
, toDocsField fc
|
||||||
|
, toDocsField fd
|
||||||
|
, toDocsField fe
|
||||||
|
, toDocsField ff
|
||||||
|
, toDocsField fg
|
||||||
|
, toDocsField fh
|
||||||
|
, toDocsField fi
|
||||||
|
, toDocsField fj
|
||||||
|
, toDocsField fk
|
||||||
|
, toDocsField fl
|
||||||
|
, toDocsField fm
|
||||||
|
]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Define a parser that converts a string into a custom Elm type.
|
{-| Define a parser that converts a string into a custom Elm type.
|
||||||
-}
|
-}
|
||||||
parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a
|
parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a
|
||||||
|
@ -1269,6 +1463,18 @@ toEncodeField (Field data) =
|
||||||
( data.fieldName, data.toField >> data.encoder )
|
( data.fieldName, data.toField >> data.encoder )
|
||||||
|
|
||||||
|
|
||||||
|
{-| Completely ignore whatever needs to be encoded, and simply return a unit
|
||||||
|
value.
|
||||||
|
-}
|
||||||
|
unit : Coder ()
|
||||||
|
unit =
|
||||||
|
Coder
|
||||||
|
{ encoder = \() -> E.object []
|
||||||
|
, decoder = D.succeed ( (), [] )
|
||||||
|
, docs = DocsUnit
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
{-| Do not do anything useful with a JSON value, just bring it to Elm as a
|
{-| Do not do anything useful with a JSON value, just bring it to Elm as a
|
||||||
JavaScript value.
|
JavaScript value.
|
||||||
-}
|
-}
|
||||||
|
|
|
@ -1,8 +1,21 @@
|
||||||
module Internal.Tools.ParserExtra exposing (..)
|
module Internal.Tools.ParserExtra exposing (zeroOrMore, oneOrMore, exactly, atLeast, atMost, times, maxLength)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Extra parsers
|
||||||
|
|
||||||
|
To help the Elm SDK with parsing complex text values, this modules offers a few functions.
|
||||||
|
|
||||||
|
@docs zeroOrMore, oneOrMore, exactly, atLeast, atMost, times, maxLength
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
import Parser as P exposing ((|.), (|=), Parser)
|
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 a -> Parser (List a)
|
||||||
zeroOrMore parser =
|
zeroOrMore parser =
|
||||||
P.loop []
|
P.loop []
|
||||||
|
@ -15,6 +28,9 @@ zeroOrMore parser =
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parses an item at least once, but up to any number of times.
|
||||||
|
The result is combined into a list.
|
||||||
|
-}
|
||||||
oneOrMore : Parser a -> Parser (List a)
|
oneOrMore : Parser a -> Parser (List a)
|
||||||
oneOrMore parser =
|
oneOrMore parser =
|
||||||
P.succeed (::)
|
P.succeed (::)
|
||||||
|
@ -22,6 +38,9 @@ oneOrMore parser =
|
||||||
|= zeroOrMore 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 : Int -> Parser a -> Parser (List a)
|
||||||
atLeast n parser =
|
atLeast n parser =
|
||||||
P.loop []
|
P.loop []
|
||||||
|
@ -39,6 +58,10 @@ atLeast n parser =
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parses an item any number of times (can be zero), but does not exceed a
|
||||||
|
given number of times.
|
||||||
|
The result is combined into a list.
|
||||||
|
-}
|
||||||
atMost : Int -> Parser a -> Parser (List a)
|
atMost : Int -> Parser a -> Parser (List a)
|
||||||
atMost n parser =
|
atMost n parser =
|
||||||
P.loop []
|
P.loop []
|
||||||
|
@ -55,6 +78,10 @@ atMost n parser =
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Parses an item a given number of times, ranging from the given minimum up
|
||||||
|
to the given maximum.
|
||||||
|
The result is combined into a list.
|
||||||
|
-}
|
||||||
times : Int -> Int -> Parser a -> Parser (List a)
|
times : Int -> Int -> Parser a -> Parser (List a)
|
||||||
times inf sup parser =
|
times inf sup parser =
|
||||||
let
|
let
|
||||||
|
@ -84,11 +111,21 @@ times inf sup parser =
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Repeat pasing an item an exact number of times.
|
||||||
|
The result is combined into a list.
|
||||||
|
-}
|
||||||
exactly : Int -> Parser a -> Parser (List a)
|
exactly : Int -> Parser a -> Parser (List a)
|
||||||
exactly n =
|
exactly n =
|
||||||
times n 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 : Int -> Parser a -> Parser a
|
||||||
maxLength n parser =
|
maxLength n parser =
|
||||||
P.succeed
|
P.succeed
|
||||||
|
|
|
@ -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 }
|
|
@ -1,5 +1,6 @@
|
||||||
module Internal.Tools.Timestamp exposing
|
module Internal.Tools.Timestamp exposing
|
||||||
( Timestamp
|
( Timestamp
|
||||||
|
, add, toMs
|
||||||
, coder, encode, decoder
|
, coder, encode, decoder
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -12,6 +13,11 @@ elm/time. This module offers ways to work with the timestamp in meaningful ways.
|
||||||
@docs Timestamp
|
@docs Timestamp
|
||||||
|
|
||||||
|
|
||||||
|
## Calculate
|
||||||
|
|
||||||
|
@docs add, toMs
|
||||||
|
|
||||||
|
|
||||||
## JSON coders
|
## JSON coders
|
||||||
|
|
||||||
@docs coder, encode, decoder
|
@docs coder, encode, decoder
|
||||||
|
@ -28,6 +34,15 @@ type alias Timestamp =
|
||||||
Time.Posix
|
Time.Posix
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a given number of miliseconds to a given Timestamp.
|
||||||
|
-}
|
||||||
|
add : Int -> Timestamp -> Timestamp
|
||||||
|
add m =
|
||||||
|
Time.posixToMillis
|
||||||
|
>> (+) m
|
||||||
|
>> Time.millisToPosix
|
||||||
|
|
||||||
|
|
||||||
{-| Create a Json coder
|
{-| Create a Json coder
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Timestamp
|
coder : Json.Coder Timestamp
|
||||||
|
@ -55,3 +70,10 @@ encode =
|
||||||
decoder : Json.Decoder Timestamp
|
decoder : Json.Decoder Timestamp
|
||||||
decoder =
|
decoder =
|
||||||
Json.decode coder
|
Json.decode coder
|
||||||
|
|
||||||
|
|
||||||
|
{-| Turn a Timestamp into a number of miliseconds
|
||||||
|
-}
|
||||||
|
toMs : Timestamp -> Int
|
||||||
|
toMs =
|
||||||
|
Time.posixToMillis
|
||||||
|
|
|
@ -1,10 +1,13 @@
|
||||||
module Internal.Values.Context exposing
|
module Internal.Values.Context exposing
|
||||||
( Context, init, coder, encode, decoder
|
( Context, AccessToken, init, coder, encode, decoder
|
||||||
, APIContext, apiFormat
|
, mostPopularToken
|
||||||
|
, APIContext, apiFormat, fromApiFormat
|
||||||
, setAccessToken, getAccessToken
|
, setAccessToken, getAccessToken
|
||||||
, setBaseUrl, getBaseUrl
|
, setBaseUrl, getBaseUrl
|
||||||
|
, setNow, getNow
|
||||||
, setTransaction, getTransaction
|
, setTransaction, getTransaction
|
||||||
, setVersions, getVersions
|
, Versions, setVersions, getVersions
|
||||||
|
, reset
|
||||||
)
|
)
|
||||||
|
|
||||||
{-| The Context is the set of variables that the user (mostly) cannot control.
|
{-| The Context is the set of variables that the user (mostly) cannot control.
|
||||||
|
@ -14,7 +17,11 @@ the Matrix API.
|
||||||
|
|
||||||
## Context
|
## Context
|
||||||
|
|
||||||
@docs Context, init, coder, encode, decoder
|
@docs Context, AccessToken, init, coder, encode, decoder
|
||||||
|
|
||||||
|
Some functions are present to influence the general Context type itself.
|
||||||
|
|
||||||
|
@docs mostPopularToken
|
||||||
|
|
||||||
|
|
||||||
## APIContext
|
## APIContext
|
||||||
|
@ -22,7 +29,7 @@ the Matrix API.
|
||||||
Once the API starts needing information, that's when we use the APIContext type
|
Once the API starts needing information, that's when we use the APIContext type
|
||||||
to build the right environment for the API communication to work with.
|
to build the right environment for the API communication to work with.
|
||||||
|
|
||||||
@docs APIContext, apiFormat
|
@docs APIContext, apiFormat, fromApiFormat
|
||||||
|
|
||||||
Once the APIContext is ready, there's helper functions for each piece of
|
Once the APIContext is ready, there's helper functions for each piece of
|
||||||
information that can be inserted.
|
information that can be inserted.
|
||||||
|
@ -38,6 +45,11 @@ information that can be inserted.
|
||||||
@docs setBaseUrl, getBaseUrl
|
@docs setBaseUrl, getBaseUrl
|
||||||
|
|
||||||
|
|
||||||
|
### Timestamp
|
||||||
|
|
||||||
|
@docs setNow, getNow
|
||||||
|
|
||||||
|
|
||||||
### Transaction id
|
### Transaction id
|
||||||
|
|
||||||
@docs setTransaction, getTransaction
|
@docs setTransaction, getTransaction
|
||||||
|
@ -45,26 +57,54 @@ information that can be inserted.
|
||||||
|
|
||||||
### Versions
|
### Versions
|
||||||
|
|
||||||
@docs setVersions, getVersions
|
@docs Versions, setVersions, getVersions
|
||||||
|
|
||||||
|
|
||||||
|
### Reset
|
||||||
|
|
||||||
|
@docs reset
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Internal.Config.Leaks as L
|
import Internal.Config.Leaks as L
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||||
|
import 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
|
{-| The Context type stores all the information in the Vault. This data type is
|
||||||
static and hence can be passed on easily.
|
static and hence can be passed on easily.
|
||||||
-}
|
-}
|
||||||
type alias Context =
|
type alias Context =
|
||||||
{ accessToken : Maybe String
|
{ accessTokens : Hashdict AccessToken
|
||||||
, baseUrl : Maybe String
|
, baseUrl : Maybe String
|
||||||
|
, deviceId : Maybe String
|
||||||
|
, nextBatch : Maybe String
|
||||||
|
, now : Maybe Timestamp
|
||||||
, password : Maybe String
|
, password : Maybe String
|
||||||
, refreshToken : Maybe String
|
, refreshToken : Maybe String
|
||||||
, username : Maybe String
|
, serverName : String
|
||||||
|
, suggestedAccessToken : Maybe String
|
||||||
, transaction : Maybe String
|
, transaction : Maybe String
|
||||||
, versions : Maybe (List String)
|
, user : Maybe User
|
||||||
|
, username : Maybe String
|
||||||
|
, versions : Maybe Versions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -77,38 +117,53 @@ type APIContext ph
|
||||||
{ accessToken : String
|
{ accessToken : String
|
||||||
, baseUrl : String
|
, baseUrl : String
|
||||||
, context : Context
|
, context : Context
|
||||||
|
, now : Timestamp
|
||||||
, transaction : String
|
, transaction : String
|
||||||
, versions : List String
|
, versions : Versions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
type alias Versions =
|
||||||
|
{ versions : List String, unstableFeatures : Set String }
|
||||||
|
|
||||||
|
|
||||||
{-| Create an unformatted APIContext type.
|
{-| Create an unformatted APIContext type.
|
||||||
-}
|
-}
|
||||||
apiFormat : Context -> APIContext {}
|
apiFormat : Context -> APIContext {}
|
||||||
apiFormat context =
|
apiFormat context =
|
||||||
APIContext
|
APIContext
|
||||||
{ accessToken = context.accessToken |> Maybe.withDefault L.accessToken
|
{ accessToken =
|
||||||
|
mostPopularToken context |> Maybe.withDefault L.accessToken
|
||||||
, baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
|
, baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
|
||||||
, context = context
|
, context = context
|
||||||
|
, now = context.now |> Maybe.withDefault (Time.millisToPosix 0)
|
||||||
, transaction = context.transaction |> Maybe.withDefault L.transaction
|
, transaction = context.transaction |> Maybe.withDefault L.transaction
|
||||||
, versions = context.versions |> Maybe.withDefault L.versions
|
, versions = context.versions |> Maybe.withDefault L.versions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the original context that contains all values from before any were
|
||||||
|
gotten from the Matrix API.
|
||||||
|
-}
|
||||||
|
fromApiFormat : APIContext a -> Context
|
||||||
|
fromApiFormat (APIContext c) =
|
||||||
|
c.context
|
||||||
|
|
||||||
|
|
||||||
{-| Define how a Context can be encoded to and decoded from a JSON object.
|
{-| Define how a Context can be encoded to and decoded from a JSON object.
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Context
|
coder : Json.Coder Context
|
||||||
coder =
|
coder =
|
||||||
Json.object7
|
Json.object13
|
||||||
{ name = Text.docs.context.name
|
{ name = Text.docs.context.name
|
||||||
, description = Text.docs.context.description
|
, description = Text.docs.context.description
|
||||||
, init = Context
|
, init = Context
|
||||||
}
|
}
|
||||||
(Json.field.optional.value
|
(Json.field.required
|
||||||
{ fieldName = "accessToken"
|
{ fieldName = "accessTokens"
|
||||||
, toField = .accessToken
|
, toField = .accessTokens
|
||||||
, description = Text.fields.context.accessToken
|
, description = Text.fields.context.accessToken
|
||||||
, coder = Json.string
|
, coder = Hashdict.coder .value coderAccessToken
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
|
@ -118,6 +173,27 @@ coder =
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "deviceId"
|
||||||
|
, toField = .deviceId
|
||||||
|
, description = Text.fields.context.deviceId
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "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
|
(Json.field.optional.value
|
||||||
{ fieldName = "password"
|
{ fieldName = "password"
|
||||||
, toField = .password
|
, toField = .password
|
||||||
|
@ -132,10 +208,17 @@ coder =
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "serverName"
|
||||||
|
, toField = .serverName
|
||||||
|
, description = Text.fields.context.serverName
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
{ fieldName = "username"
|
{ fieldName = "suggestedAccessToken"
|
||||||
, toField = .username
|
, toField = always Nothing -- Do not save
|
||||||
, description = Text.fields.context.username
|
, description = Text.fields.context.suggestedAccessToken
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
@ -146,11 +229,71 @@ coder =
|
||||||
, coder = Json.string
|
, 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
|
(Json.field.optional.value
|
||||||
{ fieldName = "versions"
|
{ fieldName = "versions"
|
||||||
, toField = .versions
|
, toField = .versions
|
||||||
, description = Text.fields.context.versions
|
, description = Text.fields.context.versions
|
||||||
, coder = Json.list Json.string
|
, coder = versionsCoder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| JSON coder for an Access Token.
|
||||||
|
-}
|
||||||
|
coderAccessToken : Json.Coder AccessToken
|
||||||
|
coderAccessToken =
|
||||||
|
Json.object5
|
||||||
|
{ name = Text.docs.accessToken.name
|
||||||
|
, description = Text.docs.accessToken.description
|
||||||
|
, init = AccessToken
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "created"
|
||||||
|
, toField = .created
|
||||||
|
, description = Text.fields.accessToken.created
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "expiryMs"
|
||||||
|
, toField = .expiryMs
|
||||||
|
, description = Text.fields.accessToken.expiryMs
|
||||||
|
, coder = Json.int
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "lastUsed"
|
||||||
|
, toField = .lastUsed
|
||||||
|
, description = Text.fields.accessToken.lastUsed
|
||||||
|
, coder = Timestamp.coder
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "refresh"
|
||||||
|
, toField = .refresh
|
||||||
|
, description = Text.fields.accessToken.refresh
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "value"
|
||||||
|
, toField = .value
|
||||||
|
, description = Text.fields.accessToken.value
|
||||||
|
, coder = Json.string
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -171,18 +314,59 @@ encode =
|
||||||
|
|
||||||
{-| A basic, untouched version of the Context, containing no information.
|
{-| A basic, untouched version of the Context, containing no information.
|
||||||
-}
|
-}
|
||||||
init : Context
|
init : String -> Maybe User -> Context
|
||||||
init =
|
init sn mu =
|
||||||
{ accessToken = Nothing
|
{ accessTokens = Hashdict.empty .value
|
||||||
, baseUrl = Nothing
|
, baseUrl = Nothing
|
||||||
|
, deviceId = Nothing
|
||||||
|
, nextBatch = Nothing
|
||||||
|
, now = Nothing
|
||||||
, refreshToken = Nothing
|
, refreshToken = Nothing
|
||||||
, password = Nothing
|
, password = Nothing
|
||||||
, username = Nothing
|
, serverName = sn
|
||||||
|
, suggestedAccessToken = Nothing
|
||||||
, transaction = Nothing
|
, transaction = Nothing
|
||||||
|
, user = mu
|
||||||
|
, username = Nothing
|
||||||
, versions = Nothing
|
, versions = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get the most popular access token available, if any.
|
||||||
|
-}
|
||||||
|
mostPopularToken : Context -> Maybe String
|
||||||
|
mostPopularToken c =
|
||||||
|
case c.suggestedAccessToken of
|
||||||
|
Just _ ->
|
||||||
|
c.suggestedAccessToken
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
c.accessTokens
|
||||||
|
|> Hashdict.values
|
||||||
|
|> List.sortBy
|
||||||
|
(\token ->
|
||||||
|
case token.expiryMs of
|
||||||
|
Nothing ->
|
||||||
|
( 0, Timestamp.toMs token.created )
|
||||||
|
|
||||||
|
Just e ->
|
||||||
|
( 1
|
||||||
|
, token.created
|
||||||
|
|> Timestamp.add e
|
||||||
|
|> Timestamp.toMs
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|> List.head
|
||||||
|
|> Maybe.map .value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Reset the phantom type of the Context, effectively forgetting all values.
|
||||||
|
-}
|
||||||
|
reset : APIContext a -> APIContext {}
|
||||||
|
reset (APIContext c) =
|
||||||
|
APIContext c
|
||||||
|
|
||||||
|
|
||||||
{-| Get an inserted access token.
|
{-| Get an inserted access token.
|
||||||
-}
|
-}
|
||||||
getAccessToken : APIContext { a | accessToken : () } -> String
|
getAccessToken : APIContext { a | accessToken : () } -> String
|
||||||
|
@ -211,6 +395,20 @@ setBaseUrl value (APIContext c) =
|
||||||
APIContext { c | baseUrl = value }
|
APIContext { c | baseUrl = value }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Get an inserted timestamp.
|
||||||
|
-}
|
||||||
|
getNow : APIContext { a | now : () } -> Timestamp
|
||||||
|
getNow (APIContext c) =
|
||||||
|
c.now
|
||||||
|
|
||||||
|
|
||||||
|
{-| Insert a Timestamp into the APIContext.
|
||||||
|
-}
|
||||||
|
setNow : Timestamp -> APIContext a -> APIContext { a | now : () }
|
||||||
|
setNow t (APIContext c) =
|
||||||
|
APIContext { c | now = t }
|
||||||
|
|
||||||
|
|
||||||
{-| Get an inserted transaction id.
|
{-| Get an inserted transaction id.
|
||||||
-}
|
-}
|
||||||
getTransaction : APIContext { a | transaction : () } -> String
|
getTransaction : APIContext { a | transaction : () } -> String
|
||||||
|
@ -227,13 +425,37 @@ setTransaction value (APIContext c) =
|
||||||
|
|
||||||
{-| Get an inserted versions list.
|
{-| Get an inserted versions list.
|
||||||
-}
|
-}
|
||||||
getVersions : APIContext { a | versions : () } -> List String
|
getVersions : APIContext { a | versions : () } -> Versions
|
||||||
getVersions (APIContext c) =
|
getVersions (APIContext c) =
|
||||||
c.versions
|
c.versions
|
||||||
|
|
||||||
|
|
||||||
{-| Insert a versions list into the APIContext.
|
{-| Insert a versions list into the APIContext.
|
||||||
-}
|
-}
|
||||||
setVersions : List String -> APIContext a -> APIContext { a | versions : () }
|
setVersions : Versions -> APIContext a -> APIContext { a | versions : () }
|
||||||
setVersions value (APIContext c) =
|
setVersions value (APIContext c) =
|
||||||
APIContext { c | versions = value }
|
APIContext { c | versions = value }
|
||||||
|
|
||||||
|
|
||||||
|
versionsCoder : Json.Coder Versions
|
||||||
|
versionsCoder =
|
||||||
|
Json.object2
|
||||||
|
{ name = Text.docs.versions.name
|
||||||
|
, description = Text.docs.versions.description
|
||||||
|
, init = Versions
|
||||||
|
}
|
||||||
|
(Json.field.required
|
||||||
|
{ fieldName = "versions"
|
||||||
|
, toField = .versions
|
||||||
|
, description = Text.fields.versions.versions
|
||||||
|
, coder = Json.list Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "unstableFeatures"
|
||||||
|
, toField = .unstableFeatures
|
||||||
|
, description = Text.fields.versions.unstableFeatures
|
||||||
|
, coder = Json.set Json.string
|
||||||
|
, default = ( Set.empty, [] )
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
|
@ -4,6 +4,7 @@ module Internal.Values.Envelope exposing
|
||||||
, Settings, mapSettings, extractSettings
|
, Settings, mapSettings, extractSettings
|
||||||
, mapContext
|
, mapContext
|
||||||
, getContent, extract
|
, getContent, extract
|
||||||
|
, EnvelopeUpdate(..), update
|
||||||
, coder, encode, decoder
|
, coder, encode, decoder
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -36,16 +37,28 @@ settings that can be adjusted manually.
|
||||||
@docs getContent, extract
|
@docs getContent, extract
|
||||||
|
|
||||||
|
|
||||||
|
## Update
|
||||||
|
|
||||||
|
@docs EnvelopeUpdate, update
|
||||||
|
|
||||||
|
|
||||||
## JSON coders
|
## JSON coders
|
||||||
|
|
||||||
@docs coder, encode, decoder
|
@docs coder, encode, decoder
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Request as Request
|
||||||
|
import Internal.Config.Log exposing (Log)
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Hashdict as Hashdict
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Context as Context exposing (Context)
|
import Internal.Tools.Timestamp exposing (Timestamp)
|
||||||
|
import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
|
||||||
import Internal.Values.Settings as Settings
|
import Internal.Values.Settings as Settings
|
||||||
|
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
|
{-| There are lots of different data types in the Elm SDK, and many of them
|
||||||
|
@ -60,6 +73,25 @@ type alias Envelope a =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The Envelope update type helps update either the envelope or a content type.
|
||||||
|
-}
|
||||||
|
type EnvelopeUpdate a
|
||||||
|
= ContentUpdate a
|
||||||
|
| HttpRequest (Request.Request ( Request.Error, List Log ) ( EnvelopeUpdate a, List Log ))
|
||||||
|
| More (List (EnvelopeUpdate a))
|
||||||
|
| Optional (Maybe (EnvelopeUpdate a))
|
||||||
|
| RemoveAccessToken String
|
||||||
|
| RemovePasswordIfNecessary
|
||||||
|
| SetAccessToken AccessToken
|
||||||
|
| SetBaseUrl String
|
||||||
|
| SetDeviceId String
|
||||||
|
| SetNextBatch String
|
||||||
|
| SetNow Timestamp
|
||||||
|
| SetRefreshToken String
|
||||||
|
| SetUser User
|
||||||
|
| SetVersions Versions
|
||||||
|
|
||||||
|
|
||||||
{-| Settings value from
|
{-| Settings value from
|
||||||
[Internal.Values.Settings](Internal-Values-Settings#Settings). Can be used to
|
[Internal.Values.Settings](Internal-Values-Settings#Settings). Can be used to
|
||||||
manipulate the Matrix Vault.
|
manipulate the Matrix Vault.
|
||||||
|
@ -97,7 +129,6 @@ coder c1 =
|
||||||
, description = Text.fields.envelope.settings
|
, description = Text.fields.envelope.settings
|
||||||
, coder = Settings.coder
|
, coder = Settings.coder
|
||||||
, default = Tuple.pair Settings.init []
|
, default = Tuple.pair Settings.init []
|
||||||
, defaultToString = always "<Default settings>"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -159,10 +190,10 @@ getContent =
|
||||||
{-| Create a new enveloped data type. All settings are set to default values
|
{-| Create a new enveloped data type. All settings are set to default values
|
||||||
from the [Internal.Config.Default](Internal-Config-Default) module.
|
from the [Internal.Config.Default](Internal-Config-Default) module.
|
||||||
-}
|
-}
|
||||||
init : a -> Envelope a
|
init : { content : a, serverName : String, user : Maybe User } -> Envelope a
|
||||||
init x =
|
init data =
|
||||||
{ content = x
|
{ content = data.content
|
||||||
, context = Context.init
|
, context = Context.init data.serverName data.user
|
||||||
, settings = Settings.init
|
, settings = Settings.init
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -260,3 +291,102 @@ toMaybe data =
|
||||||
Maybe.map
|
Maybe.map
|
||||||
(\content -> map (always content) data)
|
(\content -> map (always content) data)
|
||||||
data.content
|
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
|
||||||
|
|
|
@ -59,6 +59,7 @@ helper functions.
|
||||||
type UnsignedData
|
type UnsignedData
|
||||||
= UnsignedData
|
= UnsignedData
|
||||||
{ age : Maybe Int
|
{ age : Maybe Int
|
||||||
|
, membership : Maybe String
|
||||||
, prevContent : Maybe Json.Value
|
, prevContent : Maybe Json.Value
|
||||||
, redactedBecause : Maybe Event
|
, redactedBecause : Maybe Event
|
||||||
, transactionId : Maybe String
|
, transactionId : Maybe String
|
||||||
|
@ -242,10 +243,10 @@ transactionId event =
|
||||||
|
|
||||||
unsignedCoder : Json.Coder UnsignedData
|
unsignedCoder : Json.Coder UnsignedData
|
||||||
unsignedCoder =
|
unsignedCoder =
|
||||||
Json.object4
|
Json.object5
|
||||||
{ name = Text.docs.unsigned.name
|
{ name = Text.docs.unsigned.name
|
||||||
, description = Text.docs.unsigned.description
|
, description = Text.docs.unsigned.description
|
||||||
, init = \a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }
|
, init = \a b c d e -> UnsignedData { age = a, membership = b, prevContent = c, redactedBecause = d, transactionId = e }
|
||||||
}
|
}
|
||||||
(Json.field.optional.value
|
(Json.field.optional.value
|
||||||
{ fieldName = "age"
|
{ fieldName = "age"
|
||||||
|
@ -254,6 +255,13 @@ unsignedCoder =
|
||||||
, coder = Json.int
|
, 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
|
(Json.field.optional.value
|
||||||
{ fieldName = "prevContent"
|
{ fieldName = "prevContent"
|
||||||
, toField = \(UnsignedData data) -> data.prevContent
|
, toField = \(UnsignedData data) -> data.prevContent
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
module Internal.Values.Room exposing
|
module Internal.Values.Room exposing
|
||||||
( Room, init
|
( Room, init
|
||||||
|
, RoomUpdate(..), update
|
||||||
, Batch, addBatch, addSync, addEvents, mostRecentEvents
|
, Batch, addBatch, addSync, addEvents, mostRecentEvents
|
||||||
, getAccountData, setAccountData
|
, getAccountData, setAccountData
|
||||||
, coder, encode, decode
|
, coder, encode, decode
|
||||||
|
@ -25,6 +26,11 @@ room state reflect the homeserver state of the room.
|
||||||
@docs Room, init
|
@docs Room, init
|
||||||
|
|
||||||
|
|
||||||
|
## Update
|
||||||
|
|
||||||
|
@docs RoomUpdate, update
|
||||||
|
|
||||||
|
|
||||||
## Timeline
|
## Timeline
|
||||||
|
|
||||||
@docs Batch, addBatch, addSync, addEvents, mostRecentEvents
|
@docs Batch, addBatch, addSync, addEvents, mostRecentEvents
|
||||||
|
@ -47,10 +53,13 @@ import Internal.Config.Text as Text
|
||||||
import Internal.Filter.Timeline as Filter exposing (Filter)
|
import Internal.Filter.Timeline as Filter exposing (Filter)
|
||||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Tools.StrippedEvent as StrippedEvent exposing (StrippedEvent)
|
||||||
import Internal.Values.Event as Event exposing (Event)
|
import Internal.Values.Event as Event exposing (Event)
|
||||||
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
||||||
import Internal.Values.Timeline as Timeline exposing (Timeline)
|
import Internal.Values.Timeline as Timeline exposing (Timeline)
|
||||||
import Json.Encode as E
|
import Internal.Values.User exposing (User)
|
||||||
|
import Recursion
|
||||||
|
import Recursion.Fold
|
||||||
|
|
||||||
|
|
||||||
{-| The Batch is a group of new events from somewhere in the timeline.
|
{-| The Batch is a group of new events from somewhere in the timeline.
|
||||||
|
@ -64,6 +73,7 @@ homeserver.
|
||||||
-}
|
-}
|
||||||
type alias Room =
|
type alias Room =
|
||||||
{ accountData : Dict String Json.Value
|
{ accountData : Dict String Json.Value
|
||||||
|
, ephemeral : List StrippedEvent
|
||||||
, events : Hashdict Event
|
, events : Hashdict Event
|
||||||
, roomId : String
|
, roomId : String
|
||||||
, state : StateManager
|
, state : StateManager
|
||||||
|
@ -71,6 +81,19 @@ type alias Room =
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| The RoomUpdate type explains how to update a room based on new information
|
||||||
|
from the Matrix API.
|
||||||
|
-}
|
||||||
|
type RoomUpdate
|
||||||
|
= AddEvent Event
|
||||||
|
| AddSync Batch
|
||||||
|
| Invite User
|
||||||
|
| More (List RoomUpdate)
|
||||||
|
| Optional (Maybe RoomUpdate)
|
||||||
|
| SetAccountData String Json.Value
|
||||||
|
| SetEphemeral (List { eventType : String, content : Json.Value })
|
||||||
|
|
||||||
|
|
||||||
{-| Add new events to the Room's event directory + Room's timeline.
|
{-| Add new events to the Room's event directory + Room's timeline.
|
||||||
-}
|
-}
|
||||||
addEventsToTimeline : (Timeline.Batch -> Timeline -> Timeline) -> Batch -> Room -> Room
|
addEventsToTimeline : (Timeline.Batch -> Timeline -> Timeline) -> Batch -> Room -> Room
|
||||||
|
@ -122,7 +145,7 @@ addSync =
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Room
|
coder : Json.Coder Room
|
||||||
coder =
|
coder =
|
||||||
Json.object5
|
Json.object6
|
||||||
{ name = Text.docs.room.name
|
{ name = Text.docs.room.name
|
||||||
, description = Text.docs.room.description
|
, description = Text.docs.room.description
|
||||||
, init = Room
|
, init = Room
|
||||||
|
@ -133,7 +156,14 @@ coder =
|
||||||
, description = Text.fields.room.accountData
|
, description = Text.fields.room.accountData
|
||||||
, coder = Json.fastDict Json.value
|
, coder = Json.fastDict Json.value
|
||||||
, default = ( Dict.empty, [] )
|
, default = ( Dict.empty, [] )
|
||||||
, defaultToString = Json.encode (Json.fastDict Json.value) >> E.encode 0
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "ephemeral"
|
||||||
|
, toField = .ephemeral
|
||||||
|
, description = Text.fields.room.ephemeral
|
||||||
|
, coder = Json.list StrippedEvent.coder
|
||||||
|
, default = ( [], [] )
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -142,7 +172,6 @@ coder =
|
||||||
, description = Text.fields.room.events
|
, description = Text.fields.room.events
|
||||||
, coder = Hashdict.coder .eventId Event.coder
|
, coder = Hashdict.coder .eventId Event.coder
|
||||||
, default = ( Hashdict.empty .eventId, [ log.warn "Found a room with no known events! Is it empty?" ] )
|
, default = ( Hashdict.empty .eventId, [ log.warn "Found a room with no known events! Is it empty?" ] )
|
||||||
, defaultToString = Json.encode (Hashdict.coder .eventId Event.coder) >> E.encode 0
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.required
|
(Json.field.required
|
||||||
|
@ -158,7 +187,6 @@ coder =
|
||||||
, description = Text.fields.room.state
|
, description = Text.fields.room.state
|
||||||
, coder = StateManager.coder
|
, coder = StateManager.coder
|
||||||
, default = ( StateManager.empty, [] )
|
, default = ( StateManager.empty, [] )
|
||||||
, defaultToString = Json.encode StateManager.coder >> E.encode 0
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -167,7 +195,6 @@ coder =
|
||||||
, description = Text.fields.room.timeline
|
, description = Text.fields.room.timeline
|
||||||
, coder = Timeline.coder
|
, coder = Timeline.coder
|
||||||
, default = ( Timeline.empty, [] )
|
, default = ( Timeline.empty, [] )
|
||||||
, defaultToString = Json.encode Timeline.coder >> E.encode 0
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -198,6 +225,7 @@ getAccountData key room =
|
||||||
init : String -> Room
|
init : String -> Room
|
||||||
init roomId =
|
init roomId =
|
||||||
{ accountData = Dict.empty
|
{ accountData = Dict.empty
|
||||||
|
, ephemeral = []
|
||||||
, events = Hashdict.empty .eventId
|
, events = Hashdict.empty .eventId
|
||||||
, roomId = roomId
|
, roomId = roomId
|
||||||
, state = StateManager.empty
|
, state = StateManager.empty
|
||||||
|
@ -223,3 +251,40 @@ mostRecentEvents room =
|
||||||
setAccountData : String -> Json.Value -> Room -> Room
|
setAccountData : String -> Json.Value -> Room -> Room
|
||||||
setAccountData key value room =
|
setAccountData key value room =
|
||||||
{ room | accountData = Dict.insert key value room.accountData }
|
{ 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
|
||||||
|
|
|
@ -35,6 +35,8 @@ behave under the user's preferred settings.
|
||||||
type alias Settings =
|
type alias Settings =
|
||||||
{ currentVersion : String
|
{ currentVersion : String
|
||||||
, deviceName : String
|
, deviceName : String
|
||||||
|
, presence : Maybe String
|
||||||
|
, removePasswordOnLogin : Bool
|
||||||
, syncTime : Int
|
, syncTime : Int
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -43,7 +45,7 @@ type alias Settings =
|
||||||
-}
|
-}
|
||||||
coder : Json.Coder Settings
|
coder : Json.Coder Settings
|
||||||
coder =
|
coder =
|
||||||
Json.object3
|
Json.object5
|
||||||
{ name = Text.docs.settings.name
|
{ name = Text.docs.settings.name
|
||||||
, description = Text.docs.settings.description
|
, description = Text.docs.settings.description
|
||||||
, init = Settings
|
, init = Settings
|
||||||
|
@ -54,7 +56,6 @@ coder =
|
||||||
, description = Text.fields.settings.currentVersion
|
, description = Text.fields.settings.currentVersion
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
, default = Tuple.pair Default.currentVersion []
|
, default = Tuple.pair Default.currentVersion []
|
||||||
, defaultToString = identity
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -63,7 +64,21 @@ coder =
|
||||||
, description = Text.fields.settings.deviceName
|
, description = Text.fields.settings.deviceName
|
||||||
, coder = Json.string
|
, coder = Json.string
|
||||||
, default = Tuple.pair Default.deviceName []
|
, default = Tuple.pair Default.deviceName []
|
||||||
, defaultToString = identity
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.value
|
||||||
|
{ fieldName = "presence"
|
||||||
|
, toField = .presence
|
||||||
|
, description = Text.fields.settings.presence
|
||||||
|
, coder = Json.string
|
||||||
|
}
|
||||||
|
)
|
||||||
|
(Json.field.optional.withDefault
|
||||||
|
{ fieldName = "removePasswordOnLogin"
|
||||||
|
, toField = .removePasswordOnLogin
|
||||||
|
, description = Text.fields.settings.removePasswordOnLogin
|
||||||
|
, coder = Json.bool
|
||||||
|
, default = Tuple.pair Default.removePasswordOnLogin []
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -72,7 +87,6 @@ coder =
|
||||||
, description = Text.fields.settings.syncTime
|
, description = Text.fields.settings.syncTime
|
||||||
, coder = Json.int
|
, coder = Json.int
|
||||||
, default = Tuple.pair Default.syncTime []
|
, default = Tuple.pair Default.syncTime []
|
||||||
, defaultToString = String.fromInt
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -97,5 +111,7 @@ init : Settings
|
||||||
init =
|
init =
|
||||||
{ currentVersion = Default.currentVersion
|
{ currentVersion = Default.currentVersion
|
||||||
, deviceName = Default.deviceName
|
, deviceName = Default.deviceName
|
||||||
|
, presence = Nothing
|
||||||
|
, removePasswordOnLogin = Default.removePasswordOnLogin
|
||||||
, syncTime = Default.syncTime
|
, syncTime = Default.syncTime
|
||||||
}
|
}
|
||||||
|
|
|
@ -67,10 +67,10 @@ events!
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import FastDict as Dict exposing (Dict)
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Iddict exposing (Iddict)
|
||||||
import Internal.Config.Text as Text
|
import Internal.Config.Text as Text
|
||||||
import Internal.Filter.Timeline as Filter exposing (Filter)
|
import Internal.Filter.Timeline as Filter exposing (Filter)
|
||||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
import Internal.Tools.Iddict as Iddict exposing (Iddict)
|
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Recursion
|
import Recursion
|
||||||
import Recursion.Traverse
|
import Recursion.Traverse
|
||||||
|
@ -210,7 +210,7 @@ coder =
|
||||||
{ fieldName = "batches"
|
{ fieldName = "batches"
|
||||||
, toField = \(Timeline t) -> t.batches
|
, toField = \(Timeline t) -> t.batches
|
||||||
, description = Text.fields.timeline.batches
|
, description = Text.fields.timeline.batches
|
||||||
, coder = Iddict.coder coderIBatch
|
, coder = Json.iddict coderIBatch
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.required
|
(Json.field.required
|
||||||
|
@ -226,7 +226,6 @@ coder =
|
||||||
, description = Text.fields.timeline.filledBatches
|
, description = Text.fields.timeline.filledBatches
|
||||||
, coder = Json.int
|
, coder = Json.int
|
||||||
, default = ( 0, [] )
|
, default = ( 0, [] )
|
||||||
, defaultToString = String.fromInt
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.required
|
(Json.field.required
|
||||||
|
@ -326,7 +325,6 @@ coderIToken =
|
||||||
, description = Text.fields.itoken.starts
|
, description = Text.fields.itoken.starts
|
||||||
, coder = Json.set coderIBatchPTRValue
|
, coder = Json.set coderIBatchPTRValue
|
||||||
, default = ( Set.empty, [] )
|
, default = ( Set.empty, [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -335,7 +333,6 @@ coderIToken =
|
||||||
, description = Text.fields.itoken.ends
|
, description = Text.fields.itoken.ends
|
||||||
, coder = Json.set coderIBatchPTRValue
|
, coder = Json.set coderIBatchPTRValue
|
||||||
, default = ( Set.empty, [] )
|
, default = ( Set.empty, [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -344,7 +341,6 @@ coderIToken =
|
||||||
, description = Text.fields.itoken.inFrontOf
|
, description = Text.fields.itoken.inFrontOf
|
||||||
, coder = Json.set coderITokenPTRValue
|
, coder = Json.set coderITokenPTRValue
|
||||||
, default = ( Set.empty, [] )
|
, default = ( Set.empty, [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Json.field.optional.withDefault
|
(Json.field.optional.withDefault
|
||||||
|
@ -353,7 +349,6 @@ coderIToken =
|
||||||
, description = Text.fields.itoken.behind
|
, description = Text.fields.itoken.behind
|
||||||
, coder = Json.set coderITokenPTRValue
|
, coder = Json.set coderITokenPTRValue
|
||||||
, default = ( Set.empty, [] )
|
, default = ( Set.empty, [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -411,8 +406,8 @@ connectIBatchToIToken (IBatchPTR bptr) pointer (Timeline tl) =
|
||||||
Timeline
|
Timeline
|
||||||
{ tl
|
{ tl
|
||||||
| batches =
|
| batches =
|
||||||
Iddict.map bptr
|
Iddict.update bptr
|
||||||
(\batch -> { batch | end = pointer })
|
(Maybe.map (\batch -> { batch | end = pointer }))
|
||||||
tl.batches
|
tl.batches
|
||||||
, tokens =
|
, tokens =
|
||||||
Hashdict.map tptr
|
Hashdict.map tptr
|
||||||
|
@ -437,8 +432,8 @@ connectITokenToIBatch pointer (IBatchPTR bptr) (Timeline tl) =
|
||||||
(\token -> { token | starts = Set.insert bptr token.starts })
|
(\token -> { token | starts = Set.insert bptr token.starts })
|
||||||
tl.tokens
|
tl.tokens
|
||||||
, batches =
|
, batches =
|
||||||
Iddict.map bptr
|
Iddict.update bptr
|
||||||
(\batch -> { batch | start = pointer })
|
(Maybe.map (\batch -> { batch | start = pointer }))
|
||||||
tl.batches
|
tl.batches
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -683,20 +678,21 @@ mostRecentFrom filter timeline ptr =
|
||||||
{ ptr = ptr, visited = Set.empty }
|
{ 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
|
-- {-| Recount the Timeline's amount of filled batches. Since the Timeline
|
||||||
specific scenarios like decoding JSON values.
|
-- automatically tracks the count on itself, this is generally exclusively used in
|
||||||
-}
|
-- specific scenarios like decoding JSON values.
|
||||||
recountFilledBatches : Timeline -> Timeline
|
-- -}
|
||||||
recountFilledBatches (Timeline tl) =
|
-- recountFilledBatches : Timeline -> Timeline
|
||||||
Timeline
|
-- recountFilledBatches (Timeline tl) =
|
||||||
{ tl
|
-- Timeline
|
||||||
| filledBatches =
|
-- { tl
|
||||||
tl.batches
|
-- | filledBatches =
|
||||||
|> Iddict.values
|
-- tl.batches
|
||||||
|> List.filter (\v -> v.events /= [])
|
-- |> Iddict.values
|
||||||
|> List.length
|
-- |> List.filter (\v -> v.events /= [])
|
||||||
}
|
-- |> List.length
|
||||||
|
-- }
|
||||||
|
|
||||||
|
|
||||||
{-| Create a timeline with a single batch inserted. This batch is considered the
|
{-| Create a timeline with a single batch inserted. This batch is considered the
|
||||||
|
|
|
@ -36,7 +36,7 @@ Since the username is safely parsed, one can get these parts of the username.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Internal.Config.Log as Log exposing (log)
|
import Internal.Config.Log exposing (log)
|
||||||
import Internal.Grammar.ServerName as ServerName
|
import Internal.Grammar.ServerName as ServerName
|
||||||
import Internal.Grammar.UserId as UserId
|
import Internal.Grammar.UserId as UserId
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
|
|
|
@ -1,13 +1,191 @@
|
||||||
module Internal.Values.Vault exposing (Vault)
|
module Internal.Values.Vault exposing
|
||||||
|
( Vault, init
|
||||||
|
, VaultUpdate(..), update
|
||||||
|
, rooms, fromRoomId, mapRoom, updateRoom
|
||||||
|
, getAccountData, setAccountData
|
||||||
|
, coder
|
||||||
|
)
|
||||||
|
|
||||||
{-| This module hosts the Vault module.
|
{-| This module hosts the Vault module. The Vault is the data type storing all
|
||||||
|
credentials, all user information and all other information that the user
|
||||||
|
can receive from the Matrix API.
|
||||||
|
|
||||||
@docs Vault
|
|
||||||
|
## Vault type
|
||||||
|
|
||||||
|
@docs Vault, init
|
||||||
|
|
||||||
|
To update the Vault, one uses VaultUpdate types.
|
||||||
|
|
||||||
|
@docs VaultUpdate, update
|
||||||
|
|
||||||
|
|
||||||
|
## Rooms
|
||||||
|
|
||||||
|
Rooms are environments where people can have a conversation with each other.
|
||||||
|
|
||||||
|
@docs rooms, fromRoomId, mapRoom, updateRoom
|
||||||
|
|
||||||
|
|
||||||
|
## Account data
|
||||||
|
|
||||||
|
@docs getAccountData, setAccountData
|
||||||
|
|
||||||
|
|
||||||
|
## JSON
|
||||||
|
|
||||||
|
@docs coder
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import FastDict as Dict exposing (Dict)
|
||||||
|
import Internal.Config.Text as Text
|
||||||
|
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Room as Room exposing (Room)
|
||||||
|
import Internal.Values.User as User exposing (User)
|
||||||
|
import Recursion
|
||||||
|
import Recursion.Fold
|
||||||
|
|
||||||
|
|
||||||
{-| This is the Vault type.
|
{-| This is the Vault type.
|
||||||
-}
|
-}
|
||||||
type alias Vault =
|
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
|
||||||
|
|
236
src/Matrix.elm
236
src/Matrix.elm
|
@ -1,12 +1,18 @@
|
||||||
module Matrix exposing (Vault)
|
module Matrix exposing
|
||||||
|
( Vault, fromUserId, fromUsername
|
||||||
|
, VaultUpdate, update, sync, logs
|
||||||
|
, rooms, fromRoomId
|
||||||
|
, getAccountData, setAccountData
|
||||||
|
, addAccessToken, sendMessageEvent
|
||||||
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
|
|
||||||
# Matrix SDK
|
# Matrix SDK
|
||||||
|
|
||||||
This first version forms a mere basis from which we will create iterative builds
|
This library forms a mere basis from which an entire functional SDK is
|
||||||
that slowly improve the codebase.
|
developed for the Matrix protocol.
|
||||||
|
|
||||||
It is generally quite unusual to regularly publish iterative beta versions on
|
It is generally quite unusual to regularly publish iterative beta versions on
|
||||||
the public registry, but it is also generally quite unusual to exclusively
|
the public registry, but it is also generally quite unusual to exclusively
|
||||||
|
@ -15,17 +21,235 @@ support a monolithic public registry. (:
|
||||||
|
|
||||||
## Vault
|
## Vault
|
||||||
|
|
||||||
@docs Vault
|
@docs Vault, fromUserId, fromUsername
|
||||||
|
|
||||||
|
|
||||||
|
## Keeping the Vault up-to-date
|
||||||
|
|
||||||
|
@docs VaultUpdate, update, sync, logs
|
||||||
|
|
||||||
|
|
||||||
|
## Exploring the Vault
|
||||||
|
|
||||||
|
@docs rooms, fromRoomId
|
||||||
|
|
||||||
|
|
||||||
|
## Account data
|
||||||
|
|
||||||
|
@docs getAccountData, setAccountData
|
||||||
|
|
||||||
|
|
||||||
|
## Debugging
|
||||||
|
|
||||||
|
@docs addAccessToken, sendMessageEvent
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Types
|
import Internal.Api.Main as Api
|
||||||
|
import Internal.Values.Envelope as Envelope
|
||||||
|
import Internal.Values.User as User
|
||||||
|
import Internal.Values.Vault as Internal
|
||||||
|
import Json.Encode as E
|
||||||
|
import Types exposing (Vault(..), VaultUpdate(..))
|
||||||
|
|
||||||
|
|
||||||
{-| The Vault type stores all relevant information about the Matrix API.
|
{-| The Vault type stores all relevant information about the Matrix API.
|
||||||
|
|
||||||
It currently supports no functionality and it will just stay here - for fun.
|
If you make sure that the data type stays up-to-date, you can use it to explore
|
||||||
|
the latest information about an account.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
type alias Vault =
|
type alias Vault =
|
||||||
Types.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
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
module Matrix.Room exposing
|
module Matrix.Room exposing
|
||||||
( Room, mostRecentEvents
|
( Room, mostRecentEvents, roomId
|
||||||
, getAccountData
|
, getAccountData, setAccountData
|
||||||
|
, sendMessageEvent, sendStateEvent
|
||||||
|
, invite, kick, ban
|
||||||
)
|
)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
|
@ -12,7 +14,7 @@ What is usually called a chat, a channel, a conversation or a group chat on
|
||||||
other platforms, the term used in Matrix is a "room". A room is a conversation
|
other platforms, the term used in Matrix is a "room". A room is a conversation
|
||||||
where a group of users talk to each other.
|
where a group of users talk to each other.
|
||||||
|
|
||||||
@docs Room, mostRecentEvents
|
@docs Room, mostRecentEvents, roomId
|
||||||
|
|
||||||
This module exposes various functions that help you inspect various aspects of
|
This module exposes various functions that help you inspect various aspects of
|
||||||
a room.
|
a room.
|
||||||
|
@ -33,10 +35,26 @@ data is linked to the user account: other logged in devices can see the account
|
||||||
data too, as the server synchronizes it, but the server shouldn´t show it to
|
data too, as the server synchronizes it, but the server shouldn´t show it to
|
||||||
other users.
|
other users.
|
||||||
|
|
||||||
@docs getAccountData
|
@docs getAccountData, setAccountData
|
||||||
|
|
||||||
|
|
||||||
|
## Sending events
|
||||||
|
|
||||||
|
Besides reading the latest events, one can also send new events to the Matrix
|
||||||
|
room. These events are JSON objects that can be shaped in any way or form that
|
||||||
|
you like. To help other users with decoding your JSON objects, you pass an
|
||||||
|
`eventType` string which helps them figure out the nature of your JSON object.
|
||||||
|
|
||||||
|
@docs sendMessageEvent, sendStateEvent
|
||||||
|
|
||||||
|
|
||||||
|
## Moderating users
|
||||||
|
|
||||||
|
@docs invite, kick, ban
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Main as Api
|
||||||
import Internal.Values.Envelope as Envelope
|
import Internal.Values.Envelope as Envelope
|
||||||
import Internal.Values.Room as Internal
|
import Internal.Values.Room as Internal
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
|
@ -49,6 +67,26 @@ type alias Room =
|
||||||
Types.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.
|
{-| Get a piece of account data linked to a certain string key.
|
||||||
-}
|
-}
|
||||||
getAccountData : String -> Room -> Maybe E.Value
|
getAccountData : String -> Room -> Maybe E.Value
|
||||||
|
@ -56,9 +94,121 @@ getAccountData key (Room room) =
|
||||||
Envelope.extract (Internal.getAccountData key) 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.
|
{-| Get a list of the most recent events sent in the room.
|
||||||
-}
|
-}
|
||||||
mostRecentEvents : Room -> List Types.Event
|
mostRecentEvents : Room -> List Types.Event
|
||||||
mostRecentEvents (Room room) =
|
mostRecentEvents (Room room) =
|
||||||
Envelope.mapList Internal.mostRecentEvents room
|
Envelope.mapList Internal.mostRecentEvents room
|
||||||
|> List.map Types.Event
|
|> 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
|
||||||
|
}
|
||||||
|
|
|
@ -1,6 +1,9 @@
|
||||||
module Matrix.Settings exposing
|
module Matrix.Settings exposing
|
||||||
( getDeviceName, setDeviceName
|
( setAccessToken, removeAccessToken
|
||||||
|
, getDeviceName, setDeviceName
|
||||||
, getSyncTime, setSyncTime
|
, getSyncTime, setSyncTime
|
||||||
|
, setPassword
|
||||||
|
, removePassword, removePasswordOnLogin
|
||||||
)
|
)
|
||||||
|
|
||||||
{-| The Matrix Vault has lots of configurable variables that you rarely want to
|
{-| The Matrix Vault has lots of configurable variables that you rarely want to
|
||||||
|
@ -8,6 +11,18 @@ interact with. Usually, you configure these variables only when creating a new
|
||||||
Vault, or when a user explicitly changes one of their preferred settings.
|
Vault, or when a user explicitly changes one of their preferred settings.
|
||||||
|
|
||||||
|
|
||||||
|
## Access token
|
||||||
|
|
||||||
|
The Vault is able to log in on its own, but sometimes you would rather have the
|
||||||
|
Vault use an access token than log in to get one on its own. For this case, you
|
||||||
|
can use this option to insert an access token into the Vault.
|
||||||
|
|
||||||
|
As long as the access token remains valid, the Vault will use this provided
|
||||||
|
access token.
|
||||||
|
|
||||||
|
@docs setAccessToken, removeAccessToken
|
||||||
|
|
||||||
|
|
||||||
## Device name
|
## Device name
|
||||||
|
|
||||||
The default device name that is being communicated with the Matrix API.
|
The default device name that is being communicated with the Matrix API.
|
||||||
|
@ -37,6 +52,21 @@ The value is in miliseconds, so it is set at 30,000.
|
||||||
|
|
||||||
@docs getSyncTime, setSyncTime
|
@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 Internal.Values.Envelope as Envelope
|
||||||
|
@ -50,13 +80,6 @@ getDeviceName (Vault vault) =
|
||||||
Envelope.extractSettings .deviceName vault
|
Envelope.extractSettings .deviceName vault
|
||||||
|
|
||||||
|
|
||||||
{-| Override the device name.
|
|
||||||
-}
|
|
||||||
setDeviceName : String -> Vault -> Vault
|
|
||||||
setDeviceName name (Vault vault) =
|
|
||||||
Vault <| Envelope.mapSettings (\s -> { s | deviceName = name }) vault
|
|
||||||
|
|
||||||
|
|
||||||
{-| Determine the sync timeout value.
|
{-| Determine the sync timeout value.
|
||||||
-}
|
-}
|
||||||
getSyncTime : Vault -> Int
|
getSyncTime : Vault -> Int
|
||||||
|
@ -64,6 +87,65 @@ getSyncTime (Vault vault) =
|
||||||
Envelope.extractSettings .syncTime 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.
|
{-| Override the sync timeout value.
|
||||||
-}
|
-}
|
||||||
setSyncTime : Int -> Vault -> Vault
|
setSyncTime : Int -> Vault -> Vault
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Types exposing (Vault(..), Event(..), Room(..), User(..))
|
module Types exposing (Vault(..), Event(..), Room(..), User(..), VaultUpdate(..))
|
||||||
|
|
||||||
{-| The Elm SDK uses a lot of records and values that are easy to manipulate.
|
{-| 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)
|
Yet, the [Elm design guidelines](https://package.elm-lang.org/help/design-guidelines#keep-tags-and-record-constructors-secret)
|
||||||
|
@ -12,10 +12,11 @@ access their content directly.
|
||||||
The opaque types are placed in a central module so all exposed modules can
|
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.
|
safely access all exposed data types without risking to create circular imports.
|
||||||
|
|
||||||
@docs Vault, Event, Room, User
|
@docs Vault, Event, Room, User, VaultUpdate
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
import Internal.Api.Main as Api
|
||||||
import Internal.Values.Envelope as Envelope
|
import Internal.Values.Envelope as Envelope
|
||||||
import Internal.Values.Event as Event
|
import Internal.Values.Event as Event
|
||||||
import Internal.Values.Room as Room
|
import Internal.Values.Room as Room
|
||||||
|
@ -45,3 +46,9 @@ type User
|
||||||
-}
|
-}
|
||||||
type Vault
|
type Vault
|
||||||
= Vault (Envelope.Envelope Vault.Vault)
|
= Vault (Envelope.Envelope Vault.Vault)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Opaque type for Matrix VaultUpdate
|
||||||
|
-}
|
||||||
|
type VaultUpdate
|
||||||
|
= VaultUpdate Api.Msg
|
||||||
|
|
|
@ -103,7 +103,7 @@ suite =
|
||||||
]
|
]
|
||||||
, describe "singleton"
|
, describe "singleton"
|
||||||
[ fuzz TestEvent.fuzzer
|
[ fuzz TestEvent.fuzzer
|
||||||
"singletong = empty + insert"
|
"singleton = empty + insert"
|
||||||
(\event ->
|
(\event ->
|
||||||
Hashdict.empty .eventId
|
Hashdict.empty .eventId
|
||||||
|> Hashdict.insert event
|
|> Hashdict.insert event
|
||||||
|
@ -159,6 +159,26 @@ suite =
|
||||||
|> Expect.equal False
|
|> 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"
|
, describe "JSON"
|
||||||
[ fuzz2 eventFuzzer
|
[ fuzz2 eventFuzzer
|
||||||
(Fuzz.intRange 0 10)
|
(Fuzz.intRange 0 10)
|
||||||
|
|
|
@ -1,280 +0,0 @@
|
||||||
module Test.Tools.Iddict exposing (..)
|
|
||||||
|
|
||||||
import Expect
|
|
||||||
import Fuzz exposing (Fuzzer)
|
|
||||||
import Internal.Tools.Iddict as Iddict exposing (Iddict)
|
|
||||||
import Internal.Tools.Json as Json
|
|
||||||
import Json.Decode as D
|
|
||||||
import Json.Encode as E
|
|
||||||
import Test exposing (..)
|
|
||||||
|
|
||||||
|
|
||||||
fuzzer : Fuzzer a -> Fuzzer (Iddict a)
|
|
||||||
fuzzer fuz =
|
|
||||||
fuz
|
|
||||||
|> Fuzz.pair Fuzz.bool
|
|
||||||
|> Fuzz.list
|
|
||||||
|> Fuzz.map
|
|
||||||
(\items ->
|
|
||||||
List.foldl
|
|
||||||
(\( rm, item ) dict ->
|
|
||||||
case Iddict.insert item dict of
|
|
||||||
( key, d ) ->
|
|
||||||
if rm then
|
|
||||||
Iddict.remove key d
|
|
||||||
|
|
||||||
else
|
|
||||||
d
|
|
||||||
)
|
|
||||||
Iddict.empty
|
|
||||||
items
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
empty : Test
|
|
||||||
empty =
|
|
||||||
describe "empty"
|
|
||||||
[ test "isEmpty"
|
|
||||||
(Iddict.empty
|
|
||||||
|> Iddict.isEmpty
|
|
||||||
|> Expect.equal True
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"No members"
|
|
||||||
(\i ->
|
|
||||||
Iddict.empty
|
|
||||||
|> Iddict.member i
|
|
||||||
|> Expect.equal False
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"Get gets Nothing"
|
|
||||||
(\i ->
|
|
||||||
Iddict.empty
|
|
||||||
|> Iddict.get i
|
|
||||||
|> Expect.equal Nothing
|
|
||||||
)
|
|
||||||
, test "Size = 0"
|
|
||||||
(Iddict.empty
|
|
||||||
|> Iddict.size
|
|
||||||
|> Expect.equal 0
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
, test "No keys"
|
|
||||||
(Iddict.empty
|
|
||||||
|> Iddict.keys
|
|
||||||
|> Expect.equal []
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
, test "No values"
|
|
||||||
(Iddict.empty
|
|
||||||
|> Iddict.values
|
|
||||||
|> Expect.equal []
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
, test "JSON encode -> decode -> empty"
|
|
||||||
(Iddict.empty
|
|
||||||
|> Iddict.encode Json.value
|
|
||||||
|> D.decodeValue (Iddict.decoder Json.value)
|
|
||||||
|> Result.map Tuple.first
|
|
||||||
|> Expect.equal (Ok Iddict.empty)
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
, test "JSON encode"
|
|
||||||
(Iddict.empty
|
|
||||||
|> Iddict.encode Json.value
|
|
||||||
|> E.encode 0
|
|
||||||
|> Expect.equal "{\"dict\":{}}"
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
, test "JSON decode"
|
|
||||||
("{\"dict\":{}}"
|
|
||||||
|> D.decodeString (Iddict.decoder Json.value)
|
|
||||||
|> Result.map Tuple.first
|
|
||||||
|> Expect.equal (Ok Iddict.empty)
|
|
||||||
|> always
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
singleton : Test
|
|
||||||
singleton =
|
|
||||||
let
|
|
||||||
singleFuzzer : Fuzzer (Iddict Int)
|
|
||||||
singleFuzzer =
|
|
||||||
Fuzz.map
|
|
||||||
(\i ->
|
|
||||||
Iddict.singleton i
|
|
||||||
|> Tuple.second
|
|
||||||
)
|
|
||||||
Fuzz.int
|
|
||||||
in
|
|
||||||
describe "singleton"
|
|
||||||
[ fuzz singleFuzzer
|
|
||||||
"not isEmpty"
|
|
||||||
(\single ->
|
|
||||||
single
|
|
||||||
|> Iddict.isEmpty
|
|
||||||
|> Expect.equal False
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"singleton == insert empty"
|
|
||||||
(\i ->
|
|
||||||
Iddict.empty
|
|
||||||
|> Iddict.insert i
|
|
||||||
|> Expect.equal (Iddict.singleton i)
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"First item is key 0"
|
|
||||||
(\i ->
|
|
||||||
Iddict.singleton i
|
|
||||||
|> Tuple.first
|
|
||||||
|> Expect.equal 0
|
|
||||||
)
|
|
||||||
, fuzz singleFuzzer
|
|
||||||
"Key 0 is member"
|
|
||||||
(\single ->
|
|
||||||
single
|
|
||||||
|> Iddict.member 0
|
|
||||||
|> Expect.equal True
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"Key 0 get returns Just value"
|
|
||||||
(\i ->
|
|
||||||
Iddict.singleton i
|
|
||||||
|> Tuple.second
|
|
||||||
|> Iddict.get 0
|
|
||||||
|> Expect.equal (Just i)
|
|
||||||
)
|
|
||||||
, fuzz singleFuzzer
|
|
||||||
"Size == 1"
|
|
||||||
(\single ->
|
|
||||||
single
|
|
||||||
|> Iddict.size
|
|
||||||
|> Expect.equal 1
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"Only key 0"
|
|
||||||
(\i ->
|
|
||||||
Iddict.singleton i
|
|
||||||
|> Tuple.second
|
|
||||||
|> Iddict.keys
|
|
||||||
|> Expect.equal [ 0 ]
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"Only value value"
|
|
||||||
(\i ->
|
|
||||||
Iddict.singleton i
|
|
||||||
|> Tuple.second
|
|
||||||
|> Iddict.values
|
|
||||||
|> Expect.equal [ i ]
|
|
||||||
)
|
|
||||||
, fuzz singleFuzzer
|
|
||||||
"JSON encode -> decode -> singleton"
|
|
||||||
(\single ->
|
|
||||||
single
|
|
||||||
|> Iddict.encode Json.int
|
|
||||||
|> D.decodeValue (Iddict.decoder Json.int)
|
|
||||||
|> Result.map Tuple.first
|
|
||||||
|> Expect.equal (Ok single)
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"JSON encode"
|
|
||||||
(\i ->
|
|
||||||
Iddict.singleton i
|
|
||||||
|> Tuple.second
|
|
||||||
|> Iddict.encode Json.int
|
|
||||||
|> E.encode 0
|
|
||||||
|> Expect.equal ("{\"cursor\":1,\"dict\":{\"0\":" ++ String.fromInt i ++ "}}")
|
|
||||||
)
|
|
||||||
, fuzz Fuzz.int
|
|
||||||
"JSON decode"
|
|
||||||
(\i ->
|
|
||||||
("{\"cursor\":1,\"dict\":{\"0\":" ++ String.fromInt i ++ "}}")
|
|
||||||
|> D.decodeString (Iddict.decoder Json.int)
|
|
||||||
|> Result.map Tuple.first
|
|
||||||
|> Tuple.pair 0
|
|
||||||
|> Expect.equal (Iddict.singleton i |> Tuple.mapSecond Ok)
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
insert : Test
|
|
||||||
insert =
|
|
||||||
describe "insert"
|
|
||||||
[ fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"Add something"
|
|
||||||
(\d i ->
|
|
||||||
case Iddict.insert i d of
|
|
||||||
( key, dict ) ->
|
|
||||||
dict
|
|
||||||
|> Iddict.get key
|
|
||||||
|> Expect.equal (Just i)
|
|
||||||
)
|
|
||||||
, fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"Never isEmpty"
|
|
||||||
(\d i ->
|
|
||||||
Iddict.insert i d
|
|
||||||
|> Tuple.second
|
|
||||||
|> Iddict.isEmpty
|
|
||||||
|> Expect.equal False
|
|
||||||
)
|
|
||||||
, fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"New key"
|
|
||||||
(\d i ->
|
|
||||||
case Iddict.insert i d of
|
|
||||||
( key, dict ) ->
|
|
||||||
dict
|
|
||||||
|> Iddict.remove key
|
|
||||||
|> Iddict.insert i
|
|
||||||
|> (\( newKey, _ ) ->
|
|
||||||
Expect.notEqual key newKey
|
|
||||||
)
|
|
||||||
)
|
|
||||||
, fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"New dict"
|
|
||||||
(\d i ->
|
|
||||||
case Iddict.insert i d of
|
|
||||||
( key, dict ) ->
|
|
||||||
dict
|
|
||||||
|> Iddict.remove key
|
|
||||||
|> Iddict.insert i
|
|
||||||
|> (\( _, newDict ) ->
|
|
||||||
Expect.notEqual dict newDict
|
|
||||||
)
|
|
||||||
)
|
|
||||||
, fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"Inserted value is member"
|
|
||||||
(\d i ->
|
|
||||||
case Iddict.insert i d of
|
|
||||||
( key, dict ) ->
|
|
||||||
dict
|
|
||||||
|> Iddict.member key
|
|
||||||
|> Expect.equal True
|
|
||||||
)
|
|
||||||
, fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"Get inserted value"
|
|
||||||
(\d i ->
|
|
||||||
case Iddict.insert i d of
|
|
||||||
( key, dict ) ->
|
|
||||||
dict
|
|
||||||
|> Iddict.get key
|
|
||||||
|> Expect.equal (Just i)
|
|
||||||
)
|
|
||||||
, fuzz2 (fuzzer Fuzz.int)
|
|
||||||
Fuzz.int
|
|
||||||
"size = size + 1"
|
|
||||||
(\d i ->
|
|
||||||
case Iddict.insert i d of
|
|
||||||
( _, dict ) ->
|
|
||||||
Expect.equal
|
|
||||||
(Iddict.size dict)
|
|
||||||
(Iddict.size d + 1)
|
|
||||||
)
|
|
||||||
]
|
|
|
@ -100,7 +100,6 @@ gridField =
|
||||||
, description = []
|
, description = []
|
||||||
, coder = Json.list (Json.list Json.int)
|
, coder = Json.list (Json.list Json.int)
|
||||||
, default = ( [], [] )
|
, default = ( [], [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -132,7 +131,6 @@ hobbiesField =
|
||||||
, description = []
|
, description = []
|
||||||
, coder = Json.list Json.string
|
, coder = Json.list Json.string
|
||||||
, default = ( [], [] )
|
, default = ( [], [] )
|
||||||
, defaultToString = always "[]"
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -149,13 +147,6 @@ invitedToPartyField =
|
||||||
, description = []
|
, description = []
|
||||||
, coder = Json.bool
|
, coder = Json.bool
|
||||||
, default = ( False, [] )
|
, default = ( False, [] )
|
||||||
, defaultToString =
|
|
||||||
\b ->
|
|
||||||
if b then
|
|
||||||
"True"
|
|
||||||
|
|
||||||
else
|
|
||||||
"False"
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -3,10 +3,12 @@ module Test.Values.Context exposing (..)
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Config.Leaks as Leaks
|
import Internal.Config.Leaks as Leaks
|
||||||
import Internal.Values.Context as Context exposing (Context)
|
import Internal.Tools.Hashdict as Hashdict
|
||||||
import Json.Decode as D
|
import Internal.Values.Context as Context exposing (Context, Versions)
|
||||||
import Json.Encode as E
|
import Set
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
|
import Test.Tools.Timestamp as TestTimestamp
|
||||||
|
import Test.Values.User as TestUser
|
||||||
|
|
||||||
|
|
||||||
fuzzer : Fuzzer Context
|
fuzzer : Fuzzer Context
|
||||||
|
@ -16,14 +18,37 @@ fuzzer =
|
||||||
maybeString =
|
maybeString =
|
||||||
Fuzz.maybe Fuzz.string
|
Fuzz.maybe Fuzz.string
|
||||||
in
|
in
|
||||||
Fuzz.map7 Context
|
Fuzz.map8 (\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) -> Context a b c d e f g h i j k l m)
|
||||||
|
(Fuzz.constant <| Hashdict.empty .value)
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
(Fuzz.pair
|
||||||
maybeString
|
maybeString
|
||||||
maybeString
|
(Fuzz.maybe TestTimestamp.fuzzer)
|
||||||
maybeString
|
)
|
||||||
(Fuzz.maybe <| Fuzz.list Fuzz.string)
|
(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
|
{-| If a leak is spotted, make sure to change the leaking value and then test
|
||||||
|
@ -64,7 +89,7 @@ leaks =
|
||||||
|> Expect.notEqual Leaks.transaction
|
|> Expect.notEqual Leaks.transaction
|
||||||
)
|
)
|
||||||
, fuzz2 fuzzer
|
, fuzz2 fuzzer
|
||||||
(Fuzz.list Fuzz.string)
|
versionsFuzzer
|
||||||
"Versions"
|
"Versions"
|
||||||
(\context value ->
|
(\context value ->
|
||||||
context
|
context
|
||||||
|
@ -110,7 +135,7 @@ apiContext =
|
||||||
|> Expect.equal value
|
|> Expect.equal value
|
||||||
)
|
)
|
||||||
, fuzz2 fuzzer
|
, fuzz2 fuzzer
|
||||||
(Fuzz.list Fuzz.string)
|
versionsFuzzer
|
||||||
"Versions"
|
"Versions"
|
||||||
(\context value ->
|
(\context value ->
|
||||||
context
|
context
|
||||||
|
@ -122,22 +147,16 @@ apiContext =
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
json : Test
|
|
||||||
json =
|
-- json : Test
|
||||||
describe "JSON encode + JSON decode"
|
-- json =
|
||||||
[ test "Empty is {}"
|
-- describe "JSON encode + JSON decode"
|
||||||
(Context.init
|
-- [ fuzz fuzzer
|
||||||
|> Context.encode
|
-- "JSON recode"
|
||||||
|> E.encode 0
|
-- (\context ->
|
||||||
|> Expect.equal "{}"
|
-- context
|
||||||
|> always
|
-- |> Context.encode
|
||||||
)
|
-- |> D.decodeValue Context.decoder
|
||||||
, fuzz fuzzer
|
-- |> Expect.equal (Ok ( context, [] ))
|
||||||
"JSON recode"
|
-- )
|
||||||
(\context ->
|
-- ]
|
||||||
context
|
|
||||||
|> Context.encode
|
|
||||||
|> D.decodeValue Context.decoder
|
|
||||||
|> Expect.equal (Ok ( context, [] ))
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
|
@ -3,10 +3,7 @@ module Test.Values.Envelope exposing (..)
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Config.Default as Default
|
import Internal.Config.Default as Default
|
||||||
import Internal.Tools.Json as Json
|
|
||||||
import Internal.Values.Envelope as Envelope exposing (Envelope)
|
import Internal.Values.Envelope as Envelope exposing (Envelope)
|
||||||
import Json.Decode as D
|
|
||||||
import Json.Encode as E
|
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Values.Context as TestContext
|
import Test.Values.Context as TestContext
|
||||||
import Test.Values.Settings as TestSettings
|
import Test.Values.Settings as TestSettings
|
||||||
|
@ -28,7 +25,7 @@ suite =
|
||||||
[ fuzz Fuzz.string
|
[ fuzz Fuzz.string
|
||||||
"currentVersion"
|
"currentVersion"
|
||||||
(\s ->
|
(\s ->
|
||||||
s
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .currentVersion
|
|> Envelope.extractSettings .currentVersion
|
||||||
|> Expect.equal Default.currentVersion
|
|> Expect.equal Default.currentVersion
|
||||||
|
@ -36,7 +33,7 @@ suite =
|
||||||
, fuzz Fuzz.string
|
, fuzz Fuzz.string
|
||||||
"deviceName"
|
"deviceName"
|
||||||
(\s ->
|
(\s ->
|
||||||
s
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .deviceName
|
|> Envelope.extractSettings .deviceName
|
||||||
|> Expect.equal Default.deviceName
|
|> Expect.equal Default.deviceName
|
||||||
|
@ -44,23 +41,24 @@ suite =
|
||||||
, fuzz Fuzz.string
|
, fuzz Fuzz.string
|
||||||
"syncTime"
|
"syncTime"
|
||||||
(\s ->
|
(\s ->
|
||||||
s
|
{ content = s, serverName = "", user = Nothing }
|
||||||
|> Envelope.init
|
|> Envelope.init
|
||||||
|> Envelope.extractSettings .syncTime
|
|> Envelope.extractSettings .syncTime
|
||||||
|> Expect.equal Default.syncTime
|
|> Expect.equal Default.syncTime
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, describe "JSON"
|
|
||||||
[ fuzz2 (fuzzer Fuzz.string)
|
-- , describe "JSON"
|
||||||
Fuzz.int
|
-- [ fuzz2 (fuzzer Fuzz.string)
|
||||||
"JSON encode -> JSON decode"
|
-- Fuzz.int
|
||||||
(\envelope indent ->
|
-- "JSON encode -> JSON decode"
|
||||||
envelope
|
-- (\envelope indent ->
|
||||||
|> Envelope.encode Json.string
|
-- envelope
|
||||||
|> E.encode indent
|
-- |> Envelope.encode Json.string
|
||||||
|> D.decodeString (Envelope.decoder Json.string)
|
-- |> E.encode indent
|
||||||
|> Expect.equal (Ok ( envelope, [] ))
|
-- |> D.decodeString (Envelope.decoder Json.string)
|
||||||
)
|
-- |> Expect.equal (Ok ( envelope, [] ))
|
||||||
]
|
-- )
|
||||||
|
-- ]
|
||||||
]
|
]
|
||||||
|
|
|
@ -41,16 +41,18 @@ fuzzerState =
|
||||||
|
|
||||||
unsignedDataFuzzer : Fuzzer Event.UnsignedData
|
unsignedDataFuzzer : Fuzzer Event.UnsignedData
|
||||||
unsignedDataFuzzer =
|
unsignedDataFuzzer =
|
||||||
Fuzz.map4
|
Fuzz.map5
|
||||||
(\age prev redact trans ->
|
(\age memb prev redact trans ->
|
||||||
Event.UnsignedData
|
Event.UnsignedData
|
||||||
{ age = age
|
{ age = age
|
||||||
|
, membership = memb
|
||||||
, prevContent = prev
|
, prevContent = prev
|
||||||
, redactedBecause = redact
|
, redactedBecause = redact
|
||||||
, transactionId = trans
|
, transactionId = trans
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
(Fuzz.maybe Fuzz.int)
|
(Fuzz.maybe Fuzz.int)
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
(Fuzz.maybe valueFuzzer)
|
(Fuzz.maybe valueFuzzer)
|
||||||
(Fuzz.maybe <| Fuzz.lazy (\_ -> fuzzer))
|
(Fuzz.maybe <| Fuzz.lazy (\_ -> fuzzer))
|
||||||
(Fuzz.maybe Fuzz.string)
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
|
|
@ -1,13 +1,9 @@
|
||||||
module Test.Values.Room exposing (..)
|
module Test.Values.Room exposing (..)
|
||||||
|
|
||||||
import Expect
|
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Values.Room as Room exposing (Room)
|
import Internal.Values.Room as Room exposing (Room)
|
||||||
import Json.Decode as D
|
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Filter.Timeline as TestFilter
|
|
||||||
import Test.Values.Event as TestEvent
|
|
||||||
|
|
||||||
|
|
||||||
placeholderValue : E.Value
|
placeholderValue : E.Value
|
||||||
|
@ -20,23 +16,26 @@ fuzzer =
|
||||||
Fuzz.string
|
Fuzz.string
|
||||||
|> Fuzz.map Room.init
|
|> Fuzz.map Room.init
|
||||||
|> addAFewTimes Fuzz.string (\key -> Room.setAccountData key placeholderValue)
|
|> 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)
|
-- |> addAFewTimes (Fuzz.list TestEvent.fuzzer) Room.addEvents
|
||||||
Fuzz.string
|
-- |> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
|
||||||
(\a b c d ->
|
-- TestFilter.fuzzer
|
||||||
Room.Batch a b c d
|
-- (Fuzz.maybe Fuzz.string)
|
||||||
|> Room.addBatch
|
-- Fuzz.string
|
||||||
)
|
-- (\a b c d ->
|
||||||
|> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
|
-- Room.Batch a b c d
|
||||||
TestFilter.fuzzer
|
-- |> Room.addBatch
|
||||||
(Fuzz.maybe Fuzz.string)
|
-- )
|
||||||
Fuzz.string
|
-- |> add4AFewTimes (Fuzz.list TestEvent.fuzzer)
|
||||||
(\a b c d ->
|
-- TestFilter.fuzzer
|
||||||
Room.Batch a b c d
|
-- (Fuzz.maybe Fuzz.string)
|
||||||
|> Room.addSync
|
-- 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 : Fuzzer a -> (a -> Room -> Room) -> Fuzzer Room -> Fuzzer Room
|
||||||
|
|
|
@ -11,7 +11,7 @@ import Test exposing (..)
|
||||||
|
|
||||||
fuzzer : Fuzzer Settings
|
fuzzer : Fuzzer Settings
|
||||||
fuzzer =
|
fuzzer =
|
||||||
Fuzz.map3 Settings
|
Fuzz.map5 Settings
|
||||||
(Fuzz.oneOf
|
(Fuzz.oneOf
|
||||||
[ Fuzz.constant Default.currentVersion
|
[ Fuzz.constant Default.currentVersion
|
||||||
, Fuzz.string
|
, Fuzz.string
|
||||||
|
@ -22,6 +22,12 @@ fuzzer =
|
||||||
, Fuzz.string
|
, Fuzz.string
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
(Fuzz.oneOf
|
||||||
|
[ Fuzz.constant Default.removePasswordOnLogin
|
||||||
|
, Fuzz.bool
|
||||||
|
]
|
||||||
|
)
|
||||||
(Fuzz.oneOf
|
(Fuzz.oneOf
|
||||||
[ Fuzz.constant Default.syncTime
|
[ Fuzz.constant Default.syncTime
|
||||||
, Fuzz.int
|
, Fuzz.int
|
||||||
|
@ -45,6 +51,12 @@ suite =
|
||||||
|> Expect.equal Default.deviceName
|
|> Expect.equal Default.deviceName
|
||||||
|> always
|
|> always
|
||||||
)
|
)
|
||||||
|
, test "Remove password on login"
|
||||||
|
(Settings.init
|
||||||
|
|> .removePasswordOnLogin
|
||||||
|
|> Expect.equal Default.removePasswordOnLogin
|
||||||
|
|> always
|
||||||
|
)
|
||||||
, test "Sync time"
|
, test "Sync time"
|
||||||
(Settings.init
|
(Settings.init
|
||||||
|> .syncTime
|
|> .syncTime
|
||||||
|
|
|
@ -2,10 +2,11 @@ module Test.Values.Timeline exposing (..)
|
||||||
|
|
||||||
import Expect
|
import Expect
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
import Internal.Filter.Timeline as Filter exposing (Filter)
|
import Internal.Filter.Timeline as Filter
|
||||||
import Internal.Tools.Json as Json
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
|
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
|
||||||
import Json.Decode as D
|
import Json.Decode as D
|
||||||
|
import Json.Encode as E
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
import Test.Filter.Timeline as TestFilter
|
import Test.Filter.Timeline as TestFilter
|
||||||
|
|
||||||
|
@ -250,7 +251,8 @@ suite =
|
||||||
(\timeline ->
|
(\timeline ->
|
||||||
timeline
|
timeline
|
||||||
|> Json.encode Timeline.coder
|
|> Json.encode Timeline.coder
|
||||||
|> D.decodeValue (Json.decode Timeline.coder)
|
|> E.encode 0
|
||||||
|
|> D.decodeString (Json.decode Timeline.coder)
|
||||||
|> Result.map Tuple.first
|
|> Result.map Tuple.first
|
||||||
|> Result.map (Timeline.mostRecentEvents Filter.pass)
|
|> Result.map (Timeline.mostRecentEvents Filter.pass)
|
||||||
|> Expect.equal (Ok <| Timeline.mostRecentEvents Filter.pass timeline)
|
|> Expect.equal (Ok <| Timeline.mostRecentEvents Filter.pass timeline)
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
module Test.Values.User exposing (..)
|
||||||
|
|
||||||
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Grammar.ServerName as SN
|
||||||
|
import Internal.Values.User exposing (User)
|
||||||
|
|
||||||
|
|
||||||
|
fuzzer : Fuzzer User
|
||||||
|
fuzzer =
|
||||||
|
Fuzz.constant
|
||||||
|
{ localpart = "temporary"
|
||||||
|
, domain = { host = SN.DNS "matrix.org", port_ = Nothing }
|
||||||
|
}
|
|
@ -1,10 +1,21 @@
|
||||||
module Test.Values.Vault exposing (..)
|
module Test.Values.Vault exposing (..)
|
||||||
|
|
||||||
|
import FastDict as Dict
|
||||||
import Fuzz exposing (Fuzzer)
|
import Fuzz exposing (Fuzzer)
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
import Internal.Values.Vault exposing (Vault)
|
import Internal.Values.Vault exposing (Vault)
|
||||||
import Test exposing (..)
|
import Test exposing (..)
|
||||||
|
import Test.Tools.Hashdict as TestHashdict
|
||||||
|
import Test.Values.Room as TestRoom
|
||||||
|
|
||||||
|
|
||||||
vault : Fuzzer Vault
|
vault : Fuzzer Vault
|
||||||
vault =
|
vault =
|
||||||
Fuzz.unit
|
Fuzz.map3 Vault
|
||||||
|
(Fuzz.string
|
||||||
|
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|
||||||
|
|> Fuzz.list
|
||||||
|
|> Fuzz.map Dict.fromList
|
||||||
|
)
|
||||||
|
(Fuzz.maybe Fuzz.string)
|
||||||
|
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
|
||||||
|
|
Loading…
Reference in New Issue