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.

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

@ -30,48 +30,97 @@ type as a message to the Credentials to update certain information.
-} -}
import Http
import Internal.Api.Helpers as Helpers import Internal.Api.Helpers as Helpers
import Internal.Tools.Context as Context exposing (Context) import Internal.Tools.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X import Internal.Tools.Exceptions as X
import Task exposing (Task) import Task exposing (Task)
type alias TaskChain u a b = type alias TaskChain err u a b =
Context a -> Task X.Error (TaskChainPiece u a b) Context a -> Task (FailedChainPiece err u) (TaskChainPiece u a b)
type alias IdemChain u a = type alias IdemChain err u a =
TaskChain u a a TaskChain err u a a
type TaskChainPiece u a b type alias CompleteChain u =
= TaskChainPiece TaskChain () u {} {}
{ contextChange : Context a -> Context b
, messages : List 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. {-| 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 = andThen f2 f1 =
\context -> \context ->
f1 context f1 context
|> Task.andThen |> Task.andThen
(\(TaskChainPiece old) -> (\old ->
context context
|> old.contextChange |> old.contextChange
|> f2 |> f2
|> Task.map |> Task.map
(\(TaskChainPiece new) -> (\new ->
TaskChainPiece { contextChange = old.contextChange >> new.contextChange
{ contextChange = old.contextChange >> new.contextChange , messages = List.append old.messages new.messages
, 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. {-| Optionally run a task that may provide additional information.
If the provided chain fails, it will be ignored. This way, the chain can be tasked If the provided chain fails, it will be ignored. This way, the chain can be tasked
@ -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. 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 = maybe f =
{ contextChange = identity { contextChange = identity
, messages = [] , messages = []
} }
|> TaskChainPiece |> succeed
|> Task.succeed
|> always |> always
|> Task.onError |> onError
|> (>>) f |> (|>) 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 = otherwise f2 f1 context =
Task.onError (always <| f2 context) (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. {-| 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. 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 = toTask f1 =
Context.init Context.init
|> f1 |> f1
|> Task.map |> Task.map .messages
(\(TaskChainPiece data) ->
data.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. When set to 1 or lower, the task will only try once.
-} -}
tryNTimes : Int -> TaskChain u a b -> TaskChain u a b tryNTimes : Int -> TaskChain X.Error u a b -> TaskChain X.Error u a b
tryNTimes n f context = tryNTimes n f =
f context if n <= 0 then
|> Helpers.retryTask (n - 1) 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 _ -> X.ServerException _ ->
Task.fail err Task.fail err
X.ContextFailed _ ->
Task.fail err
X.UnsupportedSpecVersion -> X.UnsupportedSpecVersion ->
Task.fail err 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.Api.Versions.V1.Versions as V
import Internal.Tools.LoginValues as Login exposing (AccessToken(..)) import Internal.Tools.LoginValues as Login exposing (AccessToken(..))
import Task exposing (Task)
type Snackbar a type Snackbar a vu
= Snackbar = Snackbar
{ access : AccessToken { access : AccessToken
, content : a , content : a
, failedTasks : Dict Int ( String, Snackbar () vu -> Task Never vu )
, failedTasksOffset : Int
, homeserver : String , homeserver : String
, transactionOffset : Int
, vs : Maybe V.Versions , vs : Maybe V.Versions
} }
accessToken : Snackbar a -> AccessToken accessToken : Snackbar a vu -> AccessToken
accessToken (Snackbar { access }) = accessToken (Snackbar { access }) =
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)) = addToken token (Snackbar ({ access } as data)) =
Snackbar { data | access = Login.addToken token access } 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)) = addUsernameAndPassword uap (Snackbar ({ access } as data)) =
Snackbar { data | access = Login.addUsernameAndPassword uap access } 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) = addVersions vs (Snackbar data) =
Snackbar { data | vs = Just vs } 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)) = addWhoAmI whoami (Snackbar ({ access } as data)) =
Snackbar { data | access = Login.addWhoAmI whoami access } Snackbar { data | access = Login.addWhoAmI whoami access }
baseUrl : Snackbar a -> String baseUrl : Snackbar a vu -> String
baseUrl (Snackbar { homeserver }) = baseUrl (Snackbar { homeserver }) =
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 = init data =
Snackbar Snackbar
{ access = NoAccess { access = NoAccess
, content = data.content , content = data.content
, failedTasks = Dict.empty
, failedTasksOffset = 0
, homeserver = data.baseUrl , homeserver = data.baseUrl
, transactionOffset = 0
, vs = Nothing , vs = Nothing
} }
map : (a -> b) -> Snackbar a -> Snackbar b map : (a -> b) -> Snackbar a vu -> Snackbar b vu
map f (Snackbar data) = map f (Snackbar data) =
Snackbar Snackbar
{ access = data.access { access = data.access
, content = f data.content , content = f data.content
, failedTasks = data.failedTasks
, failedTasksOffset = 0
, homeserver = data.homeserver , homeserver = data.homeserver
, transactionOffset = data.transactionOffset
, vs = data.vs , 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) = mapList f (Snackbar data) =
List.map (withCandyFrom (Snackbar data)) (f data.content) 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) = mapMaybe f (Snackbar data) =
Maybe.map (withCandyFrom (Snackbar data)) (f data.content) Maybe.map (withCandyFrom (Snackbar data)) (f data.content)
removedAccessToken : Snackbar a -> AccessToken removedAccessToken : Snackbar a vu -> AccessToken
removedAccessToken (Snackbar { access }) = removedAccessToken (Snackbar { access }) =
Login.removeToken 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 }) = userId (Snackbar { access }) =
Login.getUserId access Login.getUserId access
versions : Snackbar a -> Maybe V.Versions versions : Snackbar a vu -> Maybe V.Versions
versions (Snackbar { vs }) = versions (Snackbar { vs }) =
vs vs
withCandyFrom : Snackbar b -> a -> Snackbar a withCandyFrom : Snackbar b vu -> a -> Snackbar a vu
withCandyFrom snackbar x = withCandyFrom snackbar x =
map (always x) snackbar map (always x) snackbar
withoutCandy : Snackbar a -> a withoutCandy : Snackbar a vu -> a
withoutCandy (Snackbar { content }) = withoutCandy (Snackbar { content }) =
content content
withoutContent : Snackbar a vu -> Snackbar () vu
withoutContent =
map (always ())

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

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

@ -26,8 +26,14 @@ import Task exposing (Task)
import Time import Time
type alias Vnackbar a =
Snackbar a VaultUpdate
type VaultUpdate type VaultUpdate
= MultipleUpdates (List 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 -- Updates as a result of API calls
| AccountDataSet SetAccountData.SetAccountInput SetAccountData.SetAccountOutput | AccountDataSet SetAccountData.SetAccountInput SetAccountData.SetAccountOutput
| BanUser Ban.BanInput Ban.BanOutput | BanUser Ban.BanInput Ban.BanOutput
@ -43,30 +49,39 @@ type VaultUpdate
| RedactedEvent Redact.RedactInput Redact.RedactOutput | RedactedEvent Redact.RedactInput Redact.RedactOutput
| StateEventSent SendStateKey.SendStateKeyInput SendStateKey.SendStateKeyOutput | StateEventSent SendStateKey.SendStateKeyInput SendStateKey.SendStateKeyOutput
| SyncUpdate Sync.SyncInput Sync.SyncOutput | SyncUpdate Sync.SyncInput Sync.SyncOutput
-- Updates as a result of getting data early -- Updates as a result of getting context information
| UpdateAccessToken String | UpdateAccessToken String
| UpdateVersions V.Versions | UpdateVersions V.Versions
| UpdateWhoAmI WhoAmI.WhoAmIOutput | UpdateWhoAmI WhoAmI.WhoAmIOutput
| RemoveFailedTask Int
type alias FutureTask = type alias FutureTask =
Task X.Error VaultUpdate Task Never VaultUpdate
{-| Turn an API Task into a taskchain. {-| 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 : (Context.Context ph1 -> cin -> Task err cout) -> cin -> (cout -> Chain.TaskChainPiece VaultUpdate ph1 ph2) -> TaskChain err VaultUpdate ph1 ph2
toChain transform task input context = toChain task input transform context =
task context input task context input
|> Task.map transform |> Task.map transform
|> Task.mapError (\e -> { error = e, messages = [] })
{-| Turn a chain of tasks into a full executable task. {-| Turn a chain of tasks into a full executable task.
-} -}
toTask : TaskChain VaultUpdate {} b -> FutureTask toTask : String -> (Vnackbar () -> TaskChain X.Error VaultUpdate {} b) -> Vnackbar () -> Task Never VaultUpdate
toTask = toTask debugText f snackbar =
Chain.toTask f snackbar
>> Task.map |> Chain.toTask
|> Task.onError
(\{ messages } ->
TaskFailed debugText (toTask debugText f)
:: messages
|> Task.succeed
)
|> Task.map
(\updates -> (\updates ->
case updates of case updates of
[ item ] -> [ item ] ->
@ -79,33 +94,26 @@ toTask =
{-| Get a functional access token. {-| 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 = accessToken ctoken =
case ctoken of case ctoken of
NoAccess -> NoAccess ->
X.NoAccessToken Chain.fail (X.SDKException X.NoAccessToken)
|> X.SDKException
|> Task.fail
|> always
RawAccessToken t -> RawAccessToken t ->
{ contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing } { contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing }
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece |> Chain.succeed
|> Task.succeed
|> always
|> Chain.andThen getWhoAmI |> Chain.andThen getWhoAmI
DetailedAccessToken data -> DetailedAccessToken data ->
{ contextChange = Chain.succeed
Context.setAccessToken { accessToken = data.accessToken, loginParts = Nothing } { contextChange =
>> Context.setUserId data.userId Context.setAccessToken { accessToken = data.accessToken, loginParts = Nothing }
, messages = [] >> Context.setUserId data.userId
} , messages = []
|> Chain.TaskChainPiece }
|> Task.succeed
|> always
UsernameAndPassword { username, password, token, deviceId, initialDeviceDisplayName, userId } -> UsernameAndPassword { username, password, token, deviceId, initialDeviceDisplayName, userId } ->
case token of case token of
@ -113,18 +121,16 @@ accessToken ctoken =
{ contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing } { contextChange = Context.setAccessToken { accessToken = t, loginParts = Nothing }
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece |> Chain.succeed
|> Task.succeed
|> always
|> Chain.andThen (whoAmI userId) |> Chain.andThen (whoAmI userId)
Nothing -> Nothing ->
loginWithUsernameAndPassword { username = username
{ username = username , password = password
, password = password , deviceId = deviceId
, deviceId = deviceId , initialDeviceDisplayName = initialDeviceDisplayName
, initialDeviceDisplayName = initialDeviceDisplayName }
} |> loginWithUsernameAndPassword
|> Chain.andThen |> Chain.andThen
(case userId of (case userId of
Just user -> Just user ->
@ -137,185 +143,184 @@ accessToken ctoken =
{-| Ban a user from a room. {-| Ban a user from a room.
-} -}
ban : Ban.BanInput -> IdemChain VaultUpdate (VBA a) ban : Ban.BanInput -> IdemChain X.Error VaultUpdate (VBA a)
ban input = ban input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ BanUser input output ]
}
)
Ban.ban Ban.ban
input input
(\output ->
{ contextChange = identity
, messages = [ BanUser input output ]
}
)
{-| Get an event from the API. {-| 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 = getEvent input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ GetEvent input output ]
}
)
GetEvent.getEvent GetEvent.getEvent
input input
(\output ->
{ contextChange = identity
, messages = [ GetEvent input output ]
}
)
{-| Get a list of messages from a room. {-| 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 = getMessages input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ GetMessages input output ]
}
)
GetMessages.getMessages GetMessages.getMessages
input input
(\output ->
{ contextChange = identity
, messages = [ GetMessages input output ]
}
)
getTimestamp : TaskChain VaultUpdate a { a | timestamp : () } getTimestamp : TaskChain err VaultUpdate a { a | timestamp : () }
getTimestamp = getTimestamp =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setTimestamp output
, messages = [ CurrentTimestamp output ]
}
)
(always <| always Time.now) (always <| always Time.now)
() ()
(\output ->
{ contextChange = Context.setTimestamp output
, messages = [ CurrentTimestamp output ]
}
)
{-| Get the supported spec versions from the homeserver. {-| 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 = getVersions =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setVersions output.versions
, messages = [ UpdateVersions output ]
}
)
(\context _ -> Versions.getVersions context) (\context _ -> Versions.getVersions context)
() ()
(\output ->
{ contextChange = Context.setVersions output.versions
, messages = [ UpdateVersions output ]
}
)
{-| Get a whoami to gain someone's identity. {-| 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 = getWhoAmI =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setUserId output.userId
, messages = [ UpdateWhoAmI output ]
}
)
WhoAmI.whoAmI WhoAmI.whoAmI
() ()
(\output ->
{ contextChange = Context.setUserId output.userId
, messages = [ UpdateWhoAmI output ]
}
)
{-| Invite a user to a room. {-| Invite a user to a room.
-} -}
invite : Invite.InviteInput -> IdemChain VaultUpdate (VBA a) invite : Invite.InviteInput -> IdemChain X.Error VaultUpdate (VBA a)
invite input = invite input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ InviteSent input output ]
}
)
Invite.invite Invite.invite
input input
(\output ->
{ contextChange = identity
, messages = [ InviteSent input output ]
}
)
joinedMembers : JoinedMembers.JoinedMembersInput -> IdemChain VaultUpdate (VBA a) joinedMembers : JoinedMembers.JoinedMembersInput -> IdemChain X.Error VaultUpdate (VBA a)
joinedMembers input = joinedMembers input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ JoinedMembersToRoom input output ]
}
)
JoinedMembers.joinedMembers JoinedMembers.joinedMembers
input input
(\output ->
{ contextChange = identity
, messages = [ JoinedMembersToRoom input output ]
}
)
joinRoomById : JoinRoomById.JoinRoomByIdInput -> IdemChain VaultUpdate (VBA a) joinRoomById : JoinRoomById.JoinRoomByIdInput -> IdemChain X.Error VaultUpdate (VBA a)
joinRoomById input = joinRoomById input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ JoinedRoom input output ]
}
)
JoinRoomById.joinRoomById JoinRoomById.joinRoomById
input input
(\output ->
{ contextChange = identity
, messages = [ JoinedRoom input output ]
}
)
leave : Leave.LeaveInput -> IdemChain VaultUpdate (VBA a) leave : Leave.LeaveInput -> IdemChain X.Error VaultUpdate (VBA a)
leave input = leave input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ LeftRoom input output ]
}
)
Leave.leave Leave.leave
input input
(\output ->
{ contextChange = identity
, messages = [ LeftRoom input output ]
}
)
loginWithUsernameAndPassword : LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput -> TaskChain VaultUpdate (VB a) (VBA a) loginWithUsernameAndPassword : LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput -> TaskChain X.Error VaultUpdate (VB a) (VBA a)
loginWithUsernameAndPassword input = loginWithUsernameAndPassword input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange =
Context.setAccessToken
{ accessToken = output.accessToken
, loginParts = Just input
}
, messages = [ LoggedInWithUsernameAndPassword input output ]
}
)
LoginWithUsernameAndPassword.loginWithUsernameAndPassword LoginWithUsernameAndPassword.loginWithUsernameAndPassword
input input
(\output ->
{ contextChange =
Context.setAccessToken
{ accessToken = output.accessToken
, loginParts = Just input
}
, messages = [ LoggedInWithUsernameAndPassword input output ]
}
)
{-| Make a VB-context based chain. {-| Make a VB-context based chain.
-} -}
makeVB : Snackbar a -> TaskChain VaultUpdate {} (VB {}) makeVB : Vnackbar a -> TaskChain X.Error VaultUpdate {} (VB {})
makeVB snackbar = makeVB snackbar =
snackbar snackbar
|> Snackbar.baseUrl |> Snackbar.baseUrl
|> withBaseUrl |> withBaseUrl
|> Chain.andThen (versions (Snackbar.versions snackbar)) |> Chain.andThen (versions (Snackbar.versions snackbar))
|> Chain.onError (\e -> Chain.fail (X.ContextFailed <| X.FailedVersions e))
{-| Make a VBA-context based chain. {-| Make a VBA-context based chain.
-} -}
makeVBA : Snackbar a -> TaskChain VaultUpdate {} (VBA { userId : () }) makeVBA : Vnackbar a -> TaskChain X.Error VaultUpdate {} (VBA { userId : () })
makeVBA snackbar = makeVBA snackbar =
snackbar snackbar
|> makeVB |> makeVB
|> Chain.andThen (accessToken (Snackbar.accessToken snackbar)) |> 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. {-| 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 = makeVBAT toString snackbar =
snackbar snackbar
|> makeVBA |> makeVBA
@ -324,83 +329,78 @@ makeVBAT toString snackbar =
{-| Redact an event from a room. {-| 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 = redact input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId
, messages = [ RedactedEvent input output ]
}
)
Redact.redact Redact.redact
input input
(\output ->
{ contextChange = Context.removeTransactionId
, messages = [ RedactedEvent input output ]
}
)
|> Chain.tryNTimes 5 |> Chain.tryNTimes 5
{-| Send a message event to a room. {-| 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 = sendMessageEvent input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId >> Context.setSentEvent output.eventId
, messages = [ MessageEventSent input output ]
}
)
SendMessageEvent.sendMessageEvent SendMessageEvent.sendMessageEvent
input input
(\output ->
{ contextChange = Context.removeTransactionId >> Context.setSentEvent output.eventId
, messages = [ MessageEventSent input output ]
}
)
|> Chain.tryNTimes 5 |> Chain.tryNTimes 5
{-| Send a state key event to a room. {-| 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 = sendStateEvent input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setSentEvent output.eventId
, messages = [ StateEventSent input output ]
}
)
SendStateKey.sendStateKey SendStateKey.sendStateKey
input input
(\output ->
{ contextChange = Context.setSentEvent output.eventId
, messages = [ StateEventSent input output ]
}
)
|> Chain.tryNTimes 5 |> Chain.tryNTimes 5
setAccountData : SetAccountData.SetAccountInput -> IdemChain VaultUpdate (VBA { a | userId : () }) setAccountData : SetAccountData.SetAccountInput -> IdemChain X.Error VaultUpdate (VBA { a | userId : () })
setAccountData input = setAccountData input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ AccountDataSet input output ]
}
)
SetAccountData.setAccountData SetAccountData.setAccountData
input input
(\output ->
{ contextChange = identity
, messages = [ AccountDataSet input output ]
}
)
{-| Sync the latest updates. {-| Sync the latest updates.
-} -}
sync : Sync.SyncInput -> IdemChain VaultUpdate (VBA a) sync : Sync.SyncInput -> IdemChain X.Error VaultUpdate (VBA a)
sync input = sync input =
toChain toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ SyncUpdate input output ]
}
)
Sync.sync Sync.sync
input input
(\output ->
{ contextChange = identity
, messages = [ SyncUpdate input output ]
}
)
{-| Insert versions, or get them if they are not provided. {-| 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 = versions mVersions =
(case mVersions of (case mVersions of
Just vs -> Just vs ->
@ -414,7 +414,7 @@ versions mVersions =
{-| Create a task to get a user's identity, if it is unknown. {-| 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 = whoAmI muserId =
case muserId of case muserId of
Just userId -> Just userId ->
@ -426,31 +426,29 @@ whoAmI muserId =
{-| Create a task that insert the base URL into the context. {-| 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 = withBaseUrl baseUrl =
{ contextChange = Context.setBaseUrl baseUrl { contextChange = Context.setBaseUrl baseUrl
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece
|> Task.succeed |> Task.succeed
|> always |> always
{-| Create a task that inserts an event id into the context, as if it were just sent. {-| 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 = withSentEvent sentEvent =
{ contextChange = Context.setSentEvent sentEvent { contextChange = Context.setSentEvent sentEvent
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece
|> Task.succeed |> Task.succeed
|> always |> always
{-| Create a task that inserts a transaction id into the context. {-| 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 = withTransactionId toString =
Time.now Time.now
|> Task.map |> Task.map
@ -462,28 +460,25 @@ withTransactionId toString =
|> Context.setTransactionId |> Context.setTransactionId
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece
) )
|> always |> always
withUserId : String -> TaskChain VaultUpdate a { a | userId : () } withUserId : String -> TaskChain err VaultUpdate a { a | userId : () }
withUserId userId = withUserId userId =
{ contextChange = Context.setUserId userId { contextChange = Context.setUserId userId
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece
|> Task.succeed |> Task.succeed
|> always |> always
{-| Create a task that inserts versions into the context. {-| 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 = withVersions vs =
{ contextChange = Context.setVersions vs.versions { contextChange = Context.setVersions vs.versions
, messages = [] , messages = []
} }
|> Chain.TaskChainPiece
|> Task.succeed |> Task.succeed
|> always |> 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.Main as GetEvent
import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO
import Internal.Api.GetMessages.V4.SpecObjects as GetMessagesSO 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.Sync.V2.SpecObjects as SyncSO
import Internal.Api.VaultUpdate exposing (Vnackbar)
import Internal.Tools.Timestamp exposing (Timestamp) import Internal.Tools.Timestamp exposing (Timestamp)
import Internal.Values.Event as Internal import Internal.Values.Event as Internal
import Json.Encode as E 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. {-| The central event type. This type will be used by the user and will be directly interacted with.
-} -}
type alias Event = type alias Event =
Snackbar Internal.IEvent Vnackbar Internal.IEvent
{-| Create an internal event type from an API endpoint event object. {-| 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. {-| 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.Sync.V2.SpecObjects exposing (StrippedStateEvent)
import Internal.Api.Task as Api import Internal.Api.Task as Api
import Internal.Api.VaultUpdate exposing (VaultUpdate(..)) import Internal.Api.VaultUpdate exposing (VaultUpdate(..), Vnackbar)
import Internal.Tools.Exceptions as X
import Internal.Values.RoomInvite as Internal import Internal.Values.RoomInvite as Internal
import Task exposing (Task) import Task
type alias RoomInvite = type alias RoomInvite =
Snackbar Internal.IRoomInvite Vnackbar Internal.IRoomInvite
accept : { invite : RoomInvite, reason : Maybe String } -> Task X.Error VaultUpdate accept : { invite : RoomInvite, reason : Maybe String, onResponse : VaultUpdate -> msg } -> Cmd msg
accept { invite, reason } = accept { invite, reason, onResponse } =
Api.joinRoomById Api.joinRoomById
{ roomId = roomId invite { roomId = roomId invite
, reason = reason , reason = reason
} }
invite invite
|> Task.perform onResponse
roomId : RoomInvite -> String roomId : RoomInvite -> String
@ -47,10 +47,11 @@ initFromStrippedStateEvent =
{-| Reject the invite and do not join the room. {-| Reject the invite and do not join the room.
-} -}
reject : { invite : RoomInvite, reason : Maybe String } -> Task X.Error VaultUpdate reject : { invite : RoomInvite, reason : Maybe String, onResponse : VaultUpdate -> msg } -> Cmd msg
reject { invite, reason } = reject { invite, reason, onResponse } =
Api.leave Api.leave
{ roomId = roomId invite { roomId = roomId invite
, reason = reason , reason = reason
} }
invite invite
|> Task.perform onResponse

50
src/Internal/Room.elm
View File

@ -4,12 +4,11 @@ module Internal.Room exposing (..)
-} -}
import Dict 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.Sync.V2.SpecObjects as Sync
import Internal.Api.Task as Api 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.Event as Event exposing (Event)
import Internal.Tools.Exceptions as X
import Internal.Tools.Hashdict as Hashdict import Internal.Tools.Hashdict as Hashdict
import Internal.Tools.SpecEnums as Enums import Internal.Tools.SpecEnums as Enums
import Internal.Values.Event as IEvent import Internal.Values.Event as IEvent
@ -29,7 +28,7 @@ to it.
-} -}
type alias Room = type alias Room =
Snackbar Internal.IRoom Vnackbar Internal.IRoom
{-| Create a new object from a joined room. {-| Create a new object from a joined room.
@ -121,11 +120,11 @@ getStateEvent data =
{-| Get older events from the Matrix API. {-| Get older events from the Matrix API.
-} -}
findOlderEvents : { limit : Maybe Int } -> Room -> Task X.Error VaultUpdate findOlderEvents : { limit : Maybe Int, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
findOlderEvents { limit } room = findOlderEvents { limit, onResponse } room =
case Internal.latestGap (Snackbar.withoutCandy room) of case Internal.latestGap (Snackbar.withoutCandy room) of
Nothing -> Nothing ->
Task.succeed (MultipleUpdates []) Task.succeed (MultipleUpdates []) |> Task.perform onResponse
Just { from, to } -> Just { from, to } ->
Api.getMessages Api.getMessages
@ -137,6 +136,7 @@ findOlderEvents { limit } room =
, to = from , to = from
} }
room room
|> Task.perform onResponse
{-| Get the most recent events. {-| Get the most recent events.
@ -155,8 +155,8 @@ roomId =
{-| Sends a new event to the Matrix room associated with the given `Room`. {-| 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 : { content : E.Value, eventType : String, stateKey : Maybe String, onResponse : VaultUpdate -> msg, room : Room } -> Cmd msg
sendEvent { eventType, content, stateKey } room = sendEvent { eventType, content, stateKey, onResponse, room } =
case stateKey of case stateKey of
Nothing -> Nothing ->
Api.sendMessageEvent Api.sendMessageEvent
@ -166,6 +166,7 @@ sendEvent { eventType, content, stateKey } room =
, roomId = roomId room , roomId = roomId room
} }
room room
|> Task.perform onResponse
Just s -> Just s ->
Api.sendStateEvent Api.sendStateEvent
@ -175,13 +176,14 @@ sendEvent { eventType, content, stateKey } room =
, roomId = roomId room , roomId = roomId room
} }
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 = sendEvents events room =
List.indexedMap Tuple.pair events List.indexedMap Tuple.pair events
|> List.map |> List.map
(\( i, { eventType, content, stateKey } ) -> (\( i, { eventType, content, stateKey, onResponse } ) ->
case stateKey of case stateKey of
Nothing -> Nothing ->
Api.sendMessageEvent Api.sendMessageEvent
@ -191,6 +193,7 @@ sendEvents events room =
, roomId = roomId room , roomId = roomId room
} }
room room
|> Task.perform onResponse
Just s -> Just s ->
Api.sendStateEvent Api.sendStateEvent
@ -200,13 +203,15 @@ sendEvents events room =
, roomId = roomId room , roomId = roomId room
} }
room room
|> Task.perform onResponse
) )
|> Cmd.batch
{-| Sends a new text message to the Matrix room associated with the given `Room`. {-| Sends a new text message to the Matrix room associated with the given `Room`.
-} -}
sendMessage : String -> Room -> Task X.Error VaultUpdate sendMessage : { text : String, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
sendMessage text room = sendMessage { text, onResponse } room =
Api.sendMessageEvent Api.sendMessageEvent
{ content = { content =
E.object E.object
@ -218,11 +223,12 @@ sendMessage text room =
, roomId = roomId room , roomId = roomId room
} }
room room
|> Task.perform onResponse
sendMessages : List String -> Room -> List (Task X.Error VaultUpdate) sendMessages : { textPieces : List String, onResponse : VaultUpdate -> msg } -> Room -> Cmd msg
sendMessages pieces room = sendMessages { textPieces, onResponse } room =
pieces textPieces
|> List.indexedMap Tuple.pair |> List.indexedMap Tuple.pair
|> List.map |> List.map
(\( i, piece ) -> (\( i, piece ) ->
@ -238,17 +244,21 @@ sendMessages pieces room =
} }
room room
) )
|> List.map (Task.perform onResponse)
|> Cmd.batch
{-| Leave this room. {-| Leave this room.
-} -}
leave : Room -> Task X.Error VaultUpdate leave : (VaultUpdate -> msg) -> Room -> Cmd msg
leave room = leave onResponse room =
Api.leave { roomId = roomId room, reason = Nothing } room Api.leave { roomId = roomId room, reason = Nothing } room
|> Task.perform onResponse
{-| Set account data. {-| Set account data.
-} -}
setAccountData : String -> E.Value -> Room -> Task X.Error VaultUpdate setAccountData : { key : String, value : E.Value, onResponse : VaultUpdate -> msg, room : Room } -> Cmd msg
setAccountData key value room = setAccountData { key, value, onResponse, room } =
Api.setAccountData { content = value, eventType = key, roomId = Just (roomId room) } 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 Context data
{-| Remove all context.
-}
removeAll : Context a -> Context {}
removeAll (Context data) =
Context data
{-| Remove the base url from the Context {-| Remove the base url from the Context
-} -}
removeBaseUrl : Context { a | baseUrl : () } -> Context a 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. {-| This module contains all potential errors that may be passed around in the SDK.
-} -}
@ -23,6 +23,7 @@ type Error
= InternetException Http.Error = InternetException Http.Error
| SDKException ClientError | SDKException ClientError
| ServerException ServerError | ServerException ServerError
| ContextFailed ContextError
| UnsupportedSpecVersion | UnsupportedSpecVersion
@ -31,8 +32,6 @@ notices some internal inconsistencies or if it cannot interpret the server's
input. input.
- `ServerReturnsBadJSON` The homeserver sent JSON that does not parse. - `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. - `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. - `NoAccessToken` There is no more access token and no way of getting a new one.
@ -43,6 +42,13 @@ type ClientError
| NoAccessToken | 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 {-| 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` default one described in the Matrix Spec, it will be a `CustomServerError`
and provide with the custom string. and provide with the custom string.

159
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 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.Sync.Main exposing (SyncInput)
import Internal.Api.Task as Api 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.Event as Event
import Internal.Invite as Invite import Internal.Invite as Invite
import Internal.Room as Room import Internal.Room as Room
import Internal.Tools.Exceptions as X
import Internal.Tools.SpecEnums as Enums import Internal.Tools.SpecEnums as Enums
import Internal.Values.Room as IRoom import Internal.Values.Room as IRoom
import Internal.Values.RoomInvite exposing (IRoomInvite) import Internal.Values.RoomInvite exposing (IRoomInvite)
import Internal.Values.StateManager as StateManager import Internal.Values.StateManager as StateManager
import Internal.Values.Vault as Internal import Internal.Values.Vault as Internal
import Json.Encode as E import Json.Encode as E
import Task exposing (Task) import Task
{-| You can consider the `Vault` type as a large ring of keys, {-| 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. the right keys and tokens to get the right information.
-} -}
type alias Vault = type alias Vault =
Snackbar Internal.IVault Vnackbar Internal.IVault
{-| Get personal account data linked to an account. {-| Get personal account data linked to an account.
@ -100,9 +99,10 @@ insertRoom =
{-| Join a Matrix room by its id. {-| Join a Matrix room by its id.
-} -}
joinRoomById : String -> Vault -> Task X.Error VaultUpdate joinRoomById : { roomId : String, onResponse : VaultUpdate -> msg, vault : Vault } -> Cmd msg
joinRoomById roomId vault = joinRoomById { roomId, onResponse, vault } =
Api.joinRoomById { roomId = roomId, reason = Nothing } vault Api.joinRoomById { roomId = roomId, reason = Nothing } vault
|> Task.perform onResponse
{-| Update the Vault type with new values {-| Update the Vault type with new values
@ -151,7 +151,6 @@ updateWith vaultUpdate vault =
Nothing -> Nothing ->
vault vault
-- TODO
GetMessages input output -> GetMessages input output ->
let let
prevBatch : Maybe String prevBatch : Maybe String
@ -185,25 +184,25 @@ updateWith vaultUpdate vault =
case ( getRoomById input.roomId vault, nextBatch ) of case ( getRoomById input.roomId vault, nextBatch ) of
( Just room, Just nb ) -> ( Just room, Just nb ) ->
room room
|> Snackbar.withoutCandy
|> IRoom.insertEvents
{ events =
output.chunk
|> List.map Event.initFromGetMessages
|> (\x ->
case input.direction of
Enums.Chronological ->
x
Enums.ReverseChronological ->
List.reverse x
)
, prevBatch = prevBatch
, nextBatch = nb
, stateDelta = Just <| StateManager.fromEventList (List.map Event.initFromGetMessages output.state)
}
|> Internal.insertRoom
|> Snackbar.map |> Snackbar.map
(IRoom.insertEvents
{ events =
output.chunk
|> List.map Event.initFromGetMessages
|> (\x ->
case input.direction of
Enums.Chronological ->
x
Enums.ReverseChronological ->
List.reverse x
)
, prevBatch = prevBatch
, nextBatch = nb
, stateDelta = Just <| StateManager.fromEventList (List.map Event.initFromGetMessages output.state)
}
)
|> insertRoom
|> (|>) vault |> (|>) vault
_ -> _ ->
@ -217,11 +216,10 @@ updateWith vaultUpdate vault =
JoinedMembersToRoom _ _ -> JoinedMembersToRoom _ _ ->
vault vault
-- TODO
JoinedRoom input _ -> JoinedRoom input _ ->
Snackbar.map (Internal.removeInvite input.roomId) vault Snackbar.map (Internal.removeInvite input.roomId) vault
-- TODO -- TODO: Remove room from dict of joined rooms
LeftRoom input () -> LeftRoom input () ->
Snackbar.map (Internal.removeInvite input.roomId) vault Snackbar.map (Internal.removeInvite input.roomId) vault
@ -229,42 +227,49 @@ updateWith vaultUpdate vault =
Maybe.map2 Maybe.map2
(\room sender -> (\room sender ->
room room
|> Snackbar.withoutCandy |> Snackbar.map
|> IRoom.addTemporaryEvent (IRoom.addTemporaryEvent
{ content = content { content = content
, eventType = eventType , eventType = eventType
, eventId = eventId , eventId = eventId
, originServerTs = Internal.lastUpdate (Snackbar.withoutCandy vault) , originServerTs = Internal.lastUpdate (Snackbar.withoutCandy vault)
, sender = sender , sender = sender
, stateKey = Nothing , stateKey = Nothing
} }
)
|> insertRoom
|> (|>) vault
) )
(getRoomById roomId vault) (getRoomById roomId vault)
(getUsername vault) (getUsername vault)
|> Maybe.map (Snackbar.withCandyFrom vault >> insertRoom >> (|>) vault)
|> Maybe.withDefault vault |> Maybe.withDefault vault
-- TODO -- TODO
RedactedEvent _ _ -> RedactedEvent _ _ ->
vault vault
RemoveFailedTask i ->
Snackbar.removeFailedTask i vault
StateEventSent { content, eventType, roomId, stateKey } { eventId } -> StateEventSent { content, eventType, roomId, stateKey } { eventId } ->
Maybe.map2 Maybe.map2
(\room sender -> (\room sender ->
room room
|> Snackbar.withoutCandy |> Snackbar.map
|> IRoom.addTemporaryEvent (IRoom.addTemporaryEvent
{ content = content { content = content
, eventType = eventType , eventType = eventType
, eventId = eventId , eventId = eventId
, originServerTs = Internal.lastUpdate (Snackbar.withoutCandy vault) , originServerTs = Internal.lastUpdate (Snackbar.withoutCandy vault)
, sender = sender , sender = sender
, stateKey = Just stateKey , stateKey = Just stateKey
} }
)
|> insertRoom
|> (|>) vault
) )
(getRoomById roomId vault) (getRoomById roomId vault)
(getUsername vault) (getUsername vault)
|> Maybe.map (Snackbar.withCandyFrom vault >> insertRoom >> (|>) vault)
|> Maybe.withDefault vault |> Maybe.withDefault vault
SyncUpdate input output -> SyncUpdate input output ->
@ -357,6 +362,27 @@ updateWith vaultUpdate vault =
) )
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 -> UpdateAccessToken token ->
Snackbar.addToken token vault Snackbar.addToken token vault
@ -377,15 +403,16 @@ getUsername =
{-| Set personal account data {-| Set personal account data
-} -}
setAccountData : String -> E.Value -> Vault -> Task X.Error VaultUpdate setAccountData : { key : String, value : E.Value, onResponse : VaultUpdate -> msg, vault : Vault } -> Cmd msg
setAccountData key value vault = setAccountData { key, value, onResponse, vault } =
Api.setAccountData { content = value, eventType = key, roomId = Nothing } vault Api.setAccountData { content = value, eventType = key, roomId = Nothing } vault
|> Task.perform onResponse
{-| Synchronize vault {-| Synchronize vault
-} -}
sync : Vault -> Task X.Error VaultUpdate sync : Vault -> (VaultUpdate -> msg) -> Cmd msg
sync vault = sync vault onResponse =
let let
syncInput : SyncInput syncInput : SyncInput
syncInput = syncInput =
@ -397,33 +424,7 @@ sync vault =
} }
in in
Api.sync syncInput vault Api.sync syncInput vault
-- TODO: The sync function is described as "updating all the tokens". |> Task.perform onResponse
-- 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
)
{-| Get a list of all synchronised rooms. {-| 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. 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 = sync =
Internal.Vault.sync Internal.Vault.sync
@ -146,13 +146,13 @@ username =
{-| Join a Matrix room based on its room id. {-| 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 = joinRoomById =
Internal.Vault.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. {-| 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 = setAccountData =
Internal.Vault.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 : Room -> Maybe String
description = description room =
stateEvent { eventType = "m.room.topic", stateKey = "" } stateEvent { eventType = "m.room.topic", stateKey = "", room = room }
>> Maybe.map Event.content |> Maybe.map Event.content
>> Maybe.andThen (D.decodeValue (D.field "topic" D.string) >> Result.toMaybe) |> Maybe.andThen (D.decodeValue (D.field "topic" D.string) >> Result.toMaybe)
{-| Starting from the most recent events, look for more events. Effectively, {-| 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. 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 : Maybe Int, room : Room, onResponse : VaultUpdate -> msg } -> Cmd msg
findOlderEvents { limit, room } = findOlderEvents { limit, room, onResponse } =
Internal.findOlderEvents { limit = limit } room Internal.findOlderEvents { limit = limit, onResponse = onResponse } room
{-| This function will always display the most recent events from the Matrix 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 : Room -> Maybe String
name = name room =
stateEvent { eventType = "m.room.name", stateKey = "" } stateEvent { eventType = "m.room.name", stateKey = "", room = room }
>> Maybe.map Event.content |> Maybe.map Event.content
>> Maybe.andThen (D.decodeValue (D.field "name" D.string) >> Result.toMaybe) |> Maybe.andThen (D.decodeValue (D.field "name" D.string) >> Result.toMaybe)
{-| Get a state event in the room. {-| Get a state event in the room.
-} -}
stateEvent : { eventType : String, stateKey : String } -> Room -> Maybe Event.Event stateEvent : { eventType : String, room : Room, stateKey : String } -> Maybe Event.Event
stateEvent = stateEvent { eventType, room, stateKey } =
Internal.getStateEvent 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. {-| 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 = task =
room room
|> sendMessage "Hello, world!" |> 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. **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 : { room : Room, onResponse : VaultUpdate -> msg, text : String } -> Cmd msg
sendMessage = sendMessage { room, onResponse, text } =
Internal.sendMessage Internal.sendMessage { text = text, onResponse = onResponse } room
{-| Send multiple unformatted text messages to a 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!" ] Task.sequence <| sendMessages [ "Hello, world!", "Hello, world!" ]
-} -}
sendMessages : List String -> Room -> List (Task X.Error VaultUpdate) sendMessages : { room : Room, textPieces : List String, onResponse : VaultUpdate -> msg } -> Cmd msg
sendMessages = sendMessages { room, textPieces, onResponse } =
Internal.sendMessages Internal.sendMessages { textPieces = textPieces, onResponse = onResponse } room
{-| Send a custom event to the Matrix 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 = sendOneEvent =
Internal.sendEvent Internal.sendEvent
@ -249,7 +249,7 @@ Keep in mind that this function doesn't send the events in order, it just makes
|> Task.sequence |> 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 = sendMultipleEvents =
Internal.sendEvents 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. 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 = setAccountData =
Internal.setAccountData Internal.setAccountData

46
src/Matrix/RoomInvite.elm
View File

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