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

LARGE refactor 

This refactor is an improvement on the API architecture:

- Tasks are replaced by Cmd

- Tasks will now always succeed so the Vault can deal with the issues itself

- Failed tasks will be recorded so they can be re-attempted later

- The Snackbar now fully supports editing sub-parts of a data type.
pull/1/head
Bram van den Heuvel 2023-04-19 15:09:10 +02:00
parent 4aaabe3a0a
commit 770423bcd2
18 changed files with 687 additions and 17302 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

288
src/Demos/Cookie.elm
View File

@ -1,288 +0,0 @@
module Demos.Cookie exposing (main)
import Browser
import Dict exposing (Dict)
import Html exposing (Html)
import Html.Attributes
import Html.Events
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Json.Encode as E
import Matrix exposing (VaultUpdate)
import Matrix.Event
import Matrix.Room
import Task
import Time
import Url
main =
Browser.element { init = init, update = update, subscriptions = subscriptions, view = view }
-- MODEL
type Msg
= Login { accessToken : String, baseUrl : String }
| SendEventToRoom String
| SyncVault
| VaultUpdate (Result X.Error Matrix.VaultUpdate)
| WriteAccessToken String
| WriteBaseUrl String
type Model
= LoginMenu { accessToken : String, baseUrl : String }
| CookieView Matrix.Vault
init : () -> ( Model, Cmd Msg )
init _ =
( LoginMenu { accessToken = "", baseUrl = "" }
, Cmd.none
)
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case ( msg, model ) of
( Login data, _ ) ->
let
vault : Matrix.Vault
vault =
Matrix.fromAccessToken data
in
( CookieView vault, Matrix.sync vault |> Task.attempt VaultUpdate )
( VaultUpdate _, LoginMenu _ ) ->
( model, Cmd.none )
( VaultUpdate u, CookieView vault ) ->
case u of
Ok vu ->
( vault
|> Matrix.updateWith vu
|> CookieView
, Cmd.none
)
Err _ ->
( model, Cmd.none )
( SendEventToRoom _, LoginMenu _ ) ->
( model, Cmd.none )
( SendEventToRoom roomId, CookieView vault ) ->
( model
, vault
|> Matrix.getRoomById roomId
|> Maybe.map
(Matrix.Room.sendOneEvent
{ content = E.object [ ( "body", E.string "I sent you a cookie! :)" ) ]
, eventType = "me.noordstar.demo_cookie"
, stateKey = Nothing
}
>> Task.attempt VaultUpdate
)
|> Maybe.withDefault Cmd.none
)
( SyncVault, LoginMenu _ ) ->
( model, Cmd.none )
( SyncVault, CookieView vault ) ->
( model, Matrix.sync vault |> Task.attempt VaultUpdate )
( WriteAccessToken s, LoginMenu data ) ->
( LoginMenu { data | accessToken = s }, Cmd.none )
( WriteAccessToken _, _ ) ->
( model, Cmd.none )
( WriteBaseUrl s, LoginMenu data ) ->
( LoginMenu { data | baseUrl = s }, Cmd.none )
( WriteBaseUrl _, _ ) ->
( model, Cmd.none )
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
case model of
CookieView _ ->
Time.every 5000 (always SyncVault)
_ ->
Sub.none
-- VIEW
cookies : List Matrix.Room.Room -> Dict String Int
cookies =
let
merge : Matrix.Room.Room -> Dict String Int -> Dict String Int
merge room d =
room
|> Matrix.Room.mostRecentEvents
|> List.filterMap
(\event ->
case Matrix.Event.eventType event of
"me.noordstar.demo_cookie" ->
Just (Matrix.Event.sender event)
_ ->
Nothing
)
|> List.foldl
(\user users ->
case Dict.get user users of
Just i ->
Dict.insert user (i + 1) users
Nothing ->
Dict.insert user 1 users
)
d
in
List.foldl merge Dict.empty
view : Model -> Html Msg
view model =
case model of
LoginMenu ({ accessToken, baseUrl } as data) ->
[ Html.span [] [ Html.text "Homeserver URL:" ]
, Html.input
[ Html.Events.onInput WriteBaseUrl
, Html.Attributes.style "font-size" "20px"
, Html.Attributes.style "width" "80%"
]
[ Html.text baseUrl ]
, Html.span [] [ Html.text "Access token:" ]
, Html.input
[ Html.Events.onInput WriteAccessToken
, Html.Attributes.style "font-size" "20px"
, Html.Attributes.style "width" "80%"
]
[ Html.text accessToken ]
, case ( Url.fromString baseUrl, accessToken ) of
( _, "" ) ->
Html.div [ Html.Attributes.style "height" "30px" ] []
( Nothing, _ ) ->
Html.div [ Html.Attributes.style "height" "30px" ] []
( Just _, _ ) ->
Html.button
[ Html.Attributes.style "font-size" "20px"
, Html.Attributes.style "height" "30px"
, Html.Events.onClick (Login data)
]
[ Html.text "Access" ]
]
|> Html.div
[ Html.Attributes.style "display" "flex"
, Html.Attributes.style "flex-flow" "column nowrap"
, Html.Attributes.style "justify-content" "space-evenly"
, Html.Attributes.style "align-items" "center"
, Html.Attributes.style "font-size" "20px"
, Html.Attributes.style "height" "250px"
, Html.Attributes.style "background-color" "antiquewhite"
]
CookieView vault ->
case Matrix.getRooms vault of
[] ->
Html.text "Loading rooms..."
|> List.singleton
|> Html.div
[ Html.Attributes.style "display" "flex"
, Html.Attributes.style "flex-flow" "column nowrap"
, Html.Attributes.style "justify-content" "space-evenly"
, Html.Attributes.style "align-items" "center"
, Html.Attributes.style "font-size" "20px"
, Html.Attributes.style "background-color" "antiquewhite"
]
_ :: _ ->
[ vault
|> Matrix.getRooms
|> cookies
|> Debug.log "Cookies: "
|> Dict.toList
|> List.map
(\( user, amount ) ->
case amount of
0 ->
user ++ " didn't send you any cookies."
1 ->
user ++ " sent you a cookie! 🍪"
2 ->
user ++ " sent you 2 cookies! 🍪🍪"
_ ->
user ++ " sent you " ++ String.fromInt amount ++ " cookies! 🍪🍪🍪"
)
|> List.map Html.text
|> List.map List.singleton
|> List.map (Html.p [])
|> Html.div []
, vault
|> Matrix.getRooms
|> List.map
(\room ->
let
roomName : String
roomName =
room
|> Matrix.Room.stateEvent { eventType = "m.room.name", stateKey = "" }
|> Maybe.andThen
(\event ->
case D.decodeValue (D.field "name" D.string) (Matrix.Event.content event) of
Ok title ->
Just title
Err _ ->
Nothing
)
|> Maybe.withDefault (Matrix.Room.roomId room)
in
[ Html.text roomName
, Html.text "Click here to send a cookie to everyone in this room!"
]
|> List.map List.singleton
|> List.map (Html.span [])
|> Html.span
[ Html.Events.onClick <| SendEventToRoom <| Matrix.Room.roomId room
, Html.Attributes.style "display" "flex"
, Html.Attributes.style "flex-flow" "column nowrap"
, Html.Attributes.style "justify-content" "space-evenly"
, Html.Attributes.style "margin" "20px"
, Html.Attributes.style "background-color" "beige"
]
)
|> Html.div []
]
|> Html.div
[ Html.Attributes.style "display" "flex"
, Html.Attributes.style "flex-flow" "column nowrap"
, Html.Attributes.style "justify-content" "space-evenly"
, Html.Attributes.style "align-items" "center"
, Html.Attributes.style "font-size" "20px"
, Html.Attributes.style "background-color" "antiquewhite"
]

16474
src/Demos/Cookies.html
View File

File diff suppressed because one or more lines are too long

31
src/Internal/Api/Architecture.md Normal file
View File

@ -0,0 +1,31 @@
# Elm architecture
To support the complex ways that the Matrix API runs, standard Elm tasks have gained an increased amount of complexity.
This effectively:
1. Helps the Elm compiler recognize mistakes.
2. Helps the SDK developer chain multiple tasks together efficiently.
## How the Matrix tasks work
Whenever the user attempts to run a Matrix task, it has two types of information:
### Task input
The task input is input that the function uses to access information. It has the following properties:
- If the task is attempted at a later time, these values will remain unchanged.
- If these values do not exist, the task cannot be executed.
### Context
The context is the bundle of tokens, values and information that the Vault has at the moment. It has the following properties:
- If the task is attempted at a later time, these values will change according to the Vault's latest token collection.
- If these values do not exist, the task can get them as a sub-task before getting the actual data.
## Task chains
A task chain is a chain of tasks that are run in sequential order. Traditionally, in a chain of length `n`, the first `n-1` tasks add information to the context, and the last chain actually runs the task.

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

