Compare commits

...

13 Commits

Author SHA1 Message Date
Bram bec1ae4a3b Fix merge conflict bug 2024-05-28 18:29:26 +02:00
BramvdnHeuvel daf4bcb1b1
Merge branch 'develop' into 4-transfer-api 2024-05-28 18:25:16 +02:00
Bram b0026617cf Add JSON fields to Text module 2024-05-28 18:20:01 +02:00
Bram 7fcef60ec6 Move logs to Text module 2024-05-28 16:46:33 +02:00
Bram 2b9370f0c2 Fix bugs for MVP
This version now officially works. I have tested it and I will publish an example soon.
2024-05-28 10:32:17 +02:00
Bram 12c919b071 Finish addAccessToken function 2024-05-27 23:47:37 +02:00
Bram 567ac5596a Merge branch '4-compiler-bug' into 4-transfer-api 2024-05-27 16:44:57 +02:00
Bram b32e0ef123 Fix test errors 2024-05-27 16:39:50 +02:00
Bram 9e761db4f9 Fix (most) warnings 2024-05-26 19:24:31 +02:00
Bram e335c150f0 Fix compiler bugs 2024-05-26 18:53:31 +02:00
Bram 4349a14a87 BREAKING: Fix bug breaking Elm compiler 2024-05-26 18:12:37 +02:00
Bram 42ca8f6c9c Add Elm SDK logo 2024-05-25 19:48:29 +02:00
Bram ff8b6c043a Prepare develop for master
elm-test --fuzz 1000 --seed 70276890098989
2024-05-10 15:41:27 +02:00
27 changed files with 683 additions and 465 deletions

BIN
docs/logo.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.7 KiB

16
docs/logo.svg Normal file
View File

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

After

Width:  |  Height:  |  Size: 1.2 KiB

View File

@ -3,7 +3,7 @@
"name": "noordstar/elm-matrix-sdk-beta",
"summary": "Matrix SDK for instant communication. Unstable beta version for testing only.",
"license": "EUPL-1.1",
"version": "3.1.0",
"version": "3.2.0",
"exposed-modules": [
"Matrix",
"Matrix.Event",

View File

@ -1,4 +1,4 @@
module Internal.Api.BaseUrl.Api exposing (..)
module Internal.Api.BaseUrl.Api exposing (baseUrl)
{-|
@ -7,31 +7,30 @@ module Internal.Api.BaseUrl.Api exposing (..)
This module looks for the right homeserver address.
@docs baseUrl
-}
import Internal.Api.Chain as C
import Internal.Api.Request as R
import Internal.Config.Leaks as L
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Context as Context
import Internal.Values.Envelope as E
import Internal.Values.Vault as V
{-| Get the homeserver base URL of a given server name.
-}
baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () }
baseUrl data =
R.toChain
{ logHttp =
\r ->
( E.HttpRequest r
, String.concat
-- TODO: Move this to Internal.Config.Text module
[ "Matrix HTTP: "
, r.method
, " "
, r.url
]
, Text.logs.httpRequest r.method r.url
|> log.info
|> List.singleton
)
@ -48,12 +47,7 @@ baseUrl data =
, toUpdate =
\info ->
( E.SetBaseUrl info.homeserver.baseUrl
, String.concat
[ "Found baseURL of "
, data.url
, " at address "
, info.homeserver.baseUrl
]
, Text.logs.baseUrlFound data.url info.homeserver.baseUrl
|> log.debug
|> List.singleton
)

View File

@ -1,7 +1,7 @@
module Internal.Api.Chain exposing
( TaskChain, CompleteChain
, IdemChain, toTask
, fail, succeed, andThen, catchWith
, fail, succeed, andThen, catchWith, maybe
)
{-|
@ -27,7 +27,7 @@ avoid leaking values passing through the API in unexpected ways.
## Operations
@docs fail, succeed, andThen, catchWith
@docs fail, succeed, andThen, catchWith, maybe
-}

View File

@ -15,6 +15,7 @@ retrieve this event e.g. by being a member in the room for this event.
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Tools.Timestamp as Timestamp
import Internal.Values.Envelope as E
@ -85,7 +86,7 @@ getEventV1 { eventId, roomId } =
\event ->
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
, event.eventId
|> (++) "Received event id "
|> Text.logs.getEventId
|> log.debug
|> List.singleton
)
@ -109,7 +110,7 @@ getEventV2 { eventId, roomId } =
\event ->
( E.ContentUpdate <| V.MapRoom roomId (Room.AddEvent event)
, event.eventId
|> (++) "Received event id "
|> Text.logs.getEventId
|> log.debug
|> List.singleton
)

