Compare commits
67 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 | |
|
d360c561f9 |
|
@ -8,3 +8,6 @@ repl-temp-*
|
|||
# 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
|
||||
considered deprecated.
|
||||
|
||||
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) at
|
||||
@elm_matrix_sdk@social.noordstar.me to stay up-to-date on the latest changes.
|
||||
Follow us on [Mastodon](https://social.noordstar.me/@elm_matrix_sdk) or join the
|
||||
conversation on [Matrix](https://matrix.to/#/#elm-sdk:matrix.org) to stay
|
||||
up-to-date on the latest changes.
|
||||
|
||||
## How to install
|
||||
|
||||
|
|
5
elm.json
5
elm.json
|
@ -3,7 +3,7 @@
|
|||
"name": "noordstar/elm-matrix-sdk-beta",
|
||||
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
|
||||
"license": "EUPL-1.1",
|
||||
"version": "3.3.0",
|
||||
"version": "3.5.0",
|
||||
"exposed-modules": [
|
||||
"Matrix",
|
||||
"Matrix.Event",
|
||||
|
@ -20,7 +20,8 @@
|
|||
"elm/time": "1.0.0 <= v < 2.0.0",
|
||||
"elm/url": "1.0.0 <= v < 2.0.0",
|
||||
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
||||
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
||||
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0",
|
||||
"noordstar/elm-iddict": "1.0.1 <= v < 2.0.0"
|
||||
},
|
||||
"test-dependencies": {
|
||||
"elm-explorations/test": "2.1.2 <= v < 3.0.0"
|
||||
|
|
|
@ -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
|
|
@ -13,7 +13,6 @@ This module looks for the right homeserver address.
|
|||
|
||||
import Internal.Api.Chain as C
|
||||
import Internal.Api.Request as R
|
||||
import Internal.Config.Leaks as L
|
||||
import Internal.Config.Log exposing (log)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Tools.Json as Json
|
||||
|
@ -87,12 +86,12 @@ coder =
|
|||
{ fieldName = "m.homeserver"
|
||||
, toField = .homeserver
|
||||
, coder =
|
||||
Json.object2
|
||||
Json.object1
|
||||
{ name = "Homeserver Information"
|
||||
, description =
|
||||
[ "Used by clients to discover homeserver information."
|
||||
]
|
||||
, init = \a _ -> { baseUrl = a }
|
||||
, init = HomeserverInformation
|
||||
}
|
||||
(Json.field.required
|
||||
{ fieldName = "base_url"
|
||||
|
@ -103,17 +102,6 @@ coder =
|
|||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = L.field
|
||||
, toField = always Nothing
|
||||
, description =
|
||||
[ "The Elm SDK always expects objects to have at least two fields."
|
||||
, "Otherwise, what's the point of hiding the value in an object?"
|
||||
, "For this reason, this empty placeholder key will always be ignored."
|
||||
]
|
||||
, coder = Json.value
|
||||
}
|
||||
)
|
||||
, description =
|
||||
[ "Used by clients to discover homeserver information."
|
||||
]
|
||||
|
@ -123,12 +111,12 @@ coder =
|
|||
{ fieldName = "m.identity_server"
|
||||
, toField = .identityServer
|
||||
, coder =
|
||||
Json.object2
|
||||
Json.object1
|
||||
{ name = "Homeserver Information"
|
||||
, description =
|
||||
[ "Used by clients to discover homeserver information."
|
||||
]
|
||||
, init = \a _ -> { baseUrl = a }
|
||||
, init = IdentityServerInformation
|
||||
}
|
||||
(Json.field.required
|
||||
{ fieldName = "base_url"
|
||||
|
@ -139,17 +127,6 @@ coder =
|
|||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = L.field
|
||||
, toField = always Nothing
|
||||
, description =
|
||||
[ "The Elm SDK always expects objects to have at least two fields."
|
||||
, "Otherwise, what's the point of hiding the value in an object?"
|
||||
, "For this reason, this empty placeholder key will always be ignored."
|
||||
]
|
||||
, coder = Json.value
|
||||
}
|
||||
)
|
||||
, description =
|
||||
[ "Used by clients to discover identity server information."
|
||||
]
|
||||
|
|
|
@ -204,7 +204,7 @@ getEventCoderV1 =
|
|||
[ "UnsignedData as described by the Matrix spec"
|
||||
, "https://spec.matrix.org/v1.10/client-server-api/#get_matrixclientv3roomsroomideventeventid"
|
||||
]
|
||||
, init = \a b c d -> Event.UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }
|
||||
, init = \a b c d -> Event.UnsignedData { age = a, membership = Nothing, prevContent = b, redactedBecause = c, transactionId = d }
|
||||
}
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "age"
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
module Internal.Api.Invite.Api exposing (InviteInput, Phantom, invite)
|
||||
module Internal.Api.InviteUser.Api exposing (InviteInput, Phantom, inviteUser)
|
||||
|
||||
{-|
|
||||
|
||||
|
@ -14,7 +14,7 @@ room.
|
|||
If the user was invited to the room, the homeserver will append a m.room.member
|
||||
event to the room.
|
||||
|
||||
@docs InviteInput, Phantom, invite
|
||||
@docs InviteInput, Phantom, inviteUser
|
||||
|
||||
-}
|
||||
|
||||
|
@ -31,8 +31,8 @@ import Internal.Values.Vault as V
|
|||
|
||||
{-| Invite a user to a room.
|
||||
-}
|
||||
invite : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1)
|
||||
invite =
|
||||
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"
|
||||
|
@ -107,7 +107,8 @@ inviteV2 : InviteInputV2 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1)
|
|||
inviteV2 { reason, roomId, user } =
|
||||
A.request
|
||||
{ attributes =
|
||||
[ R.bodyOpString "reason" reason
|
||||
[ R.accessToken
|
||||
, R.bodyOpString "reason" reason
|
||||
, R.bodyString "user_id" (User.toString user)
|
||||
, R.onStatusCode 400 "M_UNKNOWN"
|
||||
, R.onStatusCode 403 "M_FORBIDDEN"
|
|
@ -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
|
|
@ -13,7 +13,6 @@ This module allows the user to log in using a username and password.
|
|||
|
||||
import Internal.Api.Api as A
|
||||
import Internal.Api.Request as R
|
||||
import Internal.Config.Leaks as L
|
||||
import Internal.Config.Log exposing (log)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Tools.Json as Json
|
||||
|
@ -192,7 +191,7 @@ loginWithUsernameAndPasswordV1 { username, password } =
|
|||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, out.user
|
||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||
|> Maybe.map E.SetUser
|
||||
|> E.Optional
|
||||
]
|
||||
, Text.logs.loggedInAs username
|
||||
|
@ -234,7 +233,7 @@ loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, p
|
|||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, out.user
|
||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||
|> Maybe.map E.SetUser
|
||||
|> E.Optional
|
||||
, out.deviceId
|
||||
|> Maybe.map E.SetDeviceId
|
||||
|
@ -286,7 +285,7 @@ loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, p
|
|||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, out.user
|
||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||
|> Maybe.map E.SetUser
|
||||
|> E.Optional
|
||||
, out.deviceId
|
||||
|> Maybe.map E.SetDeviceId
|
||||
|
@ -338,7 +337,7 @@ loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, p
|
|||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, out.user
|
||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||
|> Maybe.map E.SetUser
|
||||
|> E.Optional
|
||||
, out.wellKnown
|
||||
|> Maybe.map (.homeserver >> .baseUrl)
|
||||
|
@ -394,7 +393,7 @@ loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, p
|
|||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, out.user
|
||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||
|> Maybe.map E.SetUser
|
||||
|> E.Optional
|
||||
, out.wellKnown
|
||||
|> Maybe.map (.homeserver >> .baseUrl)
|
||||
|
@ -451,7 +450,7 @@ loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisp
|
|||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, out.user
|
||||
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|
||||
|> Maybe.map E.SetUser
|
||||
|> E.Optional
|
||||
, out.wellKnown
|
||||
|> Maybe.map (.homeserver >> .baseUrl)
|
||||
|
@ -507,7 +506,7 @@ loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisp
|
|||
, value = out.accessToken
|
||||
}
|
||||
, E.RemovePasswordIfNecessary
|
||||
, E.ContentUpdate (V.SetUser out.user)
|
||||
, E.SetUser out.user
|
||||
, out.wellKnown
|
||||
|> Maybe.map (.homeserver >> .baseUrl)
|
||||
|> Maybe.map E.SetBaseUrl
|
||||
|
@ -888,12 +887,12 @@ disoveryInformationCoderV1 =
|
|||
{ fieldName = "m.homeserver"
|
||||
, toField = .homeserver
|
||||
, coder =
|
||||
Json.object2
|
||||
Json.object1
|
||||
{ name = "Homeserver Information"
|
||||
, description =
|
||||
[ "Used by clients to discover homeserver information."
|
||||
]
|
||||
, init = \a _ -> { baseUrl = a }
|
||||
, init = HomeserverInformation
|
||||
}
|
||||
(Json.field.required
|
||||
{ fieldName = "base_url"
|
||||
|
@ -904,17 +903,6 @@ disoveryInformationCoderV1 =
|
|||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = L.field
|
||||
, toField = always Nothing
|
||||
, description =
|
||||
[ "The Elm SDK always expects objects to have at least two fields."
|
||||
, "Otherwise, what's the point of hiding the value in an object?"
|
||||
, "For this reason, this empty placeholder key will always be ignored."
|
||||
]
|
||||
, coder = Json.value
|
||||
}
|
||||
)
|
||||
, description =
|
||||
[ "Used by clients to discover homeserver information."
|
||||
]
|
||||
|
@ -924,12 +912,12 @@ disoveryInformationCoderV1 =
|
|||
{ fieldName = "m.identity_server"
|
||||
, toField = .identityServer
|
||||
, coder =
|
||||
Json.object2
|
||||
Json.object1
|
||||
{ name = "Homeserver Information"
|
||||
, description =
|
||||
[ "Used by clients to discover homeserver information."
|
||||
]
|
||||
, init = \a _ -> { baseUrl = a }
|
||||
, init = HomeserverInformation
|
||||
}
|
||||
(Json.field.required
|
||||
{ fieldName = "base_url"
|
||||
|
@ -940,17 +928,6 @@ disoveryInformationCoderV1 =
|
|||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = L.field
|
||||
, toField = always Nothing
|
||||
, description =
|
||||
[ "The Elm SDK always expects objects to have at least two fields."
|
||||
, "Otherwise, what's the point of hiding the value in an object?"
|
||||
, "For this reason, this empty placeholder key will always be ignored."
|
||||
]
|
||||
, coder = Json.value
|
||||
}
|
||||
)
|
||||
, description =
|
||||
[ "Used by clients to discover identity server information."
|
||||
]
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
module Internal.Api.Main exposing
|
||||
( Msg
|
||||
, sendMessageEvent
|
||||
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||
)
|
||||
|
||||
{-|
|
||||
|
@ -18,7 +18,7 @@ This module is used as reference for getting
|
|||
|
||||
## Actions
|
||||
|
||||
@docs sendMessageEvent
|
||||
@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||
|
||||
-}
|
||||
|
||||
|
@ -26,6 +26,8 @@ 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.
|
||||
|
@ -34,6 +36,77 @@ 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 :
|
||||
|
@ -57,3 +130,107 @@ sendMessageEvent env data =
|
|||
}
|
||||
)
|
||||
(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)
|
||||
|
|
|
@ -13,7 +13,6 @@ This module helps send message events to rooms on the Matrix API.
|
|||
|
||||
import Internal.Api.Api as A
|
||||
import Internal.Api.Request as R
|
||||
import Internal.Config.Leaks as L
|
||||
import Internal.Config.Log exposing (log)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Tools.Json as Json
|
||||
|
@ -143,26 +142,15 @@ sendMessageEventV3 { content, eventType, roomId, transactionId } =
|
|||
|
||||
coderV1 : Json.Coder SendMessageEventOutputV1
|
||||
coderV1 =
|
||||
Json.object2
|
||||
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 = always SendMessageEventOutputV1
|
||||
, init = SendMessageEventOutputV1
|
||||
}
|
||||
(Json.field.optional.value
|
||||
{ fieldName = L.field
|
||||
, toField = always Nothing
|
||||
, description =
|
||||
[ "The Elm SDK always expects objects to have at least two fields."
|
||||
, "Otherwise, what's the point of hiding the value in an object?"
|
||||
, "For this reason, this empty placeholder key will always be ignored."
|
||||
]
|
||||
, coder = Json.value
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "event_id"
|
||||
, toField = .eventId
|
||||
|
@ -174,26 +162,15 @@ coderV1 =
|
|||
|
||||
coderV2 : Json.Coder SendMessageEventOutputV2
|
||||
coderV2 =
|
||||
Json.object2
|
||||
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 = always SendMessageEventOutputV2
|
||||
, init = SendMessageEventOutputV2
|
||||
}
|
||||
(Json.field.optional.value
|
||||
{ fieldName = L.field
|
||||
, toField = always Nothing
|
||||
, description =
|
||||
[ "The Elm SDK always expects objects to have at least two fields."
|
||||
, "Otherwise, what's the point of hiding the value in an object?"
|
||||
, "For this reason, this empty placeholder key will always be ignored."
|
||||
]
|
||||
, coder = Json.value
|
||||
}
|
||||
)
|
||||
(Json.field.required
|
||||
{ fieldName = "event_id"
|
||||
, toField = .eventId
|
||||
|
|
|
@ -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
|
@ -1,6 +1,6 @@
|
|||
module Internal.Api.Task exposing
|
||||
( Task, run, Backpack
|
||||
, sendMessageEvent
|
||||
, banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync
|
||||
)
|
||||
|
||||
{-|
|
||||
|
@ -23,22 +23,31 @@ up-to-date.
|
|||
|
||||
## Tasks
|
||||
|
||||
@docs sendMessageEvent
|
||||
@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 exposing (EnvelopeUpdate(..))
|
||||
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
|
||||
|
||||
|
@ -63,6 +72,15 @@ 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 : () }
|
||||
|
@ -111,7 +129,20 @@ getBaseUrl c =
|
|||
Nothing ->
|
||||
Internal.Api.BaseUrl.Api.baseUrl
|
||||
{ url = Context.fromApiFormat c |> .serverName }
|
||||
c
|
||||
|> 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
|
||||
|
@ -189,6 +220,31 @@ finishTask uftask =
|
|||
)
|
||||
|
||||
|
||||
{-| 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.
|
||||
-}
|
||||
|
@ -217,6 +273,42 @@ 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
|
||||
|
|
|
@ -86,6 +86,5 @@ versionsCoder =
|
|||
Set.empty
|
||||
}
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "{}"
|
||||
}
|
||||
)
|
||||
|
|
|
@ -29,7 +29,7 @@ will assume until overriden by the user.
|
|||
-}
|
||||
currentVersion : String
|
||||
currentVersion =
|
||||
"beta 3.3.0"
|
||||
"beta 3.5.0"
|
||||
|
||||
|
||||
{-| The default device name that is being communicated with the Matrix API.
|
||||
|
|
|
@ -118,12 +118,12 @@ docs :
|
|||
, event : TypeDocs
|
||||
, hashdict : TypeDocs
|
||||
, ibatch : TypeDocs
|
||||
, iddict : TypeDocs
|
||||
, itoken : TypeDocs
|
||||
, mashdict : TypeDocs
|
||||
, room : TypeDocs
|
||||
, settings : TypeDocs
|
||||
, stateManager : TypeDocs
|
||||
, strippedEvent : TypeDocs
|
||||
, timeline : TypeDocs
|
||||
, timelineFilter : TypeDocs
|
||||
, unsigned : TypeDocs
|
||||
|
@ -169,12 +169,6 @@ docs =
|
|||
[ "The internal batch tracks a patch of events on the Matrix timeline."
|
||||
]
|
||||
}
|
||||
, iddict =
|
||||
{ name = "Iddict"
|
||||
, description =
|
||||
[ "An iddict automatically handles creating appropriate keys by incrementally assiging a new key to new values."
|
||||
]
|
||||
}
|
||||
, itoken =
|
||||
{ name = "IToken"
|
||||
, description =
|
||||
|
@ -206,6 +200,12 @@ docs =
|
|||
, "Instead of making the user loop through the room's timeline of events, the StateManager offers the user a dictionary-like experience to navigate through the Matrix room state."
|
||||
]
|
||||
}
|
||||
, strippedEvent =
|
||||
{ name = "StrippedEvent"
|
||||
, description =
|
||||
[ "The StrippedEvent is a simplified Matrix event that contains no metadata."
|
||||
]
|
||||
}
|
||||
, timeline =
|
||||
{ name = "Timeline"
|
||||
, description =
|
||||
|
@ -270,6 +270,7 @@ fields :
|
|||
, baseUrl : Desc
|
||||
, deviceId : Desc
|
||||
, experimental : Desc
|
||||
, nextBatch : Desc
|
||||
, now : Desc
|
||||
, password : Desc
|
||||
, refreshToken : Desc
|
||||
|
@ -277,6 +278,7 @@ fields :
|
|||
, serverName : Desc
|
||||
, suggestedAccessToken : Desc
|
||||
, transaction : Desc
|
||||
, user : Desc
|
||||
, versions : Desc
|
||||
}
|
||||
, envelope :
|
||||
|
@ -313,6 +315,7 @@ fields :
|
|||
}
|
||||
, room :
|
||||
{ accountData : Desc
|
||||
, ephemeral : Desc
|
||||
, events : Desc
|
||||
, roomId : Desc
|
||||
, state : Desc
|
||||
|
@ -321,6 +324,7 @@ fields :
|
|||
, settings :
|
||||
{ currentVersion : Desc
|
||||
, deviceName : Desc
|
||||
, presence : Desc
|
||||
, removePasswordOnLogin : Desc
|
||||
, syncTime : Desc
|
||||
}
|
||||
|
@ -339,12 +343,14 @@ fields :
|
|||
}
|
||||
, unsigned :
|
||||
{ age : Desc
|
||||
, membership : Desc
|
||||
, prevContent : Desc
|
||||
, redactedBecause : Desc
|
||||
, transactionId : Desc
|
||||
}
|
||||
, vault :
|
||||
{ accountData : Desc
|
||||
, nextBatch : Desc
|
||||
, rooms : Desc
|
||||
, user : Desc
|
||||
}
|
||||
|
@ -379,6 +385,9 @@ fields =
|
|||
, 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."
|
||||
]
|
||||
|
@ -401,6 +410,9 @@ fields =
|
|||
, transaction =
|
||||
[ "A unique identifier for a transaction initiated by the user."
|
||||
]
|
||||
, user =
|
||||
[ "The Matrix user the Vault is representing."
|
||||
]
|
||||
, versions =
|
||||
[ "The versions of the Matrix protocol that are supported by the server."
|
||||
]
|
||||
|
@ -486,6 +498,9 @@ fields =
|
|||
, room =
|
||||
{ accountData =
|
||||
[ "Room account data tracking the user's private storage about this room." ]
|
||||
, ephemeral =
|
||||
[ "Ephemeral events that were sent recently in this room."
|
||||
]
|
||||
, events =
|
||||
[ "Database containing events that were sent in this room." ]
|
||||
, roomId =
|
||||
|
@ -502,6 +517,9 @@ fields =
|
|||
, deviceName =
|
||||
[ "Indicates the device name that is communicated to the Matrix API."
|
||||
]
|
||||
, presence =
|
||||
[ "Controls whether the client is automatically marked as online. The value is passed on to the Matrix API."
|
||||
]
|
||||
, removePasswordOnLogin =
|
||||
[ "Remove the password as soon as a valid access token has been received."
|
||||
]
|
||||
|
@ -547,6 +565,9 @@ fields =
|
|||
{ age =
|
||||
[ "The time in milliseconds that has elapsed since the event was sent. This field is generated by the local homeserver, and may be incorrect if the local time on at least one of the two servers is out of sync, which can cause the age to either be negative or greater than it actually is."
|
||||
]
|
||||
, membership =
|
||||
[ "The room membership of the user making the request, at the time of the event."
|
||||
]
|
||||
, prevContent =
|
||||
[ "The previous content for this event. This field is generated by the local homeserver, and is only returned if the event is a state event, and the client has permission to see the previous content."
|
||||
]
|
||||
|
@ -561,6 +582,9 @@ fields =
|
|||
{ 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."
|
||||
]
|
||||
|
@ -609,7 +633,8 @@ happened. Most of these unexpected results, are taken account of by the Elm SDK,
|
|||
but logged so that the programmer can do something about it.
|
||||
-}
|
||||
logs :
|
||||
{ baseUrlFound : String -> String -> String
|
||||
{ baseUrlFailed : String -> String
|
||||
, baseUrlFound : String -> String -> String
|
||||
, getEventId : String -> String
|
||||
, getNow : Int -> String
|
||||
, httpRequest : String -> String -> String
|
||||
|
@ -619,9 +644,12 @@ logs :
|
|||
, sendEvent : Maybe String -> String
|
||||
, serverReturnedInvalidJSON : String -> String
|
||||
, serverReturnedUnknownJSON : String -> String
|
||||
, syncAccountDataFound : Int -> String
|
||||
}
|
||||
logs =
|
||||
{ baseUrlFound =
|
||||
{ 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 = "
|
||||
|
@ -656,6 +684,8 @@ logs =
|
|||
"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" ]
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -183,7 +183,6 @@ coder =
|
|||
, description = Text.fields.timelineFilter.senders
|
||||
, coder = Json.set Json.string
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
)
|
||||
(Json.field.required
|
||||
|
@ -199,7 +198,6 @@ coder =
|
|||
, description = Text.fields.timelineFilter.types
|
||||
, coder = Json.set Json.string
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
)
|
||||
(Json.field.required
|
||||
|
|
|
@ -189,21 +189,20 @@ ipv6RightParser n =
|
|||
|. P.symbol ":"
|
||||
|
||||
|
||||
{-| Convert an IPv6 address to a readable string format
|
||||
-}
|
||||
ipv6ToString : IPv6Address -> String
|
||||
ipv6ToString { front, back } =
|
||||
(if List.length front == 8 then
|
||||
front
|
||||
|
||||
else if List.length back == 8 then
|
||||
back
|
||||
|
||||
else
|
||||
List.concat [ front, [ "" ], back ]
|
||||
)
|
||||
|> List.intersperse ":"
|
||||
|> String.concat
|
||||
-- {-| Convert an IPv6 address to a readable string format
|
||||
-- -}
|
||||
-- ipv6ToString : IPv6Address -> String
|
||||
-- ipv6ToString { front, back } =
|
||||
-- (if List.length front == 8 then
|
||||
-- front
|
||||
-- else if List.length back == 8 then
|
||||
-- back
|
||||
-- else
|
||||
-- List.concat [ front, [ "" ], back ]
|
||||
-- )
|
||||
-- |> List.intersperse ":"
|
||||
-- |> String.concat
|
||||
|
||||
|
||||
portParser : Parser Int
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
module Internal.Tools.DecodeExtra exposing
|
||||
( opField, opFieldWithDefault
|
||||
, map9, map10, map11
|
||||
, map9, map10, map11, map12, map13
|
||||
)
|
||||
|
||||
{-|
|
||||
|
@ -18,7 +18,7 @@ This module contains helper functions that help decode JSON.
|
|||
|
||||
## Extended map functions
|
||||
|
||||
@docs map9, map10, map11
|
||||
@docs map9, map10, map11, map12, map13
|
||||
|
||||
-}
|
||||
|
||||
|
@ -153,3 +153,68 @@ map11 func da db dc dd de df dg dh di dj dk =
|
|||
(D.map2 Tuple.pair df dg)
|
||||
(D.map2 Tuple.pair dh di)
|
||||
(D.map2 Tuple.pair dj dk)
|
||||
|
||||
|
||||
{-| Try 12 decoders and combine the result.
|
||||
-}
|
||||
map12 :
|
||||
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> value)
|
||||
-> D.Decoder a
|
||||
-> D.Decoder b
|
||||
-> D.Decoder c
|
||||
-> D.Decoder d
|
||||
-> D.Decoder e
|
||||
-> D.Decoder f
|
||||
-> D.Decoder g
|
||||
-> D.Decoder h
|
||||
-> D.Decoder i
|
||||
-> D.Decoder j
|
||||
-> D.Decoder k
|
||||
-> D.Decoder l
|
||||
-> D.Decoder value
|
||||
map12 func da db dc dd de df dg dh di dj dk dl =
|
||||
D.map8
|
||||
(\a b c d ( e, f ) ( g, h ) ( i, j ) ( k, l ) ->
|
||||
func a b c d e f g h i j k l
|
||||
)
|
||||
da
|
||||
db
|
||||
dc
|
||||
dd
|
||||
(D.map2 Tuple.pair de df)
|
||||
(D.map2 Tuple.pair dg dh)
|
||||
(D.map2 Tuple.pair di dj)
|
||||
(D.map2 Tuple.pair dk dl)
|
||||
|
||||
|
||||
{-| Try 12 decoders and combine the result.
|
||||
-}
|
||||
map13 :
|
||||
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> value)
|
||||
-> D.Decoder a
|
||||
-> D.Decoder b
|
||||
-> D.Decoder c
|
||||
-> D.Decoder d
|
||||
-> D.Decoder e
|
||||
-> D.Decoder f
|
||||
-> D.Decoder g
|
||||
-> D.Decoder h
|
||||
-> D.Decoder i
|
||||
-> D.Decoder j
|
||||
-> D.Decoder k
|
||||
-> D.Decoder l
|
||||
-> D.Decoder m
|
||||
-> D.Decoder value
|
||||
map13 func da db dc dd de df dg dh di dj dk dl dm =
|
||||
D.map8
|
||||
(\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) ->
|
||||
func a b c d e f g h i j k l m
|
||||
)
|
||||
da
|
||||
db
|
||||
dc
|
||||
(D.map2 Tuple.pair dd de)
|
||||
(D.map2 Tuple.pair df dg)
|
||||
(D.map2 Tuple.pair dh di)
|
||||
(D.map2 Tuple.pair dj dk)
|
||||
(D.map2 Tuple.pair dl dm)
|
||||
|
|
|
@ -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
|
||||
( Coder, string, bool, int, float, value
|
||||
( Coder, string, bool, int, float, value, unit
|
||||
, Encoder, encode, Decoder, decode, Value
|
||||
, succeed, fail, andThen, lazy, map
|
||||
, Docs(..), RequiredField(..), toDocs
|
||||
, list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe
|
||||
, list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
|
||||
, Field, field, parser
|
||||
, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
|
||||
, object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
|
||||
)
|
||||
|
||||
{-|
|
||||
|
@ -29,7 +29,7 @@ data types. Because this module uses dynamic builder types, this also means it
|
|||
is relatively easy to write documentation for any data type that uses this
|
||||
module to build its encoders and decoders.
|
||||
|
||||
@docs Coder, string, bool, int, float, value
|
||||
@docs Coder, string, bool, int, float, value, unit
|
||||
|
||||
|
||||
## JSON Coding
|
||||
|
@ -49,7 +49,7 @@ module to build its encoders and decoders.
|
|||
|
||||
## Data types
|
||||
|
||||
@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, maybe
|
||||
@docs list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe
|
||||
|
||||
|
||||
## Objects
|
||||
|
@ -62,12 +62,13 @@ first.
|
|||
|
||||
Once all fields are constructed, the user can create JSON objects.
|
||||
|
||||
@docs object2, object3, object4, object5, object6, object7, object8, object9, object10, object11
|
||||
@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13
|
||||
|
||||
-}
|
||||
|
||||
import Dict as SlowDict
|
||||
import FastDict
|
||||
import Iddict exposing (Iddict)
|
||||
import Internal.Config.Log as Log exposing (Log)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Tools.DecodeExtra as D
|
||||
|
@ -141,6 +142,7 @@ type Docs
|
|||
= DocsBool
|
||||
| DocsDict Docs
|
||||
| DocsFloat
|
||||
| DocsIddict Docs
|
||||
| DocsInt
|
||||
| DocsIntDict Docs
|
||||
| DocsLazy (() -> Docs)
|
||||
|
@ -163,6 +165,7 @@ type Docs
|
|||
| DocsRiskyMap (Descriptive { content : Docs, failure : List String })
|
||||
| DocsSet Docs
|
||||
| DocsString
|
||||
| DocsUnit
|
||||
| DocsValue
|
||||
|
||||
|
||||
|
@ -362,7 +365,7 @@ then the following field type would be used:
|
|||
, coder = string
|
||||
}
|
||||
|
||||
Suppose the JSO isn't obligated to provide a list of hobbies, and the list would
|
||||
Suppose the JSON isn't obligated to provide a list of hobbies, and the list would
|
||||
by default be overriden with an empty list, then we would use the following
|
||||
field type:
|
||||
|
||||
|
@ -373,8 +376,7 @@ field type:
|
|||
[ "The hobbies of the person. Can be omitted."
|
||||
]
|
||||
, coder = list string
|
||||
, default = ( [], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default
|
||||
, defaultToString = always "[]" -- Default converted to a string
|
||||
, default = ( [ "football" ], [] ) -- The `List Log` can be inserted in case you wish to insert a message when relying on a default
|
||||
}
|
||||
|
||||
-}
|
||||
|
@ -382,7 +384,7 @@ field :
|
|||
{ required : { fieldName : String, toField : object -> a, description : List String, coder : Coder a } -> Field a object
|
||||
, optional :
|
||||
{ value : { fieldName : String, toField : object -> Maybe a, description : List String, coder : Coder a } -> Field (Maybe a) object
|
||||
, withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ), defaultToString : a -> String } -> Field a object
|
||||
, withDefault : { fieldName : String, toField : object -> a, description : List String, coder : Coder a, default : ( a, List Log ) } -> Field a object
|
||||
}
|
||||
}
|
||||
field =
|
||||
|
@ -425,7 +427,7 @@ field =
|
|||
, requiredness = OptionalField
|
||||
}
|
||||
, withDefault =
|
||||
\{ fieldName, toField, description, coder, default, defaultToString } ->
|
||||
\{ fieldName, toField, description, coder, default } ->
|
||||
case coder of
|
||||
Coder { encoder, decoder, docs } ->
|
||||
Field
|
||||
|
@ -449,7 +451,8 @@ field =
|
|||
, requiredness =
|
||||
default
|
||||
|> Tuple.first
|
||||
|> defaultToString
|
||||
|> encoder
|
||||
|> E.encode 0
|
||||
|> OptionalFieldWithDefault
|
||||
}
|
||||
}
|
||||
|
@ -467,6 +470,26 @@ float =
|
|||
}
|
||||
|
||||
|
||||
{-| Define an Iddict as defined in
|
||||
[noordstar/elm-iddict](https://package.elm-lang.org/packages/noordstar/elm-iddict/latest/).
|
||||
-}
|
||||
iddict : Coder a -> Coder (Iddict a)
|
||||
iddict (Coder old) =
|
||||
Coder
|
||||
{ encoder = Iddict.encode old.encoder
|
||||
, decoder =
|
||||
Iddict.decoder old.decoder
|
||||
|> D.map
|
||||
(\out ->
|
||||
( Iddict.map (always Tuple.first) out
|
||||
, Iddict.values out
|
||||
|> List.concatMap Tuple.second
|
||||
)
|
||||
)
|
||||
, docs = DocsIddict old.docs
|
||||
}
|
||||
|
||||
|
||||
{-| Define an int value.
|
||||
-}
|
||||
int : Coder Int
|
||||
|
@ -596,6 +619,23 @@ objectEncoder items object =
|
|||
|> E.maybeObject
|
||||
|
||||
|
||||
object1 :
|
||||
Descriptive { init : a -> object }
|
||||
-> Field a object
|
||||
-> Coder object
|
||||
object1 { name, description, init } fa =
|
||||
Coder
|
||||
{ encoder = objectEncoder [ toEncodeField fa ]
|
||||
, decoder = D.map (Tuple.mapFirst init) (toDecoderField fa)
|
||||
, docs =
|
||||
DocsObject
|
||||
{ name = name
|
||||
, description = description
|
||||
, keys = [ toDocsField fa ]
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
{-| Define an object with 2 keys
|
||||
|
||||
type alias Human =
|
||||
|
@ -1158,6 +1198,160 @@ object11 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk =
|
|||
}
|
||||
|
||||
|
||||
{-| Define an object with 12 keys
|
||||
-}
|
||||
object12 :
|
||||
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> object }
|
||||
-> Field a object
|
||||
-> Field b object
|
||||
-> Field c object
|
||||
-> Field d object
|
||||
-> Field e object
|
||||
-> Field f object
|
||||
-> Field g object
|
||||
-> Field h object
|
||||
-> Field i object
|
||||
-> Field j object
|
||||
-> Field k object
|
||||
-> Field l object
|
||||
-> Coder object
|
||||
object12 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl =
|
||||
Coder
|
||||
{ encoder =
|
||||
objectEncoder
|
||||
[ toEncodeField fa
|
||||
, toEncodeField fb
|
||||
, toEncodeField fc
|
||||
, toEncodeField fd
|
||||
, toEncodeField fe
|
||||
, toEncodeField ff
|
||||
, toEncodeField fg
|
||||
, toEncodeField fh
|
||||
, toEncodeField fi
|
||||
, toEncodeField fj
|
||||
, toEncodeField fk
|
||||
, toEncodeField fl
|
||||
]
|
||||
, decoder =
|
||||
D.map12
|
||||
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ->
|
||||
( init a b c d e f g h i j k l
|
||||
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll ]
|
||||
)
|
||||
)
|
||||
(toDecoderField fa)
|
||||
(toDecoderField fb)
|
||||
(toDecoderField fc)
|
||||
(toDecoderField fd)
|
||||
(toDecoderField fe)
|
||||
(toDecoderField ff)
|
||||
(toDecoderField fg)
|
||||
(toDecoderField fh)
|
||||
(toDecoderField fi)
|
||||
(toDecoderField fj)
|
||||
(toDecoderField fk)
|
||||
(toDecoderField fl)
|
||||
, docs =
|
||||
DocsObject
|
||||
{ name = name
|
||||
, description = description
|
||||
, keys =
|
||||
[ toDocsField fa
|
||||
, toDocsField fb
|
||||
, toDocsField fc
|
||||
, toDocsField fd
|
||||
, toDocsField fe
|
||||
, toDocsField ff
|
||||
, toDocsField fg
|
||||
, toDocsField fh
|
||||
, toDocsField fi
|
||||
, toDocsField fj
|
||||
, toDocsField fk
|
||||
, toDocsField fl
|
||||
]
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
{-| Define an object with 13 keys
|
||||
-}
|
||||
object13 :
|
||||
Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> object }
|
||||
-> Field a object
|
||||
-> Field b object
|
||||
-> Field c object
|
||||
-> Field d object
|
||||
-> Field e object
|
||||
-> Field f object
|
||||
-> Field g object
|
||||
-> Field h object
|
||||
-> Field i object
|
||||
-> Field j object
|
||||
-> Field k object
|
||||
-> Field l object
|
||||
-> Field m object
|
||||
-> Coder object
|
||||
object13 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl fm =
|
||||
Coder
|
||||
{ encoder =
|
||||
objectEncoder
|
||||
[ toEncodeField fa
|
||||
, toEncodeField fb
|
||||
, toEncodeField fc
|
||||
, toEncodeField fd
|
||||
, toEncodeField fe
|
||||
, toEncodeField ff
|
||||
, toEncodeField fg
|
||||
, toEncodeField fh
|
||||
, toEncodeField fi
|
||||
, toEncodeField fj
|
||||
, toEncodeField fk
|
||||
, toEncodeField fl
|
||||
, toEncodeField fm
|
||||
]
|
||||
, decoder =
|
||||
D.map13
|
||||
(\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ( m, lm ) ->
|
||||
( init a b c d e f g h i j k l m
|
||||
, List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll, lm ]
|
||||
)
|
||||
)
|
||||
(toDecoderField fa)
|
||||
(toDecoderField fb)
|
||||
(toDecoderField fc)
|
||||
(toDecoderField fd)
|
||||
(toDecoderField fe)
|
||||
(toDecoderField ff)
|
||||
(toDecoderField fg)
|
||||
(toDecoderField fh)
|
||||
(toDecoderField fi)
|
||||
(toDecoderField fj)
|
||||
(toDecoderField fk)
|
||||
(toDecoderField fl)
|
||||
(toDecoderField fm)
|
||||
, docs =
|
||||
DocsObject
|
||||
{ name = name
|
||||
, description = description
|
||||
, keys =
|
||||
[ toDocsField fa
|
||||
, toDocsField fb
|
||||
, toDocsField fc
|
||||
, toDocsField fd
|
||||
, toDocsField fe
|
||||
, toDocsField ff
|
||||
, toDocsField fg
|
||||
, toDocsField fh
|
||||
, toDocsField fi
|
||||
, toDocsField fj
|
||||
, toDocsField fk
|
||||
, toDocsField fl
|
||||
, toDocsField fm
|
||||
]
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
{-| Define a parser that converts a string into a custom Elm type.
|
||||
-}
|
||||
parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a
|
||||
|
@ -1269,6 +1463,18 @@ toEncodeField (Field data) =
|
|||
( data.fieldName, data.toField >> data.encoder )
|
||||
|
||||
|
||||
{-| Completely ignore whatever needs to be encoded, and simply return a unit
|
||||
value.
|
||||
-}
|
||||
unit : Coder ()
|
||||
unit =
|
||||
Coder
|
||||
{ encoder = \() -> E.object []
|
||||
, decoder = D.succeed ( (), [] )
|
||||
, docs = DocsUnit
|
||||
}
|
||||
|
||||
|
||||
{-| Do not do anything useful with a JSON value, just bring it to Elm as a
|
||||
JavaScript value.
|
||||
-}
|
||||
|
|
|
@ -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 }
|
|
@ -71,7 +71,7 @@ import Internal.Config.Text as Text
|
|||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||
import Internal.Tools.Json as Json
|
||||
import Internal.Tools.Timestamp as Timestamp exposing (Timestamp)
|
||||
import Json.Encode as E
|
||||
import Internal.Values.User as User exposing (User)
|
||||
import Set exposing (Set)
|
||||
import Time
|
||||
|
||||
|
@ -95,12 +95,14 @@ type alias Context =
|
|||
{ accessTokens : Hashdict AccessToken
|
||||
, baseUrl : Maybe String
|
||||
, deviceId : Maybe String
|
||||
, nextBatch : Maybe String
|
||||
, now : Maybe Timestamp
|
||||
, password : Maybe String
|
||||
, refreshToken : Maybe String
|
||||
, serverName : String
|
||||
, suggestedAccessToken : Maybe String
|
||||
, transaction : Maybe String
|
||||
, user : Maybe User
|
||||
, username : Maybe String
|
||||
, versions : Maybe Versions
|
||||
}
|
||||
|
@ -152,7 +154,7 @@ fromApiFormat (APIContext c) =
|
|||
-}
|
||||
coder : Json.Coder Context
|
||||
coder =
|
||||
Json.object11
|
||||
Json.object13
|
||||
{ name = Text.docs.context.name
|
||||
, description = Text.docs.context.description
|
||||
, init = Context
|
||||
|
@ -178,6 +180,13 @@ coder =
|
|||
, 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
|
||||
|
@ -220,6 +229,13 @@ coder =
|
|||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "user"
|
||||
, toField = .user
|
||||
, description = Text.fields.context.user
|
||||
, coder = User.coder
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "username"
|
||||
, toField = .username
|
||||
|
@ -298,17 +314,19 @@ encode =
|
|||
|
||||
{-| A basic, untouched version of the Context, containing no information.
|
||||
-}
|
||||
init : String -> Context
|
||||
init sn =
|
||||
init : String -> Maybe User -> Context
|
||||
init sn mu =
|
||||
{ accessTokens = Hashdict.empty .value
|
||||
, baseUrl = Nothing
|
||||
, deviceId = Nothing
|
||||
, nextBatch = Nothing
|
||||
, now = Nothing
|
||||
, refreshToken = Nothing
|
||||
, password = Nothing
|
||||
, serverName = sn
|
||||
, suggestedAccessToken = Nothing
|
||||
, transaction = Nothing
|
||||
, user = mu
|
||||
, username = Nothing
|
||||
, versions = Nothing
|
||||
}
|
||||
|
@ -439,6 +457,5 @@ versionsCoder =
|
|||
, description = Text.fields.versions.unstableFeatures
|
||||
, coder = Json.set Json.string
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = Json.encode (Json.set Json.string) >> E.encode 0
|
||||
}
|
||||
)
|
||||
|
|
|
@ -56,6 +56,9 @@ import Internal.Tools.Json as Json
|
|||
import Internal.Tools.Timestamp exposing (Timestamp)
|
||||
import Internal.Values.Context as Context exposing (AccessToken, Context, Versions)
|
||||
import Internal.Values.Settings as Settings
|
||||
import Internal.Values.User exposing (User)
|
||||
import Recursion
|
||||
import Recursion.Fold
|
||||
|
||||
|
||||
{-| There are lots of different data types in the Elm SDK, and many of them
|
||||
|
@ -82,8 +85,10 @@ type EnvelopeUpdate a
|
|||
| SetAccessToken AccessToken
|
||||
| SetBaseUrl String
|
||||
| SetDeviceId String
|
||||
| SetNextBatch String
|
||||
| SetNow Timestamp
|
||||
| SetRefreshToken String
|
||||
| SetUser User
|
||||
| SetVersions Versions
|
||||
|
||||
|
||||
|
@ -124,7 +129,6 @@ coder c1 =
|
|||
, description = Text.fields.envelope.settings
|
||||
, coder = Settings.coder
|
||||
, default = Tuple.pair Settings.init []
|
||||
, defaultToString = always "<Default settings>"
|
||||
}
|
||||
)
|
||||
|
||||
|
@ -186,10 +190,10 @@ getContent =
|
|||
{-| Create a new enveloped data type. All settings are set to default values
|
||||
from the [Internal.Config.Default](Internal-Config-Default) module.
|
||||
-}
|
||||
init : { serverName : String, content : a } -> Envelope a
|
||||
init : { content : a, serverName : String, user : Maybe User } -> Envelope a
|
||||
init data =
|
||||
{ content = data.content
|
||||
, context = Context.init data.serverName
|
||||
, context = Context.init data.serverName data.user
|
||||
, settings = Settings.init
|
||||
}
|
||||
|
||||
|
@ -292,47 +296,97 @@ toMaybe data =
|
|||
{-| Updates the Envelope with a given EnvelopeUpdate value.
|
||||
-}
|
||||
update : (au -> a -> a) -> EnvelopeUpdate au -> Envelope a -> Envelope a
|
||||
update updateContent eu ({ context } as data) =
|
||||
case eu of
|
||||
update updateContent eu startData =
|
||||
Recursion.runRecursion
|
||||
(\updt ->
|
||||
case updt of
|
||||
ContentUpdate v ->
|
||||
Recursion.base
|
||||
(\data ->
|
||||
{ data | content = updateContent v data.content }
|
||||
)
|
||||
|
||||
HttpRequest _ ->
|
||||
data
|
||||
Recursion.base identity
|
||||
|
||||
More items ->
|
||||
List.foldl (update updateContent) data items
|
||||
Recursion.Fold.foldList (<<) identity items
|
||||
|
||||
Optional (Just u) ->
|
||||
update updateContent u data
|
||||
Recursion.recurse u
|
||||
|
||||
Optional Nothing ->
|
||||
data
|
||||
Recursion.base identity
|
||||
|
||||
RemoveAccessToken token ->
|
||||
{ data | context = { context | accessTokens = Hashdict.removeKey token context.accessTokens } }
|
||||
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
|
||||
= UnsignedData
|
||||
{ age : Maybe Int
|
||||
, membership : Maybe String
|
||||
, prevContent : Maybe Json.Value
|
||||
, redactedBecause : Maybe Event
|
||||
, transactionId : Maybe String
|
||||
|
@ -242,10 +243,10 @@ transactionId event =
|
|||
|
||||
unsignedCoder : Json.Coder UnsignedData
|
||||
unsignedCoder =
|
||||
Json.object4
|
||||
Json.object5
|
||||
{ name = Text.docs.unsigned.name
|
||||
, description = Text.docs.unsigned.description
|
||||
, init = \a b c d -> UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d }
|
||||
, init = \a b c d e -> UnsignedData { age = a, membership = b, prevContent = c, redactedBecause = d, transactionId = e }
|
||||
}
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "age"
|
||||
|
@ -254,6 +255,13 @@ unsignedCoder =
|
|||
, coder = Json.int
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "membership"
|
||||
, toField = \(UnsignedData data) -> data.membership
|
||||
, description = Text.fields.unsigned.membership
|
||||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "prevContent"
|
||||
, toField = \(UnsignedData data) -> data.prevContent
|
||||
|
|
|
@ -53,11 +53,13 @@ import Internal.Config.Text as Text
|
|||
import Internal.Filter.Timeline as Filter exposing (Filter)
|
||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||
import Internal.Tools.Json as Json
|
||||
import Internal.Tools.StrippedEvent as StrippedEvent exposing (StrippedEvent)
|
||||
import Internal.Values.Event as Event exposing (Event)
|
||||
import Internal.Values.StateManager as StateManager exposing (StateManager)
|
||||
import Internal.Values.Timeline as Timeline exposing (Timeline)
|
||||
import Internal.Values.User exposing (User)
|
||||
import Json.Encode as E
|
||||
import Recursion
|
||||
import Recursion.Fold
|
||||
|
||||
|
||||
{-| The Batch is a group of new events from somewhere in the timeline.
|
||||
|
@ -71,6 +73,7 @@ homeserver.
|
|||
-}
|
||||
type alias Room =
|
||||
{ accountData : Dict String Json.Value
|
||||
, ephemeral : List StrippedEvent
|
||||
, events : Hashdict Event
|
||||
, roomId : String
|
||||
, state : StateManager
|
||||
|
@ -86,7 +89,9 @@ type RoomUpdate
|
|||
| 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.
|
||||
|
@ -140,7 +145,7 @@ addSync =
|
|||
-}
|
||||
coder : Json.Coder Room
|
||||
coder =
|
||||
Json.object5
|
||||
Json.object6
|
||||
{ name = Text.docs.room.name
|
||||
, description = Text.docs.room.description
|
||||
, init = Room
|
||||
|
@ -151,7 +156,14 @@ coder =
|
|||
, description = Text.fields.room.accountData
|
||||
, coder = Json.fastDict Json.value
|
||||
, default = ( Dict.empty, [] )
|
||||
, defaultToString = Json.encode (Json.fastDict Json.value) >> E.encode 0
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
{ fieldName = "ephemeral"
|
||||
, toField = .ephemeral
|
||||
, description = Text.fields.room.ephemeral
|
||||
, coder = Json.list StrippedEvent.coder
|
||||
, default = ( [], [] )
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -160,7 +172,6 @@ coder =
|
|||
, description = Text.fields.room.events
|
||||
, coder = Hashdict.coder .eventId Event.coder
|
||||
, default = ( Hashdict.empty .eventId, [ log.warn "Found a room with no known events! Is it empty?" ] )
|
||||
, defaultToString = Json.encode (Hashdict.coder .eventId Event.coder) >> E.encode 0
|
||||
}
|
||||
)
|
||||
(Json.field.required
|
||||
|
@ -176,7 +187,6 @@ coder =
|
|||
, description = Text.fields.room.state
|
||||
, coder = StateManager.coder
|
||||
, default = ( StateManager.empty, [] )
|
||||
, defaultToString = Json.encode StateManager.coder >> E.encode 0
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -185,7 +195,6 @@ coder =
|
|||
, description = Text.fields.room.timeline
|
||||
, coder = Timeline.coder
|
||||
, default = ( Timeline.empty, [] )
|
||||
, defaultToString = Json.encode Timeline.coder >> E.encode 0
|
||||
}
|
||||
)
|
||||
|
||||
|
@ -216,6 +225,7 @@ getAccountData key room =
|
|||
init : String -> Room
|
||||
init roomId =
|
||||
{ accountData = Dict.empty
|
||||
, ephemeral = []
|
||||
, events = Hashdict.empty .eventId
|
||||
, roomId = roomId
|
||||
, state = StateManager.empty
|
||||
|
@ -246,21 +256,35 @@ setAccountData key value room =
|
|||
{-| Update the Room based on given instructions.
|
||||
-}
|
||||
update : RoomUpdate -> Room -> Room
|
||||
update ru room =
|
||||
update roomUpdate startRoom =
|
||||
Recursion.runRecursion
|
||||
(\ru ->
|
||||
case ru of
|
||||
AddEvent _ ->
|
||||
-- TODO: Add event
|
||||
room
|
||||
Recursion.base identity
|
||||
|
||||
AddSync batch ->
|
||||
addSync batch room
|
||||
Recursion.base (addSync batch)
|
||||
|
||||
Invite _ ->
|
||||
-- TODO: Invite user
|
||||
room
|
||||
Recursion.base identity
|
||||
|
||||
More items ->
|
||||
List.foldl update room items
|
||||
Recursion.Fold.foldList (<<) identity items
|
||||
|
||||
Optional (Just u) ->
|
||||
Recursion.recurse u
|
||||
|
||||
Optional Nothing ->
|
||||
Recursion.base identity
|
||||
|
||||
SetAccountData key value ->
|
||||
setAccountData key value room
|
||||
Recursion.base (setAccountData key value)
|
||||
|
||||
SetEphemeral eph ->
|
||||
Recursion.base (\room -> { room | ephemeral = eph })
|
||||
)
|
||||
roomUpdate
|
||||
startRoom
|
||||
|
|
|
@ -35,6 +35,7 @@ behave under the user's preferred settings.
|
|||
type alias Settings =
|
||||
{ currentVersion : String
|
||||
, deviceName : String
|
||||
, presence : Maybe String
|
||||
, removePasswordOnLogin : Bool
|
||||
, syncTime : Int
|
||||
}
|
||||
|
@ -44,7 +45,7 @@ type alias Settings =
|
|||
-}
|
||||
coder : Json.Coder Settings
|
||||
coder =
|
||||
Json.object4
|
||||
Json.object5
|
||||
{ name = Text.docs.settings.name
|
||||
, description = Text.docs.settings.description
|
||||
, init = Settings
|
||||
|
@ -55,7 +56,6 @@ coder =
|
|||
, description = Text.fields.settings.currentVersion
|
||||
, coder = Json.string
|
||||
, default = Tuple.pair Default.currentVersion []
|
||||
, defaultToString = identity
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -64,7 +64,13 @@ coder =
|
|||
, description = Text.fields.settings.deviceName
|
||||
, coder = Json.string
|
||||
, default = Tuple.pair Default.deviceName []
|
||||
, defaultToString = identity
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "presence"
|
||||
, toField = .presence
|
||||
, description = Text.fields.settings.presence
|
||||
, coder = Json.string
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -73,13 +79,6 @@ coder =
|
|||
, description = Text.fields.settings.removePasswordOnLogin
|
||||
, coder = Json.bool
|
||||
, default = Tuple.pair Default.removePasswordOnLogin []
|
||||
, defaultToString =
|
||||
\b ->
|
||||
if b then
|
||||
"true"
|
||||
|
||||
else
|
||||
"false"
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -88,7 +87,6 @@ coder =
|
|||
, description = Text.fields.settings.syncTime
|
||||
, coder = Json.int
|
||||
, default = Tuple.pair Default.syncTime []
|
||||
, defaultToString = String.fromInt
|
||||
}
|
||||
)
|
||||
|
||||
|
@ -113,6 +111,7 @@ init : Settings
|
|||
init =
|
||||
{ currentVersion = Default.currentVersion
|
||||
, deviceName = Default.deviceName
|
||||
, presence = Nothing
|
||||
, removePasswordOnLogin = Default.removePasswordOnLogin
|
||||
, syncTime = Default.syncTime
|
||||
}
|
||||
|
|
|
@ -67,10 +67,10 @@ events!
|
|||
-}
|
||||
|
||||
import FastDict as Dict exposing (Dict)
|
||||
import Iddict exposing (Iddict)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Filter.Timeline as Filter exposing (Filter)
|
||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||
import Internal.Tools.Iddict as Iddict exposing (Iddict)
|
||||
import Internal.Tools.Json as Json
|
||||
import Recursion
|
||||
import Recursion.Traverse
|
||||
|
@ -210,7 +210,7 @@ coder =
|
|||
{ fieldName = "batches"
|
||||
, toField = \(Timeline t) -> t.batches
|
||||
, description = Text.fields.timeline.batches
|
||||
, coder = Iddict.coder coderIBatch
|
||||
, coder = Json.iddict coderIBatch
|
||||
}
|
||||
)
|
||||
(Json.field.required
|
||||
|
@ -226,7 +226,6 @@ coder =
|
|||
, description = Text.fields.timeline.filledBatches
|
||||
, coder = Json.int
|
||||
, default = ( 0, [] )
|
||||
, defaultToString = String.fromInt
|
||||
}
|
||||
)
|
||||
(Json.field.required
|
||||
|
@ -326,7 +325,6 @@ coderIToken =
|
|||
, description = Text.fields.itoken.starts
|
||||
, coder = Json.set coderIBatchPTRValue
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -335,7 +333,6 @@ coderIToken =
|
|||
, description = Text.fields.itoken.ends
|
||||
, coder = Json.set coderIBatchPTRValue
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -344,7 +341,6 @@ coderIToken =
|
|||
, description = Text.fields.itoken.inFrontOf
|
||||
, coder = Json.set coderITokenPTRValue
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
)
|
||||
(Json.field.optional.withDefault
|
||||
|
@ -353,7 +349,6 @@ coderIToken =
|
|||
, description = Text.fields.itoken.behind
|
||||
, coder = Json.set coderITokenPTRValue
|
||||
, default = ( Set.empty, [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
)
|
||||
|
||||
|
@ -411,8 +406,8 @@ connectIBatchToIToken (IBatchPTR bptr) pointer (Timeline tl) =
|
|||
Timeline
|
||||
{ tl
|
||||
| batches =
|
||||
Iddict.map bptr
|
||||
(\batch -> { batch | end = pointer })
|
||||
Iddict.update bptr
|
||||
(Maybe.map (\batch -> { batch | end = pointer }))
|
||||
tl.batches
|
||||
, tokens =
|
||||
Hashdict.map tptr
|
||||
|
@ -437,8 +432,8 @@ connectITokenToIBatch pointer (IBatchPTR bptr) (Timeline tl) =
|
|||
(\token -> { token | starts = Set.insert bptr token.starts })
|
||||
tl.tokens
|
||||
, batches =
|
||||
Iddict.map bptr
|
||||
(\batch -> { batch | start = pointer })
|
||||
Iddict.update bptr
|
||||
(Maybe.map (\batch -> { batch | start = pointer }))
|
||||
tl.batches
|
||||
}
|
||||
|
||||
|
@ -683,20 +678,21 @@ mostRecentFrom filter timeline ptr =
|
|||
{ ptr = ptr, visited = Set.empty }
|
||||
|
||||
|
||||
{-| Recount the Timeline's amount of filled batches. Since the Timeline
|
||||
automatically tracks the count on itself, this is generally exclusively used in
|
||||
specific scenarios like decoding JSON values.
|
||||
-}
|
||||
recountFilledBatches : Timeline -> Timeline
|
||||
recountFilledBatches (Timeline tl) =
|
||||
Timeline
|
||||
{ tl
|
||||
| filledBatches =
|
||||
tl.batches
|
||||
|> Iddict.values
|
||||
|> List.filter (\v -> v.events /= [])
|
||||
|> List.length
|
||||
}
|
||||
|
||||
-- {-| Recount the Timeline's amount of filled batches. Since the Timeline
|
||||
-- automatically tracks the count on itself, this is generally exclusively used in
|
||||
-- specific scenarios like decoding JSON values.
|
||||
-- -}
|
||||
-- recountFilledBatches : Timeline -> Timeline
|
||||
-- recountFilledBatches (Timeline tl) =
|
||||
-- Timeline
|
||||
-- { tl
|
||||
-- | filledBatches =
|
||||
-- tl.batches
|
||||
-- |> Iddict.values
|
||||
-- |> List.filter (\v -> v.events /= [])
|
||||
-- |> List.length
|
||||
-- }
|
||||
|
||||
|
||||
{-| Create a timeline with a single batch inserted. This batch is considered the
|
||||
|
|
|
@ -1,8 +1,9 @@
|
|||
module Internal.Values.Vault exposing
|
||||
( Vault, init
|
||||
, VaultUpdate(..), update
|
||||
, fromRoomId, mapRoom, updateRoom
|
||||
, rooms, fromRoomId, mapRoom, updateRoom
|
||||
, getAccountData, setAccountData
|
||||
, coder
|
||||
)
|
||||
|
||||
{-| This module hosts the Vault module. The Vault is the data type storing all
|
||||
|
@ -23,13 +24,18 @@ To update the Vault, one uses VaultUpdate types.
|
|||
|
||||
Rooms are environments where people can have a conversation with each other.
|
||||
|
||||
@docs fromRoomId, mapRoom, updateRoom
|
||||
@docs rooms, fromRoomId, mapRoom, updateRoom
|
||||
|
||||
|
||||
## Account data
|
||||
|
||||
@docs getAccountData, setAccountData
|
||||
|
||||
|
||||
## JSON
|
||||
|
||||
@docs coder
|
||||
|
||||
-}
|
||||
|
||||
import FastDict as Dict exposing (Dict)
|
||||
|
@ -38,14 +44,16 @@ import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
|||
import Internal.Tools.Json as Json
|
||||
import Internal.Values.Room as Room exposing (Room)
|
||||
import Internal.Values.User as User exposing (User)
|
||||
import Recursion
|
||||
import Recursion.Fold
|
||||
|
||||
|
||||
{-| This is the Vault type.
|
||||
-}
|
||||
type alias Vault =
|
||||
{ accountData : Dict String Json.Value
|
||||
, nextBatch : Maybe String
|
||||
, rooms : Hashdict Room
|
||||
, user : Maybe User
|
||||
}
|
||||
|
||||
|
||||
|
@ -56,10 +64,13 @@ type VaultUpdate
|
|||
= CreateRoomIfNotExists String
|
||||
| MapRoom String Room.RoomUpdate
|
||||
| More (List VaultUpdate)
|
||||
| Optional (Maybe VaultUpdate)
|
||||
| SetAccountData String Json.Value
|
||||
| SetUser User
|
||||
| SetNextBatch String
|
||||
|
||||
|
||||
{-| Convert a Vault to and from a JSON object.
|
||||
-}
|
||||
coder : Json.Coder Vault
|
||||
coder =
|
||||
Json.object3
|
||||
|
@ -74,6 +85,13 @@ coder =
|
|||
, 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
|
||||
|
@ -81,13 +99,6 @@ coder =
|
|||
, coder = Hashdict.coder .roomId Room.coder
|
||||
}
|
||||
)
|
||||
(Json.field.optional.value
|
||||
{ fieldName = "user"
|
||||
, toField = .user
|
||||
, description = Text.fields.vault.user
|
||||
, coder = User.coder
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
{-| Get a given room by its room id.
|
||||
|
@ -106,11 +117,11 @@ getAccountData key vault =
|
|||
|
||||
{-| Initiate a new Vault type.
|
||||
-}
|
||||
init : Maybe User -> Vault
|
||||
init mUser =
|
||||
init : Vault
|
||||
init =
|
||||
{ accountData = Dict.empty
|
||||
, nextBatch = Nothing
|
||||
, rooms = Hashdict.empty .roomId
|
||||
, user = mUser
|
||||
}
|
||||
|
||||
|
||||
|
@ -122,6 +133,13 @@ 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
|
||||
|
@ -139,21 +157,35 @@ updateRoom roomId f vault =
|
|||
{-| Update the Vault using a VaultUpdate type.
|
||||
-}
|
||||
update : VaultUpdate -> Vault -> Vault
|
||||
update vu vault =
|
||||
update vaultUpdate startVault =
|
||||
Recursion.runRecursion
|
||||
(\vu ->
|
||||
case vu of
|
||||
CreateRoomIfNotExists roomId ->
|
||||
updateRoom roomId
|
||||
(Maybe.withDefault (Room.init roomId) >> Maybe.Just)
|
||||
vault
|
||||
|> updateRoom roomId
|
||||
|> Recursion.base
|
||||
|
||||
MapRoom roomId ru ->
|
||||
mapRoom roomId (Room.update ru) vault
|
||||
Recursion.base (mapRoom roomId (Room.update ru))
|
||||
|
||||
More items ->
|
||||
List.foldl update vault items
|
||||
Recursion.Fold.foldList (<<) identity items
|
||||
|
||||
Optional (Just u) ->
|
||||
Recursion.recurse u
|
||||
|
||||
Optional Nothing ->
|
||||
Recursion.base identity
|
||||
|
||||
SetAccountData key value ->
|
||||
setAccountData key value vault
|
||||
Recursion.base (setAccountData key value)
|
||||
|
||||
SetUser user ->
|
||||
{ vault | user = Just user }
|
||||
SetNextBatch nb ->
|
||||
Recursion.base
|
||||
(\vault ->
|
||||
{ vault | nextBatch = Just nb }
|
||||
)
|
||||
)
|
||||
vaultUpdate
|
||||
startVault
|
||||
|
|
113
src/Matrix.elm
113
src/Matrix.elm
|
@ -1,6 +1,8 @@
|
|||
module Matrix exposing
|
||||
( Vault, fromUserId, fromUsername
|
||||
, VaultUpdate, update
|
||||
, VaultUpdate, update, sync, logs
|
||||
, rooms, fromRoomId
|
||||
, getAccountData, setAccountData
|
||||
, addAccessToken, sendMessageEvent
|
||||
)
|
||||
|
||||
|
@ -24,7 +26,17 @@ support a monolithic public registry. (:
|
|||
|
||||
## Keeping the Vault up-to-date
|
||||
|
||||
@docs VaultUpdate, update
|
||||
@docs VaultUpdate, update, sync, logs
|
||||
|
||||
|
||||
## Exploring the Vault
|
||||
|
||||
@docs rooms, fromRoomId
|
||||
|
||||
|
||||
## Account data
|
||||
|
||||
@docs getAccountData, setAccountData
|
||||
|
||||
|
||||
## Debugging
|
||||
|
@ -66,6 +78,21 @@ addAccessToken token (Vault 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
|
||||
|
@ -83,8 +110,9 @@ fromUserId uid =
|
|||
|> Maybe.map
|
||||
(\u ->
|
||||
Envelope.init
|
||||
{ serverName = "https://" ++ User.domain u
|
||||
, content = Internal.init (Just u)
|
||||
{ content = Internal.init
|
||||
, serverName = "https://" ++ User.domain u
|
||||
, user = Just u
|
||||
}
|
||||
|> Envelope.mapContext (\c -> { c | username = Just uid })
|
||||
)
|
||||
|
@ -99,19 +127,50 @@ you can either insert `alice` or `@alice:example.org`.
|
|||
-}
|
||||
fromUsername : { username : String, host : String, port_ : Maybe Int } -> Vault
|
||||
fromUsername { username, host, port_ } =
|
||||
{ serverName =
|
||||
{ content = Internal.init
|
||||
, serverName =
|
||||
port_
|
||||
|> Maybe.map String.fromInt
|
||||
|> Maybe.map ((++) ":")
|
||||
|> Maybe.withDefault ""
|
||||
|> (++) host
|
||||
, content = Internal.init (User.fromString username)
|
||||
, 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
|
||||
|
@ -119,6 +178,18 @@ 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
|
||||
|
@ -141,6 +212,36 @@ sendMessageEvent data =
|
|||
}
|
||||
|
||||
|
||||
{-| 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
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
module Matrix.Room exposing
|
||||
( Room, mostRecentEvents
|
||||
, getAccountData
|
||||
( Room, mostRecentEvents, roomId
|
||||
, getAccountData, setAccountData
|
||||
, sendMessageEvent, sendStateEvent
|
||||
, invite, kick, ban
|
||||
)
|
||||
|
||||
{-|
|
||||
|
@ -12,7 +14,7 @@ What is usually called a chat, a channel, a conversation or a group chat on
|
|||
other platforms, the term used in Matrix is a "room". A room is a conversation
|
||||
where a group of users talk to each other.
|
||||
|
||||
@docs Room, mostRecentEvents
|
||||
@docs Room, mostRecentEvents, roomId
|
||||
|
||||
This module exposes various functions that help you inspect various aspects of
|
||||
a room.
|
||||
|
@ -33,10 +35,26 @@ data is linked to the user account: other logged in devices can see the account
|
|||
data too, as the server synchronizes it, but the server shouldn´t show it to
|
||||
other users.
|
||||
|
||||
@docs getAccountData
|
||||
@docs getAccountData, setAccountData
|
||||
|
||||
|
||||
## Sending events
|
||||
|
||||
Besides reading the latest events, one can also send new events to the Matrix
|
||||
room. These events are JSON objects that can be shaped in any way or form that
|
||||
you like. To help other users with decoding your JSON objects, you pass an
|
||||
`eventType` string which helps them figure out the nature of your JSON object.
|
||||
|
||||
@docs sendMessageEvent, sendStateEvent
|
||||
|
||||
|
||||
## Moderating users
|
||||
|
||||
@docs invite, kick, ban
|
||||
|
||||
-}
|
||||
|
||||
import Internal.Api.Main as Api
|
||||
import Internal.Values.Envelope as Envelope
|
||||
import Internal.Values.Room as Internal
|
||||
import Json.Encode as E
|
||||
|
@ -49,6 +67,26 @@ type alias Room =
|
|||
Types.Room
|
||||
|
||||
|
||||
{-| Ban a user from a room.
|
||||
-}
|
||||
ban :
|
||||
{ reason : Maybe String
|
||||
, room : Room
|
||||
, toMsg : Types.VaultUpdate -> msg
|
||||
, user : Types.User
|
||||
}
|
||||
-> Cmd msg
|
||||
ban data =
|
||||
case ( data.room, data.user ) of
|
||||
( Room room, Types.User user ) ->
|
||||
Api.banUser room
|
||||
{ reason = data.reason
|
||||
, roomId = roomId data.room
|
||||
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||
, user = Envelope.getContent user
|
||||
}
|
||||
|
||||
|
||||
{-| Get a piece of account data linked to a certain string key.
|
||||
-}
|
||||
getAccountData : String -> Room -> Maybe E.Value
|
||||
|
@ -56,9 +94,121 @@ getAccountData key (Room room) =
|
|||
Envelope.extract (Internal.getAccountData key) room
|
||||
|
||||
|
||||
{-| Invite a user to a room.
|
||||
-}
|
||||
invite :
|
||||
{ reason : Maybe String
|
||||
, room : Room
|
||||
, toMsg : Types.VaultUpdate -> msg
|
||||
, user : Types.User
|
||||
}
|
||||
-> Cmd msg
|
||||
invite data =
|
||||
case ( data.room, data.user ) of
|
||||
( Room room, Types.User user ) ->
|
||||
Api.inviteUser room
|
||||
{ reason = data.reason
|
||||
, roomId = roomId data.room
|
||||
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||
, user = Envelope.getContent user
|
||||
}
|
||||
|
||||
|
||||
{-| Kick a user from a room.
|
||||
-}
|
||||
kick :
|
||||
{ reason : Maybe String
|
||||
, room : Room
|
||||
, toMsg : Types.VaultUpdate -> msg
|
||||
, user : Types.User
|
||||
}
|
||||
-> Cmd msg
|
||||
kick data =
|
||||
case ( data.room, data.user ) of
|
||||
( Room room, Types.User user ) ->
|
||||
Api.kickUser room
|
||||
{ reason = data.reason
|
||||
, roomId = roomId data.room
|
||||
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||
, user = Envelope.getContent user
|
||||
}
|
||||
|
||||
|
||||
{-| Get a room's room id. This is an opaque string that distinguishes rooms from
|
||||
each other.
|
||||
-}
|
||||
roomId : Room -> String
|
||||
roomId (Room room) =
|
||||
Envelope.extract .roomId room
|
||||
|
||||
|
||||
{-| Get a list of the most recent events sent in the room.
|
||||
-}
|
||||
mostRecentEvents : Room -> List Types.Event
|
||||
mostRecentEvents (Room room) =
|
||||
Envelope.mapList Internal.mostRecentEvents room
|
||||
|> List.map Types.Event
|
||||
|
||||
|
||||
{-| Send a message event to a given room.
|
||||
-}
|
||||
sendMessageEvent :
|
||||
{ content : E.Value
|
||||
, eventType : String
|
||||
, room : Room
|
||||
, toMsg : Types.VaultUpdate -> msg
|
||||
, transactionId : String
|
||||
}
|
||||
-> Cmd msg
|
||||
sendMessageEvent data =
|
||||
case data.room of
|
||||
Room room ->
|
||||
Api.sendMessageEvent room
|
||||
{ content = data.content
|
||||
, eventType = data.eventType
|
||||
, roomId = roomId data.room
|
||||
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||
, transactionId = data.transactionId
|
||||
}
|
||||
|
||||
|
||||
{-| Send a state event to a given room.
|
||||
-}
|
||||
sendStateEvent :
|
||||
{ content : E.Value
|
||||
, eventType : String
|
||||
, room : Room
|
||||
, stateKey : String
|
||||
, toMsg : Types.VaultUpdate -> msg
|
||||
}
|
||||
-> Cmd msg
|
||||
sendStateEvent data =
|
||||
case data.room of
|
||||
Room room ->
|
||||
Api.sendStateEvent room
|
||||
{ content = data.content
|
||||
, eventType = data.eventType
|
||||
, roomId = roomId data.room
|
||||
, stateKey = data.stateKey
|
||||
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||
}
|
||||
|
||||
|
||||
{-| Set account data to a Matrix room.
|
||||
-}
|
||||
setAccountData :
|
||||
{ content : E.Value
|
||||
, eventType : String
|
||||
, room : Room
|
||||
, toMsg : Types.VaultUpdate -> msg
|
||||
}
|
||||
-> Cmd msg
|
||||
setAccountData data =
|
||||
case data.room of
|
||||
Room room ->
|
||||
Api.setRoomAccountData room
|
||||
{ content = data.content
|
||||
, eventType = data.eventType
|
||||
, roomId = roomId data.room
|
||||
, toMsg = Types.VaultUpdate >> data.toMsg
|
||||
}
|
||||
|
|
|
@ -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 = []
|
||||
, coder = Json.list (Json.list Json.int)
|
||||
, default = ( [], [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
|
||||
|
||||
|
@ -132,7 +131,6 @@ hobbiesField =
|
|||
, description = []
|
||||
, coder = Json.list Json.string
|
||||
, default = ( [], [] )
|
||||
, defaultToString = always "[]"
|
||||
}
|
||||
|
||||
|
||||
|
@ -149,13 +147,6 @@ invitedToPartyField =
|
|||
, description = []
|
||||
, coder = Json.bool
|
||||
, default = ( False, [] )
|
||||
, defaultToString =
|
||||
\b ->
|
||||
if b then
|
||||
"True"
|
||||
|
||||
else
|
||||
"False"
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -5,11 +5,10 @@ import Fuzz exposing (Fuzzer)
|
|||
import Internal.Config.Leaks as Leaks
|
||||
import Internal.Tools.Hashdict as Hashdict
|
||||
import Internal.Values.Context as Context exposing (Context, Versions)
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import Set
|
||||
import Test exposing (..)
|
||||
import Test.Tools.Timestamp as TestTimestamp
|
||||
import Test.Values.User as TestUser
|
||||
|
||||
|
||||
fuzzer : Fuzzer Context
|
||||
|
@ -19,20 +18,26 @@ fuzzer =
|
|||
maybeString =
|
||||
Fuzz.maybe Fuzz.string
|
||||
in
|
||||
Fuzz.map8 (\a b c d e ( f, g ) ( h, i ) ( j, k ) -> Context a b c d e f g h i j k)
|
||||
Fuzz.map8 (\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) -> Context a b c d e f g h i j k l m)
|
||||
(Fuzz.constant <| Hashdict.empty .value)
|
||||
maybeString
|
||||
maybeString
|
||||
(Fuzz.maybe TestTimestamp.fuzzer)
|
||||
maybeString
|
||||
(Fuzz.pair
|
||||
maybeString
|
||||
Fuzz.string
|
||||
(Fuzz.maybe TestTimestamp.fuzzer)
|
||||
)
|
||||
(Fuzz.pair
|
||||
maybeString
|
||||
maybeString
|
||||
)
|
||||
(Fuzz.pair
|
||||
Fuzz.string
|
||||
maybeString
|
||||
)
|
||||
(Fuzz.pair
|
||||
maybeString
|
||||
(Fuzz.maybe TestUser.fuzzer)
|
||||
)
|
||||
(Fuzz.pair
|
||||
maybeString
|
||||
(Fuzz.maybe <| versionsFuzzer)
|
||||
|
|
|
@ -3,10 +3,7 @@ module Test.Values.Envelope exposing (..)
|
|||
import Expect
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Internal.Config.Default as Default
|
||||
import Internal.Tools.Json as Json
|
||||
import Internal.Values.Envelope as Envelope exposing (Envelope)
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import Test exposing (..)
|
||||
import Test.Values.Context as TestContext
|
||||
import Test.Values.Settings as TestSettings
|
||||
|
@ -28,7 +25,7 @@ suite =
|
|||
[ fuzz Fuzz.string
|
||||
"currentVersion"
|
||||
(\s ->
|
||||
{ content = s, serverName = "" }
|
||||
{ content = s, serverName = "", user = Nothing }
|
||||
|> Envelope.init
|
||||
|> Envelope.extractSettings .currentVersion
|
||||
|> Expect.equal Default.currentVersion
|
||||
|
@ -36,7 +33,7 @@ suite =
|
|||
, fuzz Fuzz.string
|
||||
"deviceName"
|
||||
(\s ->
|
||||
{ content = s, serverName = "" }
|
||||
{ content = s, serverName = "", user = Nothing }
|
||||
|> Envelope.init
|
||||
|> Envelope.extractSettings .deviceName
|
||||
|> Expect.equal Default.deviceName
|
||||
|
@ -44,7 +41,7 @@ suite =
|
|||
, fuzz Fuzz.string
|
||||
"syncTime"
|
||||
(\s ->
|
||||
{ content = s, serverName = "" }
|
||||
{ content = s, serverName = "", user = Nothing }
|
||||
|> Envelope.init
|
||||
|> Envelope.extractSettings .syncTime
|
||||
|> Expect.equal Default.syncTime
|
||||
|
|
|
@ -41,16 +41,18 @@ fuzzerState =
|
|||
|
||||
unsignedDataFuzzer : Fuzzer Event.UnsignedData
|
||||
unsignedDataFuzzer =
|
||||
Fuzz.map4
|
||||
(\age prev redact trans ->
|
||||
Fuzz.map5
|
||||
(\age memb prev redact trans ->
|
||||
Event.UnsignedData
|
||||
{ age = age
|
||||
, membership = memb
|
||||
, prevContent = prev
|
||||
, redactedBecause = redact
|
||||
, transactionId = trans
|
||||
}
|
||||
)
|
||||
(Fuzz.maybe Fuzz.int)
|
||||
(Fuzz.maybe Fuzz.string)
|
||||
(Fuzz.maybe valueFuzzer)
|
||||
(Fuzz.maybe <| Fuzz.lazy (\_ -> fuzzer))
|
||||
(Fuzz.maybe Fuzz.string)
|
||||
|
|
|
@ -4,8 +4,6 @@ import Fuzz exposing (Fuzzer)
|
|||
import Internal.Values.Room as Room exposing (Room)
|
||||
import Json.Encode as E
|
||||
import Test exposing (..)
|
||||
import Test.Filter.Timeline as TestFilter
|
||||
import Test.Values.Event as TestEvent
|
||||
|
||||
|
||||
placeholderValue : E.Value
|
||||
|
|
|
@ -11,7 +11,7 @@ import Test exposing (..)
|
|||
|
||||
fuzzer : Fuzzer Settings
|
||||
fuzzer =
|
||||
Fuzz.map4 Settings
|
||||
Fuzz.map5 Settings
|
||||
(Fuzz.oneOf
|
||||
[ Fuzz.constant Default.currentVersion
|
||||
, Fuzz.string
|
||||
|
@ -22,6 +22,7 @@ fuzzer =
|
|||
, Fuzz.string
|
||||
]
|
||||
)
|
||||
(Fuzz.maybe Fuzz.string)
|
||||
(Fuzz.oneOf
|
||||
[ Fuzz.constant Default.removePasswordOnLogin
|
||||
, Fuzz.bool
|
||||
|
|
|
@ -6,6 +6,7 @@ import Internal.Filter.Timeline as Filter
|
|||
import Internal.Tools.Json as Json
|
||||
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import Test exposing (..)
|
||||
import Test.Filter.Timeline as TestFilter
|
||||
|
||||
|
@ -250,7 +251,8 @@ suite =
|
|||
(\timeline ->
|
||||
timeline
|
||||
|> Json.encode Timeline.coder
|
||||
|> D.decodeValue (Json.decode Timeline.coder)
|
||||
|> E.encode 0
|
||||
|> D.decodeString (Json.decode Timeline.coder)
|
||||
|> Result.map Tuple.first
|
||||
|> Result.map (Timeline.mostRecentEvents Filter.pass)
|
||||
|> Expect.equal (Ok <| Timeline.mostRecentEvents Filter.pass timeline)
|
||||
|
|
|
@ -7,7 +7,6 @@ import Internal.Values.Vault exposing (Vault)
|
|||
import Test exposing (..)
|
||||
import Test.Tools.Hashdict as TestHashdict
|
||||
import Test.Values.Room as TestRoom
|
||||
import Test.Values.User as TestUser
|
||||
|
||||
|
||||
vault : Fuzzer Vault
|
||||
|
@ -18,5 +17,5 @@ vault =
|
|||
|> Fuzz.list
|
||||
|> Fuzz.map Dict.fromList
|
||||
)
|
||||
(Fuzz.maybe Fuzz.string)
|
||||
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
|
||||
(Fuzz.maybe TestUser.fuzzer)
|
||||
|
|
Loading…
Reference in New Issue