@ -30,46 +30,95 @@ type as a message to the Credentials to update certain information.
-}
import Http
import Internal.Api.Helpers as Helpers
import Internal.Tools.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
type alias TaskChain u a b =
Context a -> Task X.Error (TaskChainPiece u a b)
type alias TaskChain err u a b =
Context a -> Task (FailedChainPiece err u) (TaskChainPiece u a b)
type alias IdemChain u a =
TaskChain u a a
type alias IdemChain err u a =
TaskChain err u a a
type TaskChainPiece u a b
= TaskChainPiece
type alias CompleteChain u =
TaskChain () u {} {}
type alias TaskChainPiece u a b =
{ contextChange : Context a -> Context b
, messages : List u
}
type alias FailedChainPiece err u =
{ error : err, messages : List u }
{-| Chain two tasks together. The second task will only run if the first one succeeds.
-}
andThen : TaskChain u b c -> TaskChain u a b -> TaskChain u a c
andThen : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
andThen f2 f1 =
\context ->
f1 context
|> Task.andThen
(\(TaskChainPiece old) ->
(\old ->
context
|> old.contextChange
|> f2
|> Task.map
(\(TaskChainPiece new) ->
TaskChainPiece
(\new ->
{ contextChange = old.contextChange >> new.contextChange
, messages = List.append old.messages new.messages
}
)
|> Task.mapError
(\{ error, messages } ->
{ error = error, messages = List.append old.messages messages }
)
)
{-| Same as `andThen`, but the results are placed at the front of the list, rather than at the end.
-}
andBeforeThat : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
andBeforeThat f2 f1 =
\context ->
f1 context
|> Task.andThen
(\old ->
context
|> old.contextChange
|> f2
|> Task.map
(\new ->
{ contextChange = old.contextChange >> new.contextChange
, messages = List.append new.messages old.messages
}
)
|> Task.mapError
(\{ error, messages } ->
{ error = error, messages = List.append messages old.messages }
)
)
{-| When an error has occurred, "fix" it with the following function.
-}
catchWith : (err -> TaskChainPiece u a b) -> TaskChain err u a b -> TaskChain err u a b
catchWith onErr f =
onError (\e -> succeed <| onErr e) f
{-| Create a task chain that always fails.
-}
fail : err -> TaskChain err u a b
fail e _ =
Task.fail { error = e, messages = [] }
{-| Optionally run a task that may provide additional information.
@ -80,46 +129,119 @@ without needlessly breaking the whole chain if anything breaks in here.
You cannot use this function to execute a task chain that adds or removes context.
-}
maybe : IdemChain u a -> IdemChain u a
maybe : IdemChain err u a -> IdemChain err u a
maybe f =
{ contextChange = identity
, messages = []
}
|> TaskChainPiece
|> Task.succeed
|> succeed
|> always
|> Task.onError
|> (>>) f
|> onError
|> (|>) f
{-| If the TaskChain fails, run this task otherwise.
{-| Map a value to a different one.
-}
otherwise : TaskChain u a b -> TaskChain u a b -> TaskChain u a b
map : (u1 -> u2) -> TaskChain err u1 a b -> TaskChain err u2 a b
map m f =
\context ->
f context
|> Task.map
(\{ contextChange, messages } ->
{ contextChange = contextChange, messages = List.map m messages }
)
|> Task.mapError
(\{ error, messages } ->
{ error = error, messages = List.map m messages }
)
{-| If the TaskChain errfails, run this task otherwise.
-}
otherwise : TaskChain err u a b -> TaskChain e u a b -> TaskChain err u a b
otherwise f2 f1 context =
Task.onError (always <| f2 context) (f1 context)
{-| If all else fails, you can also just add the failing part to the succeeding part.
-}
otherwiseFail : IdemChain err u a -> IdemChain err (Result err u) a
otherwiseFail =
map Ok
>> catchWith
(\err ->
{ contextChange = identity
, messages = [ Err err ]
}
)
{-| If an error is raised, deal with it accordingly.
-}
onError : (err -> TaskChain err2 u a b) -> TaskChain err u a b -> TaskChain err2 u a b
onError onErr f =
\context ->
f context
|> Task.onError
(\{ error, messages } ->
succeed { contextChange = identity, messages = messages }
|> andThen (onErr error)
|> (|>) context
)
{-| Create a task chain that always succeeds.
-}
succeed : { contextChange : Context a -> Context b, messages : List u } -> TaskChain err u a b
succeed d _ =
Task.succeed d
{-| Once all the pieces of the chain have been assembled, you can turn it into a task.
The compiler will fail if the chain is missing a vital piece of information.
-}
toTask : TaskChain u {} b -> Task X.Error (List u)
toTask : TaskChain err u {} b -> Task (FailedChainPiece err u) (List u)
toTask f1 =
Context.init
|> f1
|> Task.map
(\(TaskChainPiece data) ->
data.messages
)
|> Task.map .messages
{-| If the TaskChain fails, this function will get it to retry.
{-| If the TaskChain errfails, this function will get it to retry.
When set to 1 or lower, the task will only try once.
-}
tryNTimes : Int -> TaskChain u a b -> TaskChain u a b
tryNTimes n f context =
f context
|> Helpers.retryTask (n - 1)
tryNTimes : Int -> TaskChain X.Error u a b -> TaskChain X.Error u a b
tryNTimes n f =
if n <= 0 then
f
else
onError
(\e ->
case e of
X.InternetException (Http.BadUrl _) ->
fail e
X.InternetException _ ->
tryNTimes (n - 1) f
X.SDKException (X.ServerReturnsBadJSON _) ->
tryNTimes (n - 1) f
X.SDKException _ ->
fail e
X.ServerException _ ->
fail e
X.ContextFailed _ ->
fail e
X.UnsupportedSpecVersion ->
fail e
)
f

91
src/Internal/Api/Credentials.elm
View File

@ -1,91 +0,0 @@
module Internal.Api.Credentials exposing (..)
{-| The `Credentials` type stitches the Vault together to the Matrix API.
It stores tokens and values needed to interact with the API, and it provides
the necessary context when the user aims to talk to the Matrix API.
-}
import Internal.Api.Versions.V1.Versions as V
import Internal.Tools.LoginValues as Login exposing (AccessToken(..))
type Credentials
= Credentials
{ access : AccessToken
, homeserver : String
, vs : Maybe V.Versions
}
{-| Retrieves the access token from a given `Credentials` value.
-}
accessToken : Credentials -> AccessToken
accessToken (Credentials { access }) =
access
{-| Retrieves the access token type without the access token value in case the value is no longer valid.
-}
refreshedAccessToken : Credentials -> AccessToken
refreshedAccessToken (Credentials { access }) =
Login.removeToken access
{-| Add a new access token to the `Credentials` type.
-}
addToken : String -> Credentials -> Credentials
addToken token (Credentials ({ access } as data)) =
Credentials { data | access = Login.addToken token access }
{-| Add a username and password to the `Credentials` type.
-}
addUsernameAndPassword : { username : String, password : String } -> Credentials -> Credentials
addUsernameAndPassword uap (Credentials ({ access } as data)) =
Credentials { data | access = Login.addUsernameAndPassword uap access }
{-| Add known spec versions to the `Credentials` type.
-}
addVersions : V.Versions -> Credentials -> Credentials
addVersions vs (Credentials data) =
Credentials { data | vs = Just vs }
{-| Add whoami to the `Credentials` type to identify the user.
-}
addWhoAmI : { a | userId : String, deviceId : Maybe String } -> Credentials -> Credentials
addWhoAmI whoami (Credentials ({ access } as data)) =
Credentials { data | access = Login.addWhoAmI whoami access }
{-| Retrieves the base url from a given `Credentials` value.
-}
baseUrl : Credentials -> String
baseUrl (Credentials { homeserver }) =
homeserver
{-| Creates a `Credentials` value from a base URL.
-}
fromBaseUrl : String -> Credentials
fromBaseUrl url =
Credentials
{ access = NoAccess
, homeserver = url
, vs = Nothing
}
{-| Get the user id registered by the `Credentials` type.
-}
getUserId : Credentials -> Maybe String
getUserId (Credentials { access }) =
Login.getUserId access
{-| Retrieves the spec versions from a given `Credentials` value.
-}
versions : Credentials -> Maybe V.Versions
versions (Credentials { vs }) =
vs

3
src/Internal/Api/Helpers.elm
View File

@ -73,6 +73,9 @@ retryTask n task =
X.ServerException _ ->
Task.fail err
X.ContextFailed _ ->
Task.fail err
X.UnsupportedSpecVersion ->
Task.fail err
)

82
src/Internal/Api/Snackbar.elm
View File

@ -12,99 +12,149 @@ without needing to update every data type whenever any of the tokens change.
-}
import Dict exposing (Dict)
import Internal.Api.Versions.V1.Versions as V
import Internal.Tools.LoginValues as Login exposing (AccessToken(..))
import Task exposing (Task)
type Snackbar a
type Snackbar a vu
= Snackbar
{ access : AccessToken
, content : a
, failedTasks : Dict Int ( String, Snackbar () vu -> Task Never vu )
, failedTasksOffset : Int
, homeserver : String
, transactionOffset : Int
, vs : Maybe V.Versions
}
accessToken : Snackbar a -> AccessToken
accessToken : Snackbar a vu -> AccessToken
accessToken (Snackbar { access }) =
access
addToken : String -> Snackbar a -> Snackbar a
addFailedTask : (Int -> ( String, Snackbar () vu -> Task Never vu )) -> Snackbar a vu -> Snackbar a vu
addFailedTask taskWithId (Snackbar ({ failedTasks, failedTasksOffset } as data)) =
Snackbar
{ data
| failedTasks = Dict.insert failedTasksOffset (taskWithId failedTasksOffset) failedTasks
, failedTasksOffset = failedTasksOffset + 1
}
addToken : String -> Snackbar a vu -> Snackbar a vu
addToken token (Snackbar ({ access } as data)) =
Snackbar { data | access = Login.addToken token access }
addUsernameAndPassword : { username : String, password : String } -> Snackbar a -> Snackbar a
addUsernameAndPassword : { username : String, password : String } -> Snackbar a vu -> Snackbar a vu
addUsernameAndPassword uap (Snackbar ({ access } as data)) =
Snackbar { data | access = Login.addUsernameAndPassword uap access }
addVersions : V.Versions -> Snackbar a -> Snackbar a
addVersions : V.Versions -> Snackbar a vu -> Snackbar a vu
addVersions vs (Snackbar data) =
Snackbar { data | vs = Just vs }
addWhoAmI : { w | userId : String, deviceId : Maybe String } -> Snackbar a -> Snackbar a
addWhoAmI : { w | userId : String, deviceId : Maybe String } -> Snackbar a vu -> Snackbar a vu
addWhoAmI whoami (Snackbar ({ access } as data)) =
Snackbar { data | access = Login.addWhoAmI whoami access }
baseUrl : Snackbar a -> String
baseUrl : Snackbar a vu -> String
baseUrl (Snackbar { homeserver }) =
homeserver
init : { baseUrl : String, content : a } -> Snackbar a
errors : Snackbar a vu -> List String
errors (Snackbar { failedTasks }) =
Dict.values failedTasks |> List.map Tuple.first
getFailedTasks : Snackbar a vu -> List (Snackbar () vu -> Task Never vu)
getFailedTasks (Snackbar { failedTasks }) =
Dict.values failedTasks |> List.map Tuple.second
getTransactionOffset : Snackbar a vu -> Int
getTransactionOffset (Snackbar { transactionOffset }) =
transactionOffset
init : { baseUrl : String, content : a } -> Snackbar a vu
init data =
Snackbar
{ access = NoAccess
, content = data.content
, failedTasks = Dict.empty
, failedTasksOffset = 0
, homeserver = data.baseUrl
, transactionOffset = 0
, vs = Nothing
}
map : (a -> b) -> Snackbar a -> Snackbar b
map : (a -> b) -> Snackbar a vu -> Snackbar b vu
map f (Snackbar data) =
Snackbar
{ access = data.access
, content = f data.content
, failedTasks = data.failedTasks
, failedTasksOffset = 0
, homeserver = data.homeserver
, transactionOffset = data.transactionOffset
, vs = data.vs
}
mapList : (a -> List b) -> Snackbar a -> List (Snackbar b)
mapList : (a -> List b) -> Snackbar a vu -> List (Snackbar b vu)
mapList f (Snackbar data) =
List.map (withCandyFrom (Snackbar data)) (f data.content)
mapMaybe : (a -> Maybe b) -> Snackbar a -> Maybe (Snackbar b)
mapMaybe : (a -> Maybe b) -> Snackbar a vu -> Maybe (Snackbar b vu)
mapMaybe f (Snackbar data) =
Maybe.map (withCandyFrom (Snackbar data)) (f data.content)
removedAccessToken : Snackbar a -> AccessToken
removedAccessToken : Snackbar a vu -> AccessToken
removedAccessToken (Snackbar { access }) =
Login.removeToken access
userId : Snackbar a -> Maybe String
removeFailedTask : Int -> Snackbar a vu -> Snackbar a vu
removeFailedTask i (Snackbar ({ failedTasks } as data)) =
Snackbar { data | failedTasks = Dict.remove i failedTasks }
setTransactionOffset : Int -> Snackbar a vu -> Snackbar a vu
setTransactionOffset i (Snackbar data) =
Snackbar { data | transactionOffset = max (data.transactionOffset + 1) (i + 1) }
userId : Snackbar a vu -> Maybe String
userId (Snackbar { access }) =
Login.getUserId access
versions : Snackbar a -> Maybe V.Versions
versions : Snackbar a vu -> Maybe V.Versions
versions (Snackbar { vs }) =
vs
withCandyFrom : Snackbar b -> a -> Snackbar a
withCandyFrom : Snackbar b vu -> a -> Snackbar a vu
withCandyFrom snackbar x =
map (always x) snackbar
withoutCandy : Snackbar a -> a
withoutCandy : Snackbar a vu -> a
withoutCandy (Snackbar { content }) =
content
withoutContent : Snackbar a vu -> Snackbar () vu
withoutContent =
map (always ())

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

@ -13,9 +13,9 @@ import Internal.Api.JoinedMembers.Main exposing (JoinedMembersInput)
import Internal.Api.Leave.Main exposing (LeaveInput)
import Internal.Api.SendStateKey.Main exposing (SendStateKeyInput)
import Internal.Api.SetAccountData.Main exposing (SetAccountInput)
import Internal.Api.Snackbar as Snackbar exposing (Snackbar)
import Internal.Api.Snackbar as Snackbar
import Internal.Api.Sync.Main exposing (SyncInput)
import Internal.Api.VaultUpdate as C
import Internal.Api.VaultUpdate as C exposing (Vnackbar)
import Json.Encode as E
@ -29,47 +29,55 @@ type alias EventInput =
}
getEvent : EventInput -> Snackbar a -> FutureTask
getEvent : EventInput -> Vnackbar a -> FutureTask
getEvent { eventId, roomId } cred =
C.makeVBA cred
|> Chain.andThen (C.withSentEvent eventId)
|> Chain.andThen (C.getEvent { roomId = roomId })
|> C.toTask
C.toTask
("Get event `" ++ eventId ++ "` from room `" ++ roomId ++ "`")
(C.makeVBA
>> Chain.andThen (C.withSentEvent eventId)
>> Chain.andThen (C.getEvent { roomId = roomId })
)
(Snackbar.withoutContent cred)
getMessages : GetMessagesInput -> Snackbar a -> FutureTask
getMessages : GetMessagesInput -> Vnackbar a -> FutureTask
getMessages data cred =
C.makeVBA cred
|> Chain.andThen (C.getMessages data)
|> C.toTask
C.toTask
("Get messages from room `" ++ data.roomId ++ "`")
(C.makeVBA >> Chain.andThen (C.getMessages data))
(Snackbar.withoutContent cred)
invite : InviteInput -> Snackbar a -> FutureTask
invite : InviteInput -> Vnackbar a -> FutureTask
invite data cred =
C.makeVBA cred
|> Chain.andThen (C.invite data)
|> C.toTask
C.toTask
("Invite user " ++ data.userId ++ " to room " ++ data.roomId)
(C.makeVBA >> Chain.andThen (C.invite data))
(Snackbar.withoutContent cred)
joinedMembers : JoinedMembersInput -> Snackbar a -> FutureTask
joinedMembers : JoinedMembersInput -> Vnackbar a -> FutureTask
joinedMembers data cred =
C.makeVBA cred
|> Chain.andThen (C.joinedMembers data)
|> C.toTask
C.toTask
("Get a list of joined members from room " ++ data.roomId)
(C.makeVBA >> Chain.andThen (C.joinedMembers data))
(Snackbar.withoutContent cred)
joinRoomById : JoinRoomByIdInput -> Snackbar a -> FutureTask
joinRoomById : JoinRoomByIdInput -> Vnackbar a -> FutureTask
joinRoomById data cred =
C.makeVBA cred
|> Chain.andThen (C.joinRoomById data)
|> C.toTask
C.toTask
("Join room " ++ data.roomId ++ "by its room id")
(C.makeVBA >> Chain.andThen (C.joinRoomById data))
(Snackbar.withoutContent cred)
leave : LeaveInput -> Snackbar a -> FutureTask
leave : LeaveInput -> Vnackbar a -> FutureTask
leave data cred =
C.makeVBA cred
|> Chain.andThen (C.leave data)
|> C.toTask
C.toTask
("Leave room " ++ data.roomId)
(C.makeVBA >> Chain.andThen (C.leave data))
(Snackbar.withoutContent cred)
type alias RedactInput =
@ -80,10 +88,11 @@ type alias RedactInput =
}
redact : RedactInput -> Snackbar a -> FutureTask
redact : RedactInput -> Vnackbar a -> FutureTask
redact { eventId, extraTransactionNoise, reason, roomId } cred =
cred
|> C.makeVBAT
C.toTask
("Redact event " ++ eventId ++ " from room " ++ roomId)
(C.makeVBAT
(\now ->
[ Hash.fromInt now
, Hash.fromString eventId
@ -94,11 +103,12 @@ redact { eventId, extraTransactionNoise, reason, roomId } cred =
|> List.foldl Hash.independent (Hash.fromString "redact")
|> Hash.toString
)
|> Chain.andThen (C.redact { eventId = eventId, reason = reason, roomId = roomId })
|> Chain.andThen (C.withSentEvent eventId)
|> Chain.andThen
>> Chain.andThen (C.redact { eventId = eventId, reason = reason, roomId = roomId })
>> Chain.andThen (C.withSentEvent eventId)
>> Chain.andThen
(Chain.maybe <| C.getEvent { roomId = roomId })
|> C.toTask
)
(Snackbar.withoutContent cred)
type alias SendMessageEventInput =
@ -109,10 +119,11 @@ type alias SendMessageEventInput =
}
sendMessageEvent : SendMessageEventInput -> Snackbar a -> FutureTask
sendMessageEvent : SendMessageEventInput -> Vnackbar a -> FutureTask
sendMessageEvent { content, eventType, extraTransactionNoise, roomId } cred =
cred
|> C.makeVBAT
C.toTask
("Send a message event to room " ++ roomId ++ " with event type " ++ eventType)
(C.makeVBAT
(\now ->
[ Hash.fromInt now
, Hash.fromString (E.encode 0 content)
@ -123,41 +134,59 @@ sendMessageEvent { content, eventType, extraTransactionNoise, roomId } cred =
|> List.foldl Hash.independent (Hash.fromString "send message")
|> Hash.toString
)
|> Chain.andThen C.getTimestamp
|> Chain.andThen (C.sendMessageEvent { content = content, eventType = eventType, roomId = roomId })
|> Chain.andThen
>> Chain.andThen C.getTimestamp
>> Chain.andThen (C.sendMessageEvent { content = content, eventType = eventType, roomId = roomId })
>> Chain.andThen
(Chain.maybe <| C.getEvent { roomId = roomId })
|> C.toTask
)
(Snackbar.withoutContent cred)
sendStateEvent : SendStateKeyInput -> Snackbar a -> FutureTask
sendStateEvent : SendStateKeyInput -> Vnackbar a -> FutureTask
sendStateEvent data cred =
C.makeVBA cred
|> Chain.andThen C.getTimestamp
|> Chain.andThen (C.sendStateEvent data)
|> Chain.andThen
C.toTask
("Send a state event to room " ++ data.roomId ++ " with event type " ++ data.eventType)
(C.makeVBA
>> Chain.andThen C.getTimestamp
>> Chain.andThen (C.sendStateEvent data)
>> Chain.andThen
(Chain.maybe <| C.getEvent { roomId = data.roomId })
|> C.toTask
)
(Snackbar.withoutContent cred)
setAccountData : SetAccountInput -> Snackbar a -> FutureTask
setAccountData : SetAccountInput -> Vnackbar a -> FutureTask
setAccountData data cred =
C.makeVBA cred
|> Chain.andThen (C.setAccountData data)
|> C.toTask
C.toTask
("Set account data "
++ data.eventType
++ (case data.roomId of
Just r ->
" in room " ++ r
Nothing ->
" in main account"
)
)
(C.makeVBA >> Chain.andThen (C.setAccountData data))
(Snackbar.withoutContent cred)
sync : SyncInput -> Snackbar a -> FutureTask
sync : SyncInput -> Vnackbar a -> FutureTask
sync data cred =
C.makeVBA cred
|> Chain.andThen (C.sync data)
|> C.toTask
C.toTask
"Sync Vault"
(C.makeVBA >> Chain.andThen (C.sync data))
(Snackbar.withoutContent cred)
loginMaybeSync : SyncInput -> Snackbar a -> FutureTask
loginMaybeSync : SyncInput -> Vnackbar a -> FutureTask
loginMaybeSync data cred =
C.makeVB cred
|> Chain.andThen (C.accessToken (Snackbar.removedAccessToken cred))
|> Chain.andThen
C.toTask
"Log in again, then sync Vault"
(C.makeVB
>> Chain.andThen (C.accessToken (Snackbar.removedAccessToken cred))
>> Chain.andThen
(Chain.maybe <| C.sync data)
|> C.toTask
)
(Snackbar.withoutContent cred)

199
src/Internal/Api/VaultUpdate.elm
View File

@ -26,8 +26,14 @@ import Task exposing (Task)
import Time
type alias Vnackbar a =
Snackbar a VaultUpdate
type VaultUpdate
= MultipleUpdates (List VaultUpdate)
-- When a task fails, it is usually reported here
| TaskFailed String (Vnackbar () -> Task Never VaultUpdate)
-- Updates as a result of API calls
| AccountDataSet SetAccountData.SetAccountInput SetAccountData.SetAccountOutput
| BanUser Ban.BanInput Ban.BanOutput
@ -43,30 +49,39 @@ type VaultUpdate
| RedactedEvent Redact.RedactInput Redact.RedactOutput
| StateEventSent SendStateKey.SendStateKeyInput SendStateKey.SendStateKeyOutput
| SyncUpdate Sync.SyncInput Sync.SyncOutput
-- Updates as a result of getting data early
-- Updates as a result of getting context information
| UpdateAccessToken String
| UpdateVersions V.Versions
| UpdateWhoAmI WhoAmI.WhoAmIOutput
| RemoveFailedTask Int
type alias FutureTask =
Task X.Error VaultUpdate
Task Never VaultUpdate
{-| Turn an API Task into a taskchain.
-}
toChain : (cout -> Chain.TaskChainPiece VaultUpdate ph1 ph2) -> (Context.Context ph1 -> cin -> Task X.Error cout) -> cin -> TaskChain VaultUpdate ph1 ph2
toChain transform task input context =
toChain : (Context.Context ph1 -> cin -> Task err cout) -> cin -> (cout -> Chain.TaskChainPiece VaultUpdate ph1 ph2) -> TaskChain err VaultUpdate ph1 ph2
toChain task input transform context =
task context input
|> Task.map transform
|> Task.mapError (\e -> { error = e, messages = [] })
{-| Turn a chain of tasks into a full executable task.
-}
toTask : TaskChain VaultUpdate {} b -> FutureTask
toTask =
Chain.toTask
>> Task.map
toTask : String -> (Vnackbar () -> TaskChain X.Error VaultUpdate {} b) -> Vnackbar () -> Task Never VaultUpdate
toTask debugText f snackbar =
f snackbar
|> Chain.toTask
|> Task.onError
(\{ messages } ->
TaskFailed debugText (toTask debugText f)
:: messages
|> Task.succeed
)
|> Task.map
(\updates ->
case updates of
[ item ] ->
@ -79,33 +94,26 @@ toTask =
{-| Get a functional access token.
-}
accessToken : AccessToken -> TaskChain VaultUpdate (VB a) (VBA { a | userId : () })
accessToken : AccessToken -> TaskChain X.Error VaultUpdate (VB a) (VBA { a | userId : () })
accessToken ctoken =
case ctoken of
NoAccess ->
X.NoAccessToken
|> X.SDKException
|> Task.fail
|> always
Chain.fail (X.SDKException X.NoAccessToken)
RawAccessToken t ->
{ contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing }
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
|> Chain.succeed
|> Chain.andThen getWhoAmI
DetailedAccessToken data ->
Chain.succeed
{ contextChange =
Context.setAccessToken { accessToken = data.accessToken, loginParts = Nothing }
>> Context.setUserId data.userId
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
UsernameAndPassword { username, password, token, deviceId, initialDeviceDisplayName, userId } ->
case token of
@ -113,18 +121,16 @@ accessToken ctoken =
{ contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing }
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
|> Chain.succeed
|> Chain.andThen (whoAmI userId)
Nothing ->
loginWithUsernameAndPassword
{ username = username
, password = password
, deviceId = deviceId
, initialDeviceDisplayName = initialDeviceDisplayName
}
|> loginWithUsernameAndPassword
|> Chain.andThen
(case userId of
Just user ->
@ -137,151 +143,142 @@ accessToken ctoken =
{-| Ban a user from a room.
-}
ban : Ban.BanInput -> IdemChain VaultUpdate (VBA a)
ban : Ban.BanInput -> IdemChain X.Error VaultUpdate (VBA a)
ban input =
toChain
Ban.ban
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ BanUser input output ]
}
)
Ban.ban
input
{-| Get an event from the API.
-}
getEvent : GetEvent.EventInput -> IdemChain VaultUpdate (VBA { a | sentEvent : () })
getEvent : GetEvent.EventInput -> IdemChain X.Error VaultUpdate (VBA { a | sentEvent : () })
getEvent input =
toChain
GetEvent.getEvent
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ GetEvent input output ]
}
)
GetEvent.getEvent
input
{-| Get a list of messages from a room.
-}
getMessages : GetMessages.GetMessagesInput -> IdemChain VaultUpdate (VBA a)
getMessages : GetMessages.GetMessagesInput -> IdemChain X.Error VaultUpdate (VBA a)
getMessages input =
toChain
GetMessages.getMessages
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ GetMessages input output ]
}
)
GetMessages.getMessages
input
getTimestamp : TaskChain VaultUpdate a { a | timestamp : () }
getTimestamp : TaskChain err VaultUpdate a { a | timestamp : () }
getTimestamp =
toChain
(always <| always Time.now)
()
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setTimestamp output
, messages = [ CurrentTimestamp output ]
}
)
(always <| always Time.now)
()
{-| Get the supported spec versions from the homeserver.
-}
getVersions : TaskChain VaultUpdate { a | baseUrl : () } (VB a)
getVersions : TaskChain X.Error VaultUpdate { a | baseUrl : () } (VB a)
getVersions =
toChain
(\context _ -> Versions.getVersions context)
()
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setVersions output.versions
, messages = [ UpdateVersions output ]
}
)
(\context _ -> Versions.getVersions context)
()
{-| Get a whoami to gain someone's identity.
-}
getWhoAmI : TaskChain VaultUpdate (VBA a) (VBA { a | userId : () })
getWhoAmI : TaskChain X.Error VaultUpdate (VBA a) (VBA { a | userId : () })
getWhoAmI =
toChain
WhoAmI.whoAmI
()
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setUserId output.userId
, messages = [ UpdateWhoAmI output ]
}
)
WhoAmI.whoAmI
()
{-| Invite a user to a room.
-}
invite : Invite.InviteInput -> IdemChain VaultUpdate (VBA a)
invite : Invite.InviteInput -> IdemChain X.Error VaultUpdate (VBA a)
invite input =
toChain
Invite.invite
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ InviteSent input output ]
}
)
Invite.invite
input
joinedMembers : JoinedMembers.JoinedMembersInput -> IdemChain VaultUpdate (VBA a)
joinedMembers : JoinedMembers.JoinedMembersInput -> IdemChain X.Error VaultUpdate (VBA a)
joinedMembers input =
toChain
JoinedMembers.joinedMembers
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ JoinedMembersToRoom input output ]
}
)
JoinedMembers.joinedMembers
input
joinRoomById : JoinRoomById.JoinRoomByIdInput -> IdemChain VaultUpdate (VBA a)
joinRoomById : JoinRoomById.JoinRoomByIdInput -> IdemChain X.Error VaultUpdate (VBA a)
joinRoomById input =
toChain
JoinRoomById.joinRoomById
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ JoinedRoom input output ]
}
)
JoinRoomById.joinRoomById
input
leave : Leave.LeaveInput -> IdemChain VaultUpdate (VBA a)
leave : Leave.LeaveInput -> IdemChain X.Error VaultUpdate (VBA a)
leave input =
toChain
Leave.leave
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ LeftRoom input output ]
}
)
Leave.leave
input
loginWithUsernameAndPassword : LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput -> TaskChain VaultUpdate (VB a) (VBA a)
loginWithUsernameAndPassword : LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput -> TaskChain X.Error VaultUpdate (VB a) (VBA a)
loginWithUsernameAndPassword input =
toChain
LoginWithUsernameAndPassword.loginWithUsernameAndPassword
input
(\output ->
Chain.TaskChainPiece
{ contextChange =
Context.setAccessToken
{ accessToken = output.accessToken
@ -290,32 +287,40 @@ loginWithUsernameAndPassword input =
, messages = [ LoggedInWithUsernameAndPassword input output ]
}
)
LoginWithUsernameAndPassword.loginWithUsernameAndPassword
input
{-| Make a VB-context based chain.
-}
makeVB : Snackbar a -> TaskChain VaultUpdate {} (VB {})
makeVB : Vnackbar a -> TaskChain X.Error VaultUpdate {} (VB {})
makeVB snackbar =
snackbar
|> Snackbar.baseUrl
|> withBaseUrl
|> Chain.andThen (versions (Snackbar.versions snackbar))
|> Chain.onError (\e -> Chain.fail (X.ContextFailed <| X.FailedVersions e))
{-| Make a VBA-context based chain.
-}
makeVBA : Snackbar a -> TaskChain VaultUpdate {} (VBA { userId : () })
makeVBA : Vnackbar a -> TaskChain X.Error VaultUpdate {} (VBA { userId : () })
makeVBA snackbar =
snackbar
|> makeVB
|> Chain.andThen (accessToken (Snackbar.accessToken snackbar))
|> Chain.onError
(\e ->
case e of
X.ContextFailed _ ->
Chain.fail e
_ ->
Chain.fail <| X.ContextFailed <| X.FailedAccessToken e
)
{-| Make a VBAT-context based chain.
-}
makeVBAT : (Int -> String) -> Snackbar a -> TaskChain VaultUpdate {} (VBAT { userId : () })
makeVBAT : (Int -> String) -> Vnackbar a -> TaskChain X.Error VaultUpdate {} (VBAT { userId : () })
makeVBAT toString snackbar =
snackbar
|> makeVBA
@ -324,83 +329,78 @@ makeVBAT toString snackbar =
{-| Redact an event from a room.
-}
redact : Redact.RedactInput -> TaskChain VaultUpdate (VBAT a) (VBA a)
redact : Redact.RedactInput -> TaskChain X.Error VaultUpdate (VBAT a) (VBA a)
redact input =
toChain
Redact.redact
input
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId
, messages = [ RedactedEvent input output ]
}
)
Redact.redact
input
|> Chain.tryNTimes 5
{-| Send a message event to a room.
-}
sendMessageEvent : SendMessageEvent.SendMessageEventInput -> TaskChain VaultUpdate (VBAT { a | timestamp : () }) (VBA { a | sentEvent : (), timestamp : () })
sendMessageEvent : SendMessageEvent.SendMessageEventInput -> TaskChain X.Error VaultUpdate (VBAT { a | timestamp : () }) (VBA { a | sentEvent : (), timestamp : () })
sendMessageEvent input =
toChain
SendMessageEvent.sendMessageEvent
input
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId >> Context.setSentEvent output.eventId
, messages = [ MessageEventSent input output ]
}
)
SendMessageEvent.sendMessageEvent
input
|> Chain.tryNTimes 5
{-| Send a state key event to a room.
-}
sendStateEvent : SendStateKey.SendStateKeyInput -> TaskChain VaultUpdate (VBA { a | timestamp : () }) (VBA { a | sentEvent : (), timestamp : () })
sendStateEvent : SendStateKey.SendStateKeyInput -> TaskChain X.Error VaultUpdate (VBA { a | timestamp : () }) (VBA { a | sentEvent : (), timestamp : () })
sendStateEvent input =
toChain
SendStateKey.sendStateKey
input
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setSentEvent output.eventId
, messages = [ StateEventSent input output ]
}
)
SendStateKey.sendStateKey
input
|> Chain.tryNTimes 5
setAccountData : SetAccountData.SetAccountInput -> IdemChain VaultUpdate (VBA { a | userId : () })
setAccountData : SetAccountData.SetAccountInput -> IdemChain X.Error VaultUpdate (VBA { a | userId : () })
setAccountData input =
toChain
SetAccountData.setAccountData
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ AccountDataSet input output ]
}
)
SetAccountData.setAccountData
input
{-| Sync the latest updates.
-}
sync : Sync.SyncInput -> IdemChain VaultUpdate (VBA a)
sync : Sync.SyncInput -> IdemChain X.Error VaultUpdate (VBA a)
sync input =
toChain
Sync.sync
input
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ SyncUpdate input output ]
}
)
Sync.sync
input
{-| Insert versions, or get them if they are not provided.
-}
versions : Maybe V.Versions -> TaskChain VaultUpdate { a | baseUrl : () } (VB a)
versions : Maybe V.Versions -> TaskChain X.Error VaultUpdate { a | baseUrl : () } (VB a)
versions mVersions =
(case mVersions of
Just vs ->
@ -414,7 +414,7 @@ versions mVersions =
{-| Create a task to get a user's identity, if it is unknown.
-}
whoAmI : Maybe String -> TaskChain VaultUpdate (VBA a) (VBA { a | userId : () })
whoAmI : Maybe String -> TaskChain X.Error VaultUpdate (VBA a) (VBA { a | userId : () })
whoAmI muserId =
case muserId of
Just userId ->
@ -426,31 +426,29 @@ whoAmI muserId =
{-| Create a task that insert the base URL into the context.
-}
withBaseUrl : String -> TaskChain VaultUpdate a { a | baseUrl : () }
withBaseUrl : String -> TaskChain err VaultUpdate a { a | baseUrl : () }
withBaseUrl baseUrl =
{ contextChange = Context.setBaseUrl baseUrl
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
{-| Create a task that inserts an event id into the context, as if it were just sent.
-}
withSentEvent : String -> TaskChain VaultUpdate a { a | sentEvent : () }
withSentEvent : String -> TaskChain err VaultUpdate a { a | sentEvent : () }
withSentEvent sentEvent =
{ contextChange = Context.setSentEvent sentEvent
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
{-| Create a task that inserts a transaction id into the context.
-}
withTransactionId : (Int -> String) -> TaskChain VaultUpdate a { a | transactionId : () }
withTransactionId : (Int -> String) -> TaskChain err VaultUpdate a { a | transactionId : () }
withTransactionId toString =
Time.now
|> Task.map
@ -462,28 +460,25 @@ withTransactionId toString =
|> Context.setTransactionId
, messages = []
}
|> Chain.TaskChainPiece
)
|> always
withUserId : String -> TaskChain VaultUpdate a { a | userId : () }
withUserId : String -> TaskChain err VaultUpdate a { a | userId : () }
withUserId userId =
{ contextChange = Context.setUserId userId
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always
{-| Create a task that inserts versions into the context.
-}
withVersions : V.Versions -> TaskChain VaultUpdate a { a | versions : () }
withVersions : V.Versions -> TaskChain err VaultUpdate a { a | versions : () }
withVersions vs =
{ contextChange = Context.setVersions vs.versions
, messages = []
}
|> Chain.TaskChainPiece
|> Task.succeed
|> always

5
src/Internal/Event.elm
View File

@ -10,8 +10,9 @@ resend other events or forward them elsewhere.
import Internal.Api.GetEvent.Main as GetEvent
import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO
import Internal.Api.GetMessages.V4.SpecObjects as GetMessagesSO
import Internal.Api.Snackbar as Snackbar exposing (Snackbar)
import Internal.Api.Snackbar as Snackbar
import Internal.Api.Sync.V2.SpecObjects as SyncSO
import Internal.Api.VaultUpdate exposing (Vnackbar)
import Internal.Tools.Timestamp exposing (Timestamp)
import Internal.Values.Event as Internal
import Json.Encode as E
@ -20,7 +21,7 @@ import Json.Encode as E
{-| The central event type. This type will be used by the user and will be directly interacted with.
-}
type alias Event =
Snackbar Internal.IEvent
Vnackbar Internal.IEvent
{-| Create an internal event type from an API endpoint event object.

19
src/Internal/Invite.elm
View File

@ -3,26 +3,26 @@ module Internal.Invite exposing (..)
{-| An invite is an Elm type that informs the user they've been invited to a room.
-}
import Internal.Api.Snackbar as Snackbar exposing (Snackbar)
import Internal.Api.Snackbar as Snackbar
import Internal.Api.Sync.V2.SpecObjects exposing (StrippedStateEvent)
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Tools.Exceptions as X
import Internal.Api.VaultUpdate exposing (VaultUpdate(..), Vnackbar)
import Internal.Values.RoomInvite as Internal
import Task exposing (Task)
import Task
type alias RoomInvite =
Snackbar Internal.IRoomInvite
Vnackbar Internal.IRoomInvite
accept : { invite : RoomInvite, reason : Maybe String } -> Task X.Error VaultUpdate
accept { invite, reason } =
accept : { invite : RoomInvite, reason : Maybe String, onResponse : VaultUpdate -> msg } -> Cmd msg
accept { invite, reason, onResponse } =
Api.joinRoomById
{ roomId = roomId invite
, reason = reason
}
invite
|> Task.perform onResponse
roomId : RoomInvite -> String
@ -47,10 +47,11 @@ initFromStrippedStateEvent =
{-| Reject the invite and do not join the room.
-}
reject : { invite : RoomInvite, reason : Maybe String } -> Task X.Error VaultUpdate
reject { invite, reason } =
reject : { invite : RoomInvite, reason : Maybe String, onResponse : VaultUpdate -> msg } -> Cmd msg
reject { invite, reason, onResponse } =
Api.leave
{ roomId = roomId invite
, reason = reason
}
invite
|> Task.perform onResponse

50
src/Internal/Room.elm
View File

@ -4,12 +4,11 @@ module Internal.Room exposing (..)
-}
import Dict
import Internal.Api.Snackbar as Snackbar exposing (Snackbar)
import Internal.Api.Snackbar as Snackbar
import Internal.Api.Sync.V2.SpecObjects as Sync
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Api.VaultUpdate exposing (VaultUpdate(..), Vnackbar)
import Internal.Event as Event exposing (Event)
import Internal.Tools.Exceptions as X
import Internal.Tools.Hashdict as Hashdict
import Internal.Tools.SpecEnums as Enums
import Internal.Values.Event as IEvent
@ -29,7 +28,7 @@ to it.
-}
type alias Room =
Snackbar Internal.IRoom
Vnackbar Internal.IRoom
{-| Create a new object from a joined room.
@ -121,11 +120,11 @@ getStateEvent data =
{-| Get older events from the Matrix API.
-}
findOlderEvents : { limit : Maybe Int } -> Room -> Task X.Error VaultUpdate
findOlderEvents { limit } room =
findOlderEvents : { limit : Maybe Int, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
findOlderEvents { limit, onResponse } room =
case Internal.latestGap (Snackbar.withoutCandy room) of
Nothing ->
Task.succeed (MultipleUpdates [])
Task.succeed (MultipleUpdates []) |> Task.perform onResponse
Just { from, to } ->
Api.getMessages
@ -137,6 +136,7 @@ findOlderEvents { limit } room =
, to = from
}
room
|> Task.perform onResponse
{-| Get the most recent events.
@ -155,8 +155,8 @@ roomId =
{-| Sends a new event to the Matrix room associated with the given `Room`.
-}
sendEvent : { content : E.Value, eventType : String, stateKey : Maybe String } -> Room -> Task X.Error VaultUpdate
sendEvent { eventType, content, stateKey } room =
sendEvent : { content : E.Value, eventType : String, stateKey : Maybe String, onResponse : VaultUpdate -> msg, room : Room } -> Cmd msg
sendEvent { eventType, content, stateKey, onResponse, room } =
case stateKey of
Nothing ->
Api.sendMessageEvent
@ -166,6 +166,7 @@ sendEvent { eventType, content, stateKey } room =
, roomId = roomId room
}
room
|> Task.perform onResponse
Just s ->
Api.sendStateEvent
@ -175,13 +176,14 @@ sendEvent { eventType, content, stateKey } room =
, roomId = roomId room
}
room
|> Task.perform onResponse
sendEvents : List { content : E.Value, eventType : String, stateKey : Maybe String } -> Room -> List (Task X.Error VaultUpdate)
sendEvents : List { content : E.Value, eventType : String, stateKey : Maybe String, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
sendEvents events room =
List.indexedMap Tuple.pair events
|> List.map
(\( i, { eventType, content, stateKey } ) ->
(\( i, { eventType, content, stateKey, onResponse } ) ->
case stateKey of
Nothing ->
Api.sendMessageEvent
@ -191,6 +193,7 @@ sendEvents events room =
, roomId = roomId room
}
room
|> Task.perform onResponse
Just s ->
Api.sendStateEvent
@ -200,13 +203,15 @@ sendEvents events room =
, roomId = roomId room
}
room
|> Task.perform onResponse
)
|> Cmd.batch
{-| Sends a new text message to the Matrix room associated with the given `Room`.
-}
sendMessage : String -> Room -> Task X.Error VaultUpdate
sendMessage text room =
sendMessage : { text : String, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
sendMessage { text, onResponse } room =
Api.sendMessageEvent
{ content =
E.object
@ -218,11 +223,12 @@ sendMessage text room =
, roomId = roomId room
}
room
|> Task.perform onResponse
sendMessages : List String -> Room -> List (Task X.Error VaultUpdate)
sendMessages pieces room =
pieces
sendMessages : { textPieces : List String, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
sendMessages { textPieces, onResponse } room =
textPieces
|> List.indexedMap Tuple.pair
|> List.map
(\( i, piece ) ->
@ -238,17 +244,21 @@ sendMessages pieces room =
}
room
)
|> List.map (Task.perform onResponse)
|> Cmd.batch
{-| Leave this room.
-}
leave : Room -> Task X.Error VaultUpdate
leave room =
leave : (VaultUpdate -> msg) -> Room -> Cmd msg
leave onResponse room =
Api.leave { roomId = roomId room, reason = Nothing } room
|> Task.perform onResponse
{-| Set account data.
-}
setAccountData : String -> E.Value -> Room -> Task X.Error VaultUpdate
setAccountData key value room =
setAccountData : { key : String, value : E.Value, onResponse : VaultUpdate -> msg, room : Room } -> Cmd msg
setAccountData { key, value, onResponse, room } =
Api.setAccountData { content = value, eventType = key, roomId = Just (roomId room) } room
|> Task.perform onResponse

7
src/Internal/Tools/Context.elm
View File

@ -180,6 +180,13 @@ removeAccessToken (Context data) =
Context data
{-| Remove all context.
-}
removeAll : Context a -> Context {}
removeAll (Context data) =
Context data
{-| Remove the base url from the Context
-}
removeBaseUrl : Context { a | baseUrl : () } -> Context a

12
src/Internal/Tools/Exceptions.elm
View File

@ -1,4 +1,4 @@
module Internal.Tools.Exceptions exposing (ClientError(..), Error(..), ServerError(..), errorCatches, errorToString)
module Internal.Tools.Exceptions exposing (ClientError(..), ContextError(..), Error(..), ServerError(..), errorCatches, errorToString)
{-| This module contains all potential errors that may be passed around in the SDK.
-}
@ -23,6 +23,7 @@ type Error
= InternetException Http.Error
| SDKException ClientError
| ServerException ServerError
| ContextFailed ContextError
| UnsupportedSpecVersion
@ -31,8 +32,6 @@ notices some internal inconsistencies or if it cannot interpret the server's
input.
- `ServerReturnsBadJSON` The homeserver sent JSON that does not parse.
- `CouldntGetTimestamp` The Elm core somehow failed to get the current
Unix timestamp.
- `NotSupportedYet` Some part of the SDK is intended to be implemented - but it isn't yet.
- `NoAccessToken` There is no more access token and no way of getting a new one.
@ -43,6 +42,13 @@ type ClientError
| NoAccessToken
{-| Sometimes, the Context failed to be gathered. In such a case, this function will tell you which one went wrong.
-}
type ContextError
= FailedVersions Error
| FailedAccessToken Error
{-| Potential error codes that the server may return. If the error is not a
default one described in the Matrix Spec, it will be a `CustomServerError`
and provide with the custom string.

103
src/Internal/Vault.elm
View File

@ -8,21 +8,20 @@ This file combines the internal functions with the API endpoints to create a ful
-}
import Dict
import Internal.Api.Snackbar as Snackbar exposing (Snackbar)
import Internal.Api.Snackbar as Snackbar
import Internal.Api.Sync.Main exposing (SyncInput)
import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..))
import Internal.Api.VaultUpdate exposing (VaultUpdate(..), Vnackbar)
import Internal.Event as Event
import Internal.Invite as Invite
import Internal.Room as Room
import Internal.Tools.Exceptions as X
import Internal.Tools.SpecEnums as Enums
import Internal.Values.Room as IRoom
import Internal.Values.RoomInvite exposing (IRoomInvite)
import Internal.Values.StateManager as StateManager
import Internal.Values.Vault as Internal
import Json.Encode as E
import Task exposing (Task)
import Task
{-| You can consider the `Vault` type as a large ring of keys,
@ -31,7 +30,7 @@ If you pass the `Vault` into any function, then the library will look for
the right keys and tokens to get the right information.
-}
type alias Vault =
Snackbar Internal.IVault
Vnackbar Internal.IVault
{-| Get personal account data linked to an account.
@ -100,9 +99,10 @@ insertRoom =
{-| Join a Matrix room by its id.
-}
joinRoomById : String -> Vault -> Task X.Error VaultUpdate
joinRoomById roomId vault =
joinRoomById : { roomId : String, onResponse : VaultUpdate -> msg, vault : Vault } -> Cmd msg
joinRoomById { roomId, onResponse, vault } =
Api.joinRoomById { roomId = roomId, reason = Nothing } vault
|> Task.perform onResponse
{-| Update the Vault type with new values
@ -151,7 +151,6 @@ updateWith vaultUpdate vault =
Nothing ->
vault
-- TODO
GetMessages input output ->
let
prevBatch : Maybe String
@ -185,8 +184,8 @@ updateWith vaultUpdate vault =
case ( getRoomById input.roomId vault, nextBatch ) of
( Just room, Just nb ) ->
room
|> Snackbar.withoutCandy
|> IRoom.insertEvents
|> Snackbar.map
(IRoom.insertEvents
{ events =
output.chunk
|> List.map Event.initFromGetMessages
@ -202,8 +201,8 @@ updateWith vaultUpdate vault =
, nextBatch = nb
, stateDelta = Just <| StateManager.fromEventList (List.map Event.initFromGetMessages output.state)
}
|> Internal.insertRoom
|> Snackbar.map
)
|> insertRoom
|> (|>) vault
_ ->
@ -217,11 +216,10 @@ updateWith vaultUpdate vault =
JoinedMembersToRoom _ _ ->
vault
-- TODO
JoinedRoom input _ ->
Snackbar.map (Internal.removeInvite input.roomId) vault
-- TODO
-- TODO: Remove room from dict of joined rooms
LeftRoom input () ->
Snackbar.map (Internal.removeInvite input.roomId) vault
@ -229,8 +227,8 @@ updateWith vaultUpdate vault =
Maybe.map2
(\room sender ->
room
|> Snackbar.withoutCandy
|> IRoom.addTemporaryEvent
|> Snackbar.map
(IRoom.addTemporaryEvent
{ content = content
, eventType = eventType
, eventId = eventId
@ -239,21 +237,26 @@ updateWith vaultUpdate vault =
, stateKey = Nothing
}
)
|> insertRoom
|> (|>) vault
)
(getRoomById roomId vault)
(getUsername vault)
|> Maybe.map (Snackbar.withCandyFrom vault >> insertRoom >> (|>) vault)
|> Maybe.withDefault vault
-- TODO
RedactedEvent _ _ ->
vault
RemoveFailedTask i ->
Snackbar.removeFailedTask i vault
StateEventSent { content, eventType, roomId, stateKey } { eventId } ->
Maybe.map2
(\room sender ->
room
|> Snackbar.withoutCandy
|> IRoom.addTemporaryEvent
|> Snackbar.map
(IRoom.addTemporaryEvent
{ content = content
, eventType = eventType
, eventId = eventId
@ -262,9 +265,11 @@ updateWith vaultUpdate vault =
, stateKey = Just stateKey
}
)
|> insertRoom
|> (|>) vault
)
(getRoomById roomId vault)
(getUsername vault)
|> Maybe.map (Snackbar.withCandyFrom vault >> insertRoom >> (|>) vault)
|> Maybe.withDefault vault
SyncUpdate input output ->
@ -357,6 +362,27 @@ updateWith vaultUpdate vault =
)
vault
TaskFailed s t ->
Snackbar.addFailedTask
(\taskId ->
( s
, t
>> Task.map
(\u ->
case u of
MultipleUpdates [] ->
RemoveFailedTask taskId
MultipleUpdates l ->
MultipleUpdates (RemoveFailedTask taskId :: l)
_ ->
MultipleUpdates [ RemoveFailedTask taskId, u ]
)
)
)
vault
UpdateAccessToken token ->
Snackbar.addToken token vault
@ -377,15 +403,16 @@ getUsername =
{-| Set personal account data
-}
setAccountData : String -> E.Value -> Vault -> Task X.Error VaultUpdate
setAccountData key value vault =
setAccountData : { key : String, value : E.Value, onResponse : VaultUpdate -> msg, vault : Vault } -> Cmd msg
setAccountData { key, value, onResponse, vault } =
Api.setAccountData { content = value, eventType = key, roomId = Nothing } vault
|> Task.perform onResponse
{-| Synchronize vault
-}
sync : Vault -> Task X.Error VaultUpdate
sync vault =
sync : Vault -> (VaultUpdate -> msg) -> Cmd msg
sync vault onResponse =
let
syncInput : SyncInput
syncInput =
@ -397,33 +424,7 @@ sync vault =
}
in
Api.sync syncInput vault
-- TODO: The sync function is described as "updating all the tokens".
-- TODO: For this reason, (only) the sync function should handle errors
-- TODO: that indicate that the user's access tokens have expired.
-- TODO: This implementation needs to be tested.
|> Task.onError
(\err ->
case err of
X.UnsupportedSpecVersion ->
Task.fail err
X.SDKException _ ->
Task.fail err
X.InternetException _ ->
Task.fail err
-- TODO: The login should be different when soft_logout.
-- TODO: Add support for refresh token.
X.ServerException (X.M_UNKNOWN_TOKEN _) ->
Api.loginMaybeSync syncInput vault
X.ServerException (X.M_MISSING_TOKEN _) ->
Api.loginMaybeSync syncInput vault
X.ServerException _ ->
Task.fail err
)
|> Task.perform onResponse
{-| Get a list of all synchronised rooms.

6
src/Matrix.elm
View File

@ -95,7 +95,7 @@ Your vault is always a snapshot of changes since the last time you updated it.
If you'd like to update it once more, simply run this function and the API will make sure that your Vault has the latest changes.
-}
sync : Vault -> Task X.Error VaultUpdate
sync : Vault -> (VaultUpdate -> msg) -> Cmd msg
sync =
Internal.Vault.sync
@ -146,13 +146,13 @@ username =
{-| Join a Matrix room based on its room id.
-}
joinRoomById : String -> Vault -> Task X.Error VaultUpdate
joinRoomById : { roomId : String, onResponse : VaultUpdate -> msg, vault : Vault } -> Cmd msg
joinRoomById =
Internal.Vault.joinRoomById
{-| Update the user's personal account data. This saves the information on the homeserver's side and keeps it available for future use.
-}
setAccountData : String -> E.Value -> Vault -> Task X.Error VaultUpdate
setAccountData : { key : String, value : E.Value, onResponse : VaultUpdate -> msg, vault : Vault } -> Cmd msg
setAccountData =
Internal.Vault.setAccountData