View File

@ -21,6 +21,7 @@ event to the room.
import Internal.Api.Api as A
import Internal.Api.Request as R
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Internal.Values.Envelope as E
import Internal.Values.Room as Room
@ -95,13 +96,7 @@ inviteV1 { roomId, user } =
, toUpdate =
always
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
, String.concat
-- TODO: Move to Internal.Config.Text
[ "Invited user "
, User.toString user
, " to room "
, roomId
]
, Text.logs.invitedUser (User.toString user) roomId
|> log.debug
|> List.singleton
)
@ -125,13 +120,7 @@ inviteV2 { reason, roomId, user } =
, toUpdate =
always
( E.ContentUpdate <| V.MapRoom roomId (Room.Invite user)
, String.concat
-- TODO: Move to Internal.Config.Text
[ "Invited user "
, User.toString user
, " to room "
, roomId
]
, Text.logs.invitedUser (User.toString user) roomId
|> log.debug
|> List.singleton
)

View File

@ -14,6 +14,8 @@ 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
import Internal.Values.Context as Context
import Internal.Values.Envelope as E
@ -22,6 +24,8 @@ import Internal.Values.Vault as V
import Json.Encode as E
{-| Log in using a username and password.
-}
loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> A.TaskChain (Phantom a) (Phantom { a | accessToken : () })
loginWithUsernameAndPassword =
A.startWithVersion "r0.0.0" loginWithUsernameAndPasswordV1
@ -46,8 +50,10 @@ loginWithUsernameAndPassword =
|> A.versionChain
{-| Context needed for logging in with a username and password
-}
type alias Phantom a =
{ a | baseUrl : (), versions : () }
{ a | baseUrl : (), now : (), versions : () }
type alias LoginWithUsernameAndPasswordInput =
@ -159,333 +165,354 @@ type alias PhantomV1 a =
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV1 { username, password } context =
A.request
{ attributes =
[ R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
]
, coder = coderV1
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
]
, []
)
}
context
loginWithUsernameAndPasswordV1 { username, password } =
\context ->
A.request
{ attributes =
[ R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
]
, coder = coderV1
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV2 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } context =
A.request
{ attributes =
[ R.bodyOpString "device_id" deviceId
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "string" -- Yup. That's what it says.
]
, coder = coderV2
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, []
)
}
context
loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "device_id" deviceId
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "string" -- Yup. That's what it says.
]
, coder = coderV2
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV3 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } context =
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV3
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, []
)
}
context
loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV3
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV4 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } context =
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV4
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, []
)
}
context
loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV4
, method = "POST"
, path = [ "_matrix", "client", "r0", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV5 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } context =
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV4
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, []
)
}
context
loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV4
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = Nothing
, lastUsed = Context.getNow context
, refresh = Nothing
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV6 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } context =
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyOpBool "refresh_token" enableRefreshToken
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV5
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = out.expiresInMs
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, []
)
}
context
loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyOpBool "refresh_token" enableRefreshToken
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV5
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = out.expiresInMs
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, out.user
|> Maybe.map (V.SetUser >> E.ContentUpdate)
|> E.Optional
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, out.deviceId
|> Maybe.map E.SetDeviceId
|> E.Optional
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
loginWithUsernameAndPasswordV7 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } context =
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyOpBool "refresh_token" enableRefreshToken
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV6
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = out.expiresInMs
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, E.ContentUpdate (V.SetUser out.user)
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, E.SetDeviceId out.deviceId
]
, []
)
}
context
loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
\context ->
A.request
{ attributes =
[ R.bodyOpString "address" Nothing
, R.bodyOpString "device_id" deviceId
, R.bodyValue "identifier"
(E.object
[ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
)
, R.bodyOpString "initial_device_display_name" initialDeviceDisplayName
, R.bodyString "password" password
, R.bodyOpBool "refresh_token" enableRefreshToken
, R.bodyString "type" "m.login.password"
, R.bodyString "user" username
, R.onStatusCode 400 "M_UNKNOWN"
, R.onStatusCode 403 "M_FORBIDDEN"
, R.onStatusCode 429 "M_LIMIT_EXCEEDED"
]
, coder = coderV6
, method = "POST"
, path = [ "_matrix", "client", "v3", "login" ]
, contextChange =
\out -> Context.setAccessToken out.accessToken
, toUpdate =
\out ->
( E.More
[ E.SetAccessToken
{ created = Context.getNow context
, expiryMs = out.expiresInMs
, lastUsed = Context.getNow context
, refresh = out.refreshToken
, value = out.accessToken
}
, E.ContentUpdate (V.SetUser out.user)
, out.wellKnown
|> Maybe.map (.homeserver >> .baseUrl)
|> Maybe.map E.SetBaseUrl
|> E.Optional
, E.SetDeviceId out.deviceId
]
, Text.logs.loggedInAs username
|> log.debug
|> List.singleton
)
}
context
coderV1 : Json.Coder LoginWithUsernameAndPasswordOutputV1

View File

@ -28,6 +28,8 @@ import Internal.Values.Context as Context
import Internal.Values.Envelope as E
{-| Update message type that is being returned.
-}
type alias Msg =
Backpack

View File

@ -13,25 +13,28 @@ Get the current time.
import Internal.Api.Api as A
import Internal.Config.Log exposing (log)
import Internal.Config.Text as Text
import Internal.Values.Context as Context
import Internal.Values.Envelope as E
import Task
import Time
{-| Get the current time and place it in the context.
-}
getNow : A.TaskChain a { a | now : () }
getNow _ =
Task.map
(\now ->
{ messages = [ E.SetNow now ]
, logs =
[ "Identified current time at Unix time "
, now |> Time.posixToMillis |> String.fromInt
]
|> String.concat
|> log.debug
|> List.singleton
, contextChange = Context.setNow now
}
)
Time.now
getNow =
\_ ->
Task.map
(\now ->
{ messages = [ E.SetNow now ]
, logs =
now
|> Time.posixToMillis
|> Text.logs.getNow
|> log.debug
|> List.singleton
, contextChange = Context.setNow now
}
)
Time.now

View File

@ -287,7 +287,7 @@ fullBody value _ =
FullBody value
getBody : List ContextAttr -> Json.Value
getBody : List ContextAttr -> Maybe Json.Value
getBody attributes =
attributes
|> List.filterMap
@ -301,19 +301,30 @@ getBody attributes =
)
|> List.reverse
|> List.head
|> Maybe.withDefault
(List.filterMap
(\attr ->
case attr of
BodyParam key value ->
Just ( key, value )
|> (\fb ->
case fb of
Just _ ->
fb
_ ->
Nothing
)
attributes
|> E.object
)
Nothing ->
case
List.filterMap
(\attr ->
case attr of
BodyParam key value ->
Just ( key, value )
_ ->
Nothing
)
attributes
of
[] ->
Nothing
head :: tail ->
Just <| E.object (head :: tail)
)
getHeaders : List ContextAttr -> List Http.Header
@ -479,21 +490,21 @@ rawApiCallResolver decoder statusCodeErrors =
Http.BadUrl s
|> InternetException
|> Tuple.pair
|> (|>) []
|> (|>) [ log.error ("Encountered bad URL " ++ s) ]
|> Err
Http.Timeout_ ->
Http.Timeout
|> InternetException
|> Tuple.pair
|> (|>) []
|> (|>) [ log.error "Encountered timeout - maybe the server is down?" ]
|> Err
Http.NetworkError_ ->
Http.NetworkError
|> InternetException
|> Tuple.pair
|> (|>) []
|> (|>) [ log.error "Encountered a network error - the user might be offline" ]
|> Err
Http.BadStatus_ metadata body ->
@ -534,7 +545,10 @@ toChain data apiContext =
{ method = call.method
, headers = getHeaders call.attributes
, url = getUrl call
, body = Http.jsonBody (getBody call.attributes)
, body =
getBody call.attributes
|> Maybe.map Http.jsonBody
|> Maybe.withDefault Http.emptyBody
, resolver = rawApiCallResolver (Json.decode data.coder) (getStatusCodes call.attributes)
, timeout = getTimeout call.attributes
}
@ -544,7 +558,10 @@ toChain data apiContext =
{ method = call.method
, headers = getHeaders call.attributes
, url = getUrl call
, body = Http.jsonBody (getBody call.attributes)
, body =
getBody call.attributes
|> Maybe.map Http.jsonBody
|> Maybe.withDefault Http.emptyBody
, resolver =
rawApiCallResolver
(Json.decode data.coder

View File

@ -1,4 +1,4 @@
module Internal.Api.SendMessageEvent.Api exposing (..)
module Internal.Api.SendMessageEvent.Api exposing (Phantom, sendMessageEvent)
{-|
@ -7,7 +7,7 @@ module Internal.Api.SendMessageEvent.Api exposing (..)
This module helps send message events to rooms on the Matrix API.
@docs Phantom
@docs Phantom, sendMessageEvent
-}
@ -15,10 +15,13 @@ 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
import Internal.Values.Envelope as E
{-| Send a message event to the Matrix room.
-}
sendMessageEvent : SendMessageEventInput -> A.TaskChain (Phantom a) (Phantom a)
sendMessageEvent =
A.startWithVersion "r0.0.0" sendMessageEventV1
@ -44,8 +47,10 @@ sendMessageEvent =
|> A.versionChain
{-| Context needed for sending a message event
-}
type alias Phantom a =
a
{ a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a =
@ -80,7 +85,7 @@ type alias SendMessageEventOutputV2 =
sendMessageEventV1 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendMessageEventV1 { content, eventType, roomId, transactionId } =
A.request
{ attributes = [ R.fullBody content ]
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV1
, contextChange = always identity
, method = "PUT"
@ -89,9 +94,7 @@ sendMessageEventV1 { content, eventType, roomId, transactionId } =
\out ->
( E.More []
, out.eventId
|> Maybe.map ((++) ", received event id ")
|> Maybe.withDefault ""
|> (++) "Sent event"
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
@ -101,7 +104,7 @@ sendMessageEventV1 { content, eventType, roomId, transactionId } =
sendMessageEventV2 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendMessageEventV2 { content, eventType, roomId, transactionId } =
A.request
{ attributes = [ R.fullBody content ]
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
@ -110,7 +113,8 @@ sendMessageEventV2 { content, eventType, roomId, transactionId } =
\out ->
( E.More []
, out.eventId
|> (++) "Sent event, received event id "
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
@ -120,7 +124,7 @@ sendMessageEventV2 { content, eventType, roomId, transactionId } =
sendMessageEventV3 : SendMessageEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a)
sendMessageEventV3 { content, eventType, roomId, transactionId } =
A.request
{ attributes = [ R.fullBody content ]
{ attributes = [ R.accessToken, R.fullBody content ]
, coder = coderV2
, contextChange = always identity
, method = "PUT"
@ -129,7 +133,8 @@ sendMessageEventV3 { content, eventType, roomId, transactionId } =
\out ->
( E.More []
, out.eventId
|> (++) "Sent event, received event id "
|> Maybe.Just
|> Text.logs.sendEvent
|> log.debug
|> List.singleton
)
@ -161,7 +166,7 @@ coderV1 =
(Json.field.optional.value
{ fieldName = "event_id"
, toField = .eventId
, description = Debug.todo "Needs docs"
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)
@ -174,7 +179,7 @@ coderV2 =
, 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"
, "https://spec.matrix.org/legacy/client_server/r0.6.1.html#put-matrix-client-r0-rooms-roomid-send-eventtype-txnid"
]
, init = always SendMessageEventOutputV2
}
@ -192,7 +197,7 @@ coderV2 =
(Json.field.required
{ fieldName = "event_id"
, toField = .eventId
, description = Debug.todo "Needs docs"
, description = [ "A unique identifier for the event." ]
, coder = Json.string
}
)

View File

@ -65,7 +65,7 @@ type alias UFTask a b =
{-| Get an access token to talk to the Matrix API
-}
getAccessToken : UFTask { a | now : () } { a | accessToken : (), now : () }
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
getAccessToken c =
case Context.fromApiFormat c of
context ->
@ -149,11 +149,43 @@ finishTask uftask =
}
)
|> C.catchWith
(\_ ->
{ messages = [] -- TODO: Maybe categorize errors?
, logs = [ log.warn "Encountered unhandled error" ]
, contextChange = Context.reset
}
(\e ->
case e of
Request.MissingPassword ->
{ messages = []
, logs = [ log.error "Cannot log in - password is missing" ]
, contextChange = Context.reset
}
Request.MissingUsername ->
{ messages = []
, logs = [ log.error "Cannot log in - username is missing" ]
, contextChange = Context.reset
}
Request.NoSupportedVersion ->
{ messages = []
, logs = [ log.error "No supported version is available to complete the API interaction." ]
, contextChange = Context.reset
}
Request.ServerReturnsBadJSON t ->
{ messages = []
, logs = [ log.error ("The server returned invalid JSON: " ++ t) ]
, contextChange = Context.reset
}
Request.ServerReturnsError name _ ->
{ messages = []
, logs = [ log.error ("The server returns an error: " ++ name) ]
, contextChange = Context.reset
}
_ ->
{ messages = [] -- TODO: Maybe categorize errors?
, logs = [ log.warn "Encountered unhandled error" ]
, contextChange = Context.reset
}
)

View File

@ -23,7 +23,7 @@ will assume until overriden by the user.
-}
currentVersion : String
currentVersion =
"beta 3.1.0"
"beta 3.2.0"
{-| The default device name that is being communicated with the Matrix API.

View File

@ -112,7 +112,8 @@ decodedDictSize from to =
{-| Documentation used for all functions and data types in JSON coders
-}
docs :
{ context : TypeDocs
{ accessToken : TypeDocs
, context : TypeDocs
, envelope : TypeDocs
, event : TypeDocs
, hashdict : TypeDocs
@ -127,9 +128,16 @@ docs :
, timelineFilter : TypeDocs
, unsigned : TypeDocs
, vault : TypeDocs
, versions : TypeDocs
}
docs =
{ context =
{ accessToken =
{ name = "Access Token"
, description =
[ "The Access Token type stores information about an access token - its value, when it expires, and how one may get a new access token when the current value expires."
]
}
, context =
{ name = "Context"
, description =
[ "The Context is the set of variables that the user (mostly) cannot control."
@ -223,6 +231,12 @@ docs =
[ "Main type storing all relevant information from the Matrix API."
]
}
, versions =
{ name = "Versions"
, description =
[ "Versions type describing the supported spec versions and MSC properties."
]
}
}
@ -244,14 +258,24 @@ failures =
what they do and what they are for.
-}
fields :
{ context :
{ accessToken :
{ created : Desc
, expiryMs : Desc
, lastUsed : Desc
, refresh : Desc
, value : Desc
}
, context :
{ accessToken : Desc
, baseUrl : Desc
, deviceId : Desc
, experimental : Desc
, now : Desc
, password : Desc
, refreshToken : Desc
, username : Desc
, serverName : Desc
, suggestedAccessToken : Desc
, transaction : Desc
, versions : Desc
}
@ -321,25 +345,51 @@ fields :
, vault :
{ accountData : Desc
, rooms : Desc
, user : Desc
}
, versions :
{ unstableFeatures : Desc
, versions : Desc
}
}
fields =
{ context =
{ accessToken =
{ created =
[ "Timestamp of when the access token was received." ]
, expiryMs =
[ "Given time in milliseconds of when the access token might expire." ]
, lastUsed =
[ "Timestamp of when the access token was last used." ]
, refresh =
[ "Refresh token used to gain a new access token." ]
, value =
[ "Secret access token value." ]
}
, context =
{ accessToken =
[ "The access token used for authentication with the Matrix server."
]
, baseUrl =
[ "The base URL of the Matrix server."
]
, deviceId =
[ "The reported device ID according to the API."
]
, experimental =
[ "Experimental features supported by the homeserver."
]
, now =
[ "The most recently found timestamp."
]
, password =
[ "The user's password for authentication purposes."
]
, refreshToken =
[ "The token used to obtain a new access token upon expiration of the current access token."
]
, suggestedAccessToken =
[ "An access token provided with no context by the user."
]
, username =
[ "The username of the Matrix account."
]
@ -510,6 +560,16 @@ fields =
, rooms =
[ "Directory of joined rooms that the user is a member of."
]
, user =
[ "User that the Vault is logging in as."
]
}
, versions =
{ unstableFeatures =
[ "Unstable features such as experimental MSCs that are supported by a homeserver."
]
, versions =
[ "Spec versions supported by a homeserver." ]
}
}
@ -545,18 +605,51 @@ happened. Most of these unexpected results, are taken account of by the Elm SDK,
but logged so that the programmer can do something about it.
-}
logs :
{ keyIsNotAnInt : String -> String
{ baseUrlFound : String -> String -> String
, getEventId : String -> String
, getNow : Int -> String
, httpRequest : String -> String -> String
, invitedUser : String -> String -> String
, keyIsNotAnInt : String -> String
, loggedInAs : String -> String
, sendEvent : Maybe String -> String
, serverReturnedInvalidJSON : String -> String
, serverReturnedUnknownJSON : String -> String
}
logs =
{ keyIsNotAnInt =
{ baseUrlFound =
\url baseUrl ->
String.concat [ "Found baseURL of ", url, " at address ", baseUrl ]
, getEventId = (++) "Received event with id = "
, getNow =
\now ->
String.concat
[ "Identified current time at Unix time "
, String.fromInt now
]
, httpRequest =
\method url -> String.concat [ "Matrix HTTP: ", method, " ", url ]
, invitedUser =
\userId roomId ->
String.concat [ "Invited user ", userId, " to room ", roomId ]
, keyIsNotAnInt =
\key ->
String.concat
[ "Encountered a key `"
, key
, "` that cannot be converted to an Int"
]
, loggedInAs =
\username ->
String.concat [ "Successfully logged in as user ", username ]
, sendEvent =
\eventId ->
case eventId of
Just e ->
"Sent event, received event id " ++ e
Nothing ->
"Sent event, event id not known - make sure to check transaction id"
, serverReturnedInvalidJSON = (++) "The server returned invalid JSON: "
, serverReturnedUnknownJSON = (++) "The server returned JSON that doesn't seem to live up to spec rules: "
}

View File

@ -50,8 +50,6 @@ for interacting with the Matrix API.
import Internal.Config.Text as Text
import Internal.Grammar.UserId as U
import Internal.Tools.Json as Json
import Json.Decode as D
import Json.Encode as E
import Set exposing (Set)

View File

@ -174,14 +174,14 @@ coder =
(Json.field.optional.value
{ fieldName = "deviceId"
, toField = .deviceId
, description = Debug.todo "Needs docs"
, description = Text.fields.context.deviceId
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "now"
, toField = .now
, description = Debug.todo "Needs docs"
, description = Text.fields.context.now
, coder = Timestamp.coder
}
)
@ -209,7 +209,7 @@ coder =
(Json.field.optional.value
{ fieldName = "suggestedAccessToken"
, toField = always Nothing -- Do not save
, description = Debug.todo "Needs docs"
, description = Text.fields.context.suggestedAccessToken
, coder = Json.string
}
)
@ -241,42 +241,42 @@ coder =
coderAccessToken : Json.Coder AccessToken
coderAccessToken =
Json.object5
{ name = Debug.todo "Needs docs"
, description = Debug.todo "Needs docs"
{ name = Text.docs.accessToken.name
, description = Text.docs.accessToken.description
, init = AccessToken
}
(Json.field.required
{ fieldName = "created"
, toField = .created
, description = Debug.todo "Needs docs"
, description = Text.fields.accessToken.created
, coder = Timestamp.coder
}
)
(Json.field.optional.value
{ fieldName = "expiryMs"
, toField = .expiryMs
, description = Debug.todo "Needs docs"
, description = Text.fields.accessToken.expiryMs
, coder = Json.int
}
)
(Json.field.required
{ fieldName = "lastUsed"
, toField = .lastUsed
, description = Debug.todo "Needs docs"
, description = Text.fields.accessToken.lastUsed
, coder = Timestamp.coder
}
)
(Json.field.optional.value
{ fieldName = "refresh"
, toField = .refresh
, description = Debug.todo "Needs docs"
, description = Text.fields.accessToken.refresh
, coder = Json.string
}
)
(Json.field.required
{ fieldName = "value"
, toField = .value
, description = Debug.todo "Needs docs"
, description = Text.fields.accessToken.value
, coder = Json.string
}
)
@ -318,23 +318,28 @@ init sn =
-}
mostPopularToken : Context -> Maybe String
mostPopularToken c =
c.accessTokens
|> Hashdict.values
|> List.sortBy
(\token ->
case token.expiryMs of
Nothing ->
( 0, Timestamp.toMs token.created )
case c.suggestedAccessToken of
Just _ ->
c.suggestedAccessToken
Just e ->
( 1
, token.created
|> Timestamp.add e
|> Timestamp.toMs
)
)
|> List.head
|> Maybe.map .value
Nothing ->
c.accessTokens
|> Hashdict.values
|> List.sortBy
(\token ->
case token.expiryMs of
Nothing ->
( 0, Timestamp.toMs token.created )
Just e ->
( 1
, token.created
|> Timestamp.add e
|> Timestamp.toMs
)
)
|> List.head
|> Maybe.map .value
{-| Reset the phantom type of the Context, effectively forgetting all values.
@ -417,21 +422,21 @@ setVersions value (APIContext c) =
versionsCoder : Json.Coder Versions
versionsCoder =
Json.object2
{ name = Debug.todo "Add name" -- Text.docs.versions.name
, description = Debug.todo "Add description" -- Text.docs.versions.description
{ name = Text.docs.versions.name
, description = Text.docs.versions.description
, init = Versions
}
(Json.field.required
{ fieldName = "versions"
, toField = .versions
, description = Debug.todo "Add description"
, description = Text.fields.versions.versions
, coder = Json.list Json.string
}
)
(Json.field.optional.withDefault
{ fieldName = "unstableFeatures"
, toField = .unstableFeatures
, description = Debug.todo "Add description"
, description = Text.fields.versions.unstableFeatures
, coder = Json.set Json.string
, default = ( Set.empty, [] )
, defaultToString = Json.encode (Json.set Json.string) >> E.encode 0

View File

@ -56,7 +56,7 @@ import Internal.Tools.Json as Json
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 as User exposing (User)
import Internal.Values.User exposing (User)
import Json.Encode as E
@ -255,7 +255,7 @@ update ru room =
AddSync batch ->
addSync batch room
Invite user ->
Invite _ ->
-- TODO: Invite user
room

View File

@ -36,7 +36,7 @@ Since the username is safely parsed, one can get these parts of the username.
-}
import Internal.Config.Log as Log exposing (log)
import Internal.Config.Log exposing (log)
import Internal.Grammar.ServerName as ServerName
import Internal.Grammar.UserId as UserId
import Internal.Tools.Json as Json

View File

@ -33,8 +33,6 @@ Rooms are environments where people can have a conversation with each other.
-}
import FastDict as Dict exposing (Dict)
import Internal.Api.Request as Request
import Internal.Config.Log exposing (Log)
import Internal.Config.Text as Text
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Tools.Json as Json
@ -86,7 +84,7 @@ coder =
(Json.field.required
{ fieldName = "user"
, toField = .user
, description = Debug.todo "Needs description"
, description = Text.fields.vault.user
, coder = User.coder
}
)

View File

@ -1,7 +1,7 @@
module Matrix exposing
( Vault
( Vault, fromUserId
, VaultUpdate, update
, sendMessageEvent, fromUserId
, addAccessToken, sendMessageEvent
)
{-|
@ -29,16 +29,16 @@ support a monolithic public registry. (:
## Debugging
@docs sendMessageEvent
@docs addAccessToken, sendMessageEvent
-}
import Internal.Api.Main as Api
import Internal.Values.Envelope as Envelope
import Internal.Values.User as User
import Internal.Values.Vault as Internal
import Json.Encode as E
import Types exposing (Vault(..), VaultUpdate(..))
import Internal.Values.User as User
{-| The Vault type stores all relevant information about the Matrix API.
@ -56,18 +56,22 @@ type alias Vault =
type alias VaultUpdate =
Types.VaultUpdate
addAccessToken : String -> Vault -> Vault
addAccessToken token (Vault vault) =
Envelope.mapContext (\c -> { c | suggestedAccessToken = Just token }) vault
|> Vault
{-| Use a fully-fledged Matrix ID to connect.
case Matrix.fromUserId "@alice:example.org" of
Just vault ->
"We got a vault!"
Nothing ->
"Invalid username"
-}
fromUserId : String -> Maybe Vault
fromUserId =
@ -75,12 +79,13 @@ fromUserId =
>> Maybe.map
(\u ->
Envelope.init
{ serverName = User.domain u
{ serverName = "https://" ++ User.domain u
, content = Internal.init u
}
)
>> Maybe.map Vault
{-| Send a message event to a room.
This function can be used in a scenario where the user does not want to sync

View File

@ -3,10 +3,13 @@ module Test.Values.Context exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Config.Leaks as Leaks
import Internal.Values.Context as Context exposing (Context)
import 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
fuzzer : Fuzzer Context
@ -16,14 +19,31 @@ fuzzer =
maybeString =
Fuzz.maybe Fuzz.string
in
Fuzz.map7 Context
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.constant <| Hashdict.empty .value)
maybeString
maybeString
(Fuzz.maybe TestTimestamp.fuzzer)
maybeString
maybeString
maybeString
maybeString
(Fuzz.maybe <| Fuzz.list Fuzz.string)
(Fuzz.pair
maybeString
Fuzz.string
)
(Fuzz.pair
maybeString
maybeString
)
(Fuzz.pair
maybeString
(Fuzz.maybe <| versionsFuzzer)
)
versionsFuzzer : Fuzzer Versions
versionsFuzzer =
Fuzz.map2 Versions
(Fuzz.list Fuzz.string)
(Fuzz.map Set.fromList <| Fuzz.list Fuzz.string)
{-| If a leak is spotted, make sure to change the leaking value and then test
@ -64,7 +84,7 @@ leaks =
|> Expect.notEqual Leaks.transaction
)
, fuzz2 fuzzer
(Fuzz.list Fuzz.string)
versionsFuzzer
"Versions"
(\context value ->
context
@ -110,7 +130,7 @@ apiContext =
|> Expect.equal value
)
, fuzz2 fuzzer
(Fuzz.list Fuzz.string)
versionsFuzzer
"Versions"
(\context value ->
context
@ -126,7 +146,7 @@ json : Test
json =
describe "JSON encode + JSON decode"
[ test "Empty is {}"
(Context.init
(Context.init ""
|> Context.encode
|> E.encode 0
|> Expect.equal "{}"

View File

@ -28,7 +28,7 @@ suite =
[ fuzz Fuzz.string
"currentVersion"
(\s ->
s
{ content = s, serverName = "" }
|> Envelope.init
|> Envelope.extractSettings .currentVersion
|> Expect.equal Default.currentVersion
@ -36,7 +36,7 @@ suite =
, fuzz Fuzz.string
"deviceName"
(\s ->
s
{ content = s, serverName = "" }
|> Envelope.init
|> Envelope.extractSettings .deviceName
|> Expect.equal Default.deviceName
@ -44,7 +44,7 @@ suite =
, fuzz Fuzz.string
"syncTime"
(\s ->
s
{ content = s, serverName = "" }
|> Envelope.init
|> Envelope.extractSettings .syncTime
|> Expect.equal Default.syncTime

View File

@ -1,9 +1,7 @@
module Test.Values.Room exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Values.Room as Room exposing (Room)
import Json.Decode as D
import Json.Encode as E
import Test exposing (..)
import Test.Filter.Timeline as TestFilter

View File

@ -2,7 +2,7 @@ module Test.Values.Timeline exposing (..)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Filter.Timeline as Filter exposing (Filter)
import Internal.Filter.Timeline as Filter
import Internal.Tools.Json as Json
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
import Json.Decode as D

View File

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

View File

@ -1,20 +1,22 @@
module Test.Values.Vault exposing (..)
import FastDict as Dict exposing (Dict)
import FastDict as Dict
import Fuzz exposing (Fuzzer)
import Internal.Tools.Json as Json
import Internal.Values.Vault exposing (Vault)
import Test exposing (..)
import Test.Tools.Hashdict as TestHashdict
import Test.Values.Room as TestRoom
import Test.Values.User as TestUser
vault : Fuzzer Vault
vault =
Fuzz.map2 Vault
Fuzz.map3 Vault
(Fuzz.string
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|> Fuzz.list
|> Fuzz.map Dict.fromList
)
(TestHashdict.fuzzer .roomId TestRoom.fuzzer)
TestUser.fuzzer