noordstar
/
elm-matrix-sdk-beta
mirror of https://github.com/noordstar/elm-matrix-sdk-beta
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: noordstar:bec1ae4a3b23ac64849010170e3c94eabf1d9fee
Branches Tags
noordstar:main
noordstar:develop
noordstar:4-transfer-api
noordstar:patch-no-baseurl-found
noordstar:4-log-reader
noordstar:4-compiler-bug
noordstar:3-vault
noordstar:3-room
noordstar:parser
noordstar:json-docs
noordstar:3-timeline
noordstar:json-extra
noordstar:3-data-types
noordstar:3-state-manager
noordstar:elm-test
noordstar:3-event
noordstar:2-transfer-tools
noordstar:1-repo-setup
noordstar:3.5.0
noordstar:3.4.0
noordstar:3.3.1
noordstar:3.3.0
noordstar:3.2.0
noordstar:3.1.0
noordstar:3.0.0
noordstar:2.1.2
noordstar:2.1.1
noordstar:2.1.0
noordstar:2.0.0
noordstar:1.0.0
..
compare: noordstar:487c872d43c5bcebccc383d35ee5ada361e73073
Branches Tags
noordstar:main
noordstar:develop
noordstar:4-transfer-api
noordstar:patch-no-baseurl-found
noordstar:4-log-reader
noordstar:4-compiler-bug
noordstar:3-vault
noordstar:3-room
noordstar:parser
noordstar:json-docs
noordstar:3-timeline
noordstar:json-extra
noordstar:3-data-types
noordstar:3-state-manager
noordstar:elm-test
noordstar:3-event
noordstar:2-transfer-tools
noordstar:1-repo-setup
noordstar:3.5.0
noordstar:3.4.0
noordstar:3.3.1
noordstar:3.3.0
noordstar:3.2.0
noordstar:3.1.0
noordstar:3.0.0
noordstar:2.1.2
noordstar:2.1.1
noordstar:2.1.0
noordstar:2.0.0
noordstar:1.0.0

No commits in common. "bec1ae4a3b23ac64849010170e3c94eabf1d9fee" and "487c872d43c5bcebccc383d35ee5ada361e73073" have entirely different histories.
bec1ae4a3b ... 487c872d43

27 changed files with 465 additions and 683 deletions
Show Stats Expand all files Collapse all files

BIN
docs/logo.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 7.7 KiB

16
docs/logo.svg
View File

@ -1,16 +0,0 @@
<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>
Side by Side

Before

Width:  |  Height:  |  Size: 1.2 KiB

2
elm.json
View File

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

22
src/Internal/Api/BaseUrl/Api.elm
View File

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

4
src/Internal/Api/Chain.elm
View File

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

5
src/Internal/Api/GetEvent/Api.elm
View File

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

17
src/Internal/Api/Invite/Api.elm
View File

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

647
src/Internal/Api/LoginWithUsernameAndPassword/Api.elm
View File

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

2
src/Internal/Api/Main.elm
View File

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

33
src/Internal/Api/Now/Api.elm
View File

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

53
src/Internal/Api/Request.elm
View File

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

33
src/Internal/Api/SendMessageEvent/Api.elm
View File

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

44
src/Internal/Api/Task.elm
View File

@ -65,7 +65,7 @@ type alias UFTask a b =
{-| Get an access token to talk to the Matrix API {-| Get an access token to talk to the Matrix API
-} -}
getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () } getAccessToken : UFTask { a | now : () } { a | accessToken : (), now : () }
getAccessToken c = getAccessToken c =
case Context.fromApiFormat c of case Context.fromApiFormat c of
context -> context ->
@ -149,43 +149,11 @@ finishTask uftask =
} }
) )
|> C.catchWith |> C.catchWith
(\e -> (\_ ->
case e of { messages = [] -- TODO: Maybe categorize errors?
Request.MissingPassword -> , logs = [ log.warn "Encountered unhandled error" ]
{ messages = [] , contextChange = Context.reset
, 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
}
) )

2
src/Internal/Config/Default.elm
View File

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

105
src/Internal/Config/Text.elm
View File

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

2
src/Internal/Filter/Timeline.elm
View File

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

65
src/Internal/Values/Context.elm
View File

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

4
src/Internal/Values/Room.elm
View File

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

2
src/Internal/Values/User.elm
View File

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

4
src/Internal/Values/Vault.elm
View File

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

15
src/Matrix.elm
View File

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

38
tests/Test/Values/Context.elm
View File

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

6
tests/Test/Values/Envelope.elm
View File

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

2
tests/Test/Values/Room.elm
View File

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

2
tests/Test/Values/Timeline.elm
View File

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

13
tests/Test/Values/User.elm
View File

@ -1,13 +0,0 @@
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 }
}

6
tests/Test/Values/Vault.elm
View File

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