48
src/Matrix/Room.elm
View File

@ -96,18 +96,18 @@ an empty state key, and decoding the content.
-}
description : Room -> Maybe String
description =
stateEvent { eventType = "m.room.topic", stateKey = "" }
>> Maybe.map Event.content
>> Maybe.andThen (D.decodeValue (D.field "topic" D.string) >> Result.toMaybe)
description room =
stateEvent { eventType = "m.room.topic", stateKey = "", room = room }
|> Maybe.map Event.content
|> Maybe.andThen (D.decodeValue (D.field "topic" D.string) >> Result.toMaybe)
{-| Starting from the most recent events, look for more events. Effectively,
this inserts more events at the start of the `[mostRecentEvents](#mostRecentEvents)` function's output list.
-}
findOlderEvents : { limit : Maybe Int, room : Room } -> Task X.Error VaultUpdate
findOlderEvents { limit, room } =
Internal.findOlderEvents { limit = limit } room
findOlderEvents : { limit : Maybe Int, room : Room, onResponse : VaultUpdate -> msg } -> Cmd msg
findOlderEvents { limit, room, onResponse } =
Internal.findOlderEvents { limit = limit, onResponse = onResponse } room
{-| This function will always display the most recent events from the Matrix room.
@ -146,17 +146,17 @@ an empty state key, and decoding the content.
-}
name : Room -> Maybe String
name =
stateEvent { eventType = "m.room.name", stateKey = "" }
>> Maybe.map Event.content
>> Maybe.andThen (D.decodeValue (D.field "name" D.string) >> Result.toMaybe)
name room =
stateEvent { eventType = "m.room.name", stateKey = "", room = room }
|> Maybe.map Event.content
|> Maybe.andThen (D.decodeValue (D.field "name" D.string) >> Result.toMaybe)
{-| Get a state event in the room.
-}
stateEvent : { eventType : String, stateKey : String } -> Room -> Maybe Event.Event
stateEvent =
Internal.getStateEvent
stateEvent : { eventType : String, room : Room, stateKey : String } -> Maybe Event.Event
stateEvent { eventType, room, stateKey } =
Internal.getStateEvent { eventType = eventType, stateKey = stateKey } room
{-| Every room has a unique Matrix ID. You can later use this room ID to find the same room back.
@ -171,14 +171,14 @@ roomId =
task =
room
|> sendMessage "Hello, world!"
|> Task.attempt toMsg
|> Task.attempt onResponse
**Hint:** are you trying to send multiple messages at the same time? You might want to use `sendMessages` instead.
-}
sendMessage : String -> Room -> Task X.Error VaultUpdate
sendMessage =
Internal.sendMessage
sendMessage : { room : Room, onResponse : VaultUpdate -> msg, text : String } -> Cmd msg
sendMessage { room, onResponse, text } =
Internal.sendMessage { text = text, onResponse = onResponse } room
{-| Send multiple unformatted text messages to a room.
@ -201,9 +201,9 @@ If you're intending to send the same message multiple times, this function will
Task.sequence <| sendMessages [ "Hello, world!", "Hello, world!" ]
-}
sendMessages : List String -> Room -> List (Task X.Error VaultUpdate)
sendMessages =
Internal.sendMessages
sendMessages : { room : Room, textPieces : List String, onResponse : VaultUpdate -> msg } -> Cmd msg
sendMessages { room, textPieces, onResponse } =
Internal.sendMessages { textPieces = textPieces, onResponse = onResponse } room
{-| Send a custom event to the Matrix room.
@ -223,7 +223,7 @@ Keep in mind that this function is not safe to use if you're sending exactly the
]
-}
sendOneEvent : { content : D.Value, eventType : String, stateKey : Maybe String } -> Room -> Task X.Error VaultUpdate
sendOneEvent : { content : D.Value, eventType : String, room : Room, stateKey : Maybe String, onResponse : VaultUpdate -> msg } -> Cmd msg
sendOneEvent =
Internal.sendEvent
@ -249,7 +249,7 @@ Keep in mind that this function doesn't send the events in order, it just makes
|> Task.sequence
-}
sendMultipleEvents : List { content : D.Value, eventType : String, stateKey : Maybe String } -> Room -> List (Task X.Error VaultUpdate)
sendMultipleEvents : List { content : D.Value, eventType : String, stateKey : Maybe String, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
sendMultipleEvents =
Internal.sendEvents
@ -259,6 +259,6 @@ sendMultipleEvents =
The homeserver will save this information on this room, but it will only be visible to the user who sent it.
-}
setAccountData : String -> D.Value -> Room -> Task X.Error VaultUpdate
setAccountData : { key : String, value : D.Value, room : Room, onResponse : VaultUpdate -> msg } -> Cmd msg
setAccountData =
Internal.setAccountData

46
src/Matrix/RoomInvite.elm
View File

@ -1,6 +1,6 @@
module Matrix.RoomInvite exposing
( RoomInvite, accept, reject, acceptWithReason, rejectWithReason
, roomId, RoomInviteEvent, getAllEvents--, getEvent
( RoomInvite, accept, reject
, roomId, RoomInviteEvent, getEvent, getAllEvents
, sender, stateKey, eventType, content
)
@ -11,7 +11,7 @@ you can accept them, reject them or inspect them for further information.
# Invitations
@docs RoomInvite, accept, reject, acceptWithReason, rejectWithReason
@docs RoomInvite, accept, reject
# Exploring invitations
@ -46,30 +46,16 @@ type alias RoomInvite =
{-| If you would like to join a room, you can accept the offer.
-}
accept : RoomInvite -> Task X.Error VaultUpdate
accept invite =
Internal.accept { invite = invite, reason = Nothing }
accept : { invite : RoomInvite, onResponse : VaultUpdate -> msg, reason : Maybe String } -> Cmd msg
accept =
Internal.accept
{-| If you don't want to join the room, you can reject the offer.
-}
reject : RoomInvite -> Task X.Error VaultUpdate
reject invite =
Internal.reject { invite = invite, reason = Nothing }
{-| If the Matrix server supports it, you can add a reason for accepting an invite.
-}
acceptWithReason : String -> RoomInvite -> Task X.Error VaultUpdate
acceptWithReason reason invite =
Internal.accept { invite = invite, reason = Just reason }
{-| If the Matrix server supports it, you can add a reason for rejecting an invite.
-}
rejectWithReason : String -> RoomInvite -> Task X.Error VaultUpdate
rejectWithReason reason invite =
Internal.reject { invite = invite, reason = Just reason }
reject : { invite : RoomInvite, onResponse : VaultUpdate -> msg, reason : Maybe String } -> Cmd msg
reject =
Internal.reject
{-| Get the room id of the invited room.
@ -117,15 +103,11 @@ stateKey =
IR.stateKey
-- -- TODO: Fix this
-- {-| Get a specific event with a specific event content type and state key, if it exists.
-- -}
-- getEvent : { eventType : String, stateKey : String } -> RoomInvite -> Maybe RoomInviteEvent
-- getEvent data invite =
-- invite
-- |> Internal.withoutCredentials
-- |> IR.getEvent data
{-| Get a specific event with a specific event content type and state key, if it exists.
-}
getEvent : { eventType : String, stateKey : String } -> RoomInvite -> Maybe RoomInviteEvent
getEvent =
Internal.getEvent
{-| Instead of looking at just one event, get all events in a list.