Refactor to TaskChains
parent
bd73b97e93
commit
65591b710c
|
|
@ -1,21 +1,23 @@
|
|||
module Internal.Api.All exposing (..)
|
||||
|
||||
import Hash
|
||||
import Internal.Api.Chain as Chain exposing (TaskChain, IdemChain)
|
||||
import Internal.Api.Context as Context exposing (VB, VBA, VBAT)
|
||||
import Internal.Api.GetEvent.Main as GetEvent
|
||||
import Internal.Api.Invite.Main as Invite
|
||||
import Internal.Api.JoinedMembers.Main as JoinedMembers
|
||||
import Internal.Api.PreApi.Main as PreApi
|
||||
import Internal.Api.PreApi.Objects.Versions as V
|
||||
import Internal.Api.Versions.V1.Versions as V
|
||||
import Internal.Api.Redact.Main as Redact
|
||||
import Internal.Api.SendMessageEvent.Main as SendMessageEvent
|
||||
import Internal.Api.SendStateKey.Main as SendStateKey
|
||||
import Internal.Api.Sync.Main as Sync
|
||||
import Internal.Api.Versions.Main as Versions
|
||||
import Internal.Tools.Exceptions as X
|
||||
import Internal.Tools.LoginValues exposing (AccessToken)
|
||||
import Internal.Tools.SpecEnums as Enums
|
||||
import Internal.Tools.ValueGetter as VG
|
||||
import Json.Encode as E
|
||||
import Task exposing (Task)
|
||||
import Time
|
||||
|
||||
|
||||
type CredUpdate
|
||||
|
|
@ -32,315 +34,288 @@ type CredUpdate
|
|||
| UpdateAccessToken String
|
||||
| UpdateVersions V.Versions
|
||||
|
||||
type alias FutureTask = Task X.Error CredUpdate
|
||||
|
||||
type alias Future a =
|
||||
Task X.Error a
|
||||
{-| Turn a chain of tasks into a full executable task.
|
||||
-}
|
||||
toTask : TaskChain CredUpdate {} b -> FutureTask
|
||||
toTask =
|
||||
Chain.toTask
|
||||
>> Task.map
|
||||
(\updates ->
|
||||
case updates of
|
||||
[ item ] ->
|
||||
item
|
||||
|
||||
_ ->
|
||||
MultipleUpdates updates
|
||||
)
|
||||
|
||||
type alias GetEventInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, eventId : String
|
||||
, roomId : String
|
||||
, versions : Maybe V.Versions
|
||||
}
|
||||
{ eventId : String, roomId : String }
|
||||
|
||||
|
||||
{-| Get a specific event from the Matrix API.
|
||||
{-| Get an event from the API.
|
||||
-}
|
||||
getEvent : GetEventInput -> Future CredUpdate
|
||||
getEvent data =
|
||||
VG.withInfo2
|
||||
(\accessToken versions ->
|
||||
let
|
||||
input : GetEvent.EventInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, eventId = data.eventId
|
||||
, roomId = data.roomId
|
||||
}
|
||||
in
|
||||
GetEvent.getEvent versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ GetEvent input output
|
||||
, UpdateAccessToken accessToken
|
||||
, UpdateVersions versions
|
||||
]
|
||||
)
|
||||
getEvent : GetEventInput -> IdemChain CredUpdate (VBA a)
|
||||
getEvent { eventId, roomId } context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, eventId = eventId
|
||||
, roomId = roomId
|
||||
}
|
||||
in
|
||||
input
|
||||
|> GetEvent.getEvent (Context.getVersions context)
|
||||
|> Task.map (\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = identity
|
||||
, messages = [ GetEvent input output ]
|
||||
}
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
|
||||
{-| Insert versions, or get them if they are not provided.
|
||||
-}
|
||||
getVersions : Maybe V.Versions -> TaskChain CredUpdate { a | baseUrl : () } (VB a)
|
||||
getVersions mVersions =
|
||||
case mVersions of
|
||||
Just vs ->
|
||||
withVersions vs
|
||||
|
||||
Nothing ->
|
||||
versions
|
||||
|
||||
type alias InviteInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, reason : Maybe String
|
||||
{ reason : Maybe String
|
||||
, roomId : String
|
||||
, userId : String
|
||||
, versions : Maybe V.Versions
|
||||
}
|
||||
|
||||
{-| Send an invite to join a room.
|
||||
-}
|
||||
invite : InviteInput -> Future CredUpdate
|
||||
invite data =
|
||||
VG.withInfo2
|
||||
(\accessToken versions ->
|
||||
let
|
||||
input : Invite.InviteInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, reason = data.reason
|
||||
, roomId = data.roomId
|
||||
, userId = data.userId
|
||||
{-| Invite a user to a room. -}
|
||||
invite : InviteInput -> IdemChain CredUpdate (VBA a)
|
||||
invite { reason, roomId, userId } context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, reason = reason
|
||||
, roomId = roomId
|
||||
, userId = userId
|
||||
}
|
||||
in
|
||||
input
|
||||
|> Invite.invite (Context.getVersions context)
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = identity
|
||||
, messages = [ InviteSent input output ]
|
||||
}
|
||||
in
|
||||
Invite.invite versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ InviteSent input output
|
||||
, UpdateAccessToken accessToken
|
||||
, UpdateVersions versions
|
||||
]
|
||||
)
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
|
||||
)
|
||||
|
||||
type alias JoinedMembersInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, roomId : String
|
||||
, versions : Maybe V.Versions
|
||||
}
|
||||
{ roomId : String }
|
||||
|
||||
|
||||
{-| Get a list of members who are part of a Matrix room.
|
||||
-}
|
||||
joinedMembers : JoinedMembersInput -> Future CredUpdate
|
||||
joinedMembers data =
|
||||
VG.withInfo2
|
||||
(\accessToken versions ->
|
||||
let
|
||||
input : JoinedMembers.JoinedMembersInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, roomId = data.roomId
|
||||
joinedMembers : JoinedMembersInput -> IdemChain CredUpdate (VBA a)
|
||||
joinedMembers { roomId } context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, roomId = roomId
|
||||
}
|
||||
in
|
||||
input
|
||||
|> JoinedMembers.joinedMembers (Context.getVersions context)
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = identity
|
||||
, messages = [ JoinedMembersToRoom input output ]
|
||||
}
|
||||
in
|
||||
JoinedMembers.joinedMembers versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ JoinedMembersToRoom input output
|
||||
, UpdateAccessToken accessToken
|
||||
, UpdateVersions versions
|
||||
]
|
||||
)
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
)
|
||||
|
||||
|
||||
type alias RedactEventInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, eventId : String
|
||||
type alias RedactInput =
|
||||
{ eventId : String
|
||||
, reason : Maybe String
|
||||
, roomId : String
|
||||
, versions : Maybe V.Versions
|
||||
, extraTransactionNoise : String
|
||||
}
|
||||
|
||||
|
||||
{-| Redact an event from a Matrix room.
|
||||
{-| Redact an event from a room.
|
||||
-}
|
||||
redact : RedactEventInput -> Future CredUpdate
|
||||
redact data =
|
||||
VG.withInfo3
|
||||
(\accessToken versions transactionId ->
|
||||
let
|
||||
input : Redact.RedactInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, roomId = data.roomId
|
||||
, eventId = data.eventId
|
||||
, txnId = transactionId
|
||||
, reason = data.reason
|
||||
redact : RedactInput -> TaskChain CredUpdate (VBAT a) (VBA a)
|
||||
redact { eventId, reason, roomId } context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, eventId = eventId
|
||||
, reason = reason
|
||||
, roomId = roomId
|
||||
, txnId = Context.getTransactionId context
|
||||
}
|
||||
in
|
||||
input
|
||||
|> Redact.redact (Context.getVersions context)
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = Context.removeTransactionId
|
||||
, messages = [ RedactedEvent input output ]
|
||||
}
|
||||
in
|
||||
-- TODO: As an option, the API may get this event to see
|
||||
-- what the event looks like now.
|
||||
Redact.redact versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ RedactedEvent input output
|
||||
]
|
||||
)
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
(PreApi.transactionId
|
||||
(\timestamp ->
|
||||
[ Hash.fromInt timestamp
|
||||
, Hash.fromString data.baseUrl
|
||||
, Hash.fromString data.eventId
|
||||
, Hash.fromString data.roomId
|
||||
, Hash.fromString (data.reason |> Maybe.withDefault "no-reason")
|
||||
, Hash.fromString data.extraTransactionNoise
|
||||
]
|
||||
|> List.foldl Hash.dependent (Hash.fromInt 0)
|
||||
|> Hash.toString
|
||||
|> (++) "elm"
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
type alias SendMessageEventInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, content : E.Value
|
||||
{ content : E.Value
|
||||
, eventType : String
|
||||
, roomId : String
|
||||
, versions : Maybe V.Versions
|
||||
, extraTransactionNoise : String
|
||||
}
|
||||
|
||||
|
||||
{-| Send a message event into a Matrix room.
|
||||
{-| Send a message event to a room.
|
||||
-}
|
||||
sendMessageEvent : SendMessageEventInput -> Future CredUpdate
|
||||
sendMessageEvent data =
|
||||
VG.withInfo3
|
||||
(\accessToken versions transactionId ->
|
||||
let
|
||||
input : SendMessageEvent.SendMessageEventInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, content = data.content
|
||||
, eventType = data.eventType
|
||||
, roomId = data.roomId
|
||||
, transactionId = transactionId
|
||||
sendMessageEvent : SendMessageEventInput -> TaskChain CredUpdate (VBAT a) (VBA a)
|
||||
sendMessageEvent { content, eventType, roomId } context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, content = content
|
||||
, eventType = eventType
|
||||
, roomId = roomId
|
||||
, transactionId = Context.getTransactionId context
|
||||
}
|
||||
in
|
||||
input
|
||||
|> SendMessageEvent.sendMessageEvent (Context.getVersions context)
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = Context.removeTransactionId
|
||||
, messages = [ MessageEventSent input output ]
|
||||
}
|
||||
in
|
||||
SendMessageEvent.sendMessageEvent versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ MessageEventSent input output
|
||||
, UpdateAccessToken accessToken
|
||||
, UpdateVersions versions
|
||||
]
|
||||
)
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
(PreApi.transactionId
|
||||
(\timestamp ->
|
||||
[ Hash.fromInt timestamp
|
||||
, Hash.fromString data.baseUrl
|
||||
, Hash.fromString data.eventType
|
||||
, Hash.fromString data.roomId
|
||||
, Hash.fromString data.extraTransactionNoise
|
||||
]
|
||||
|> List.foldl Hash.dependent (Hash.fromInt 0)
|
||||
|> Hash.toString
|
||||
|> (++) "elm"
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
type alias SendStateKeyInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, content : E.Value
|
||||
type alias SendStateEventInput =
|
||||
{ content : E.Value
|
||||
, eventType : String
|
||||
, roomId : String
|
||||
, stateKey : String
|
||||
, versions : Maybe V.Versions
|
||||
}
|
||||
|
||||
|
||||
{-| Send a state event into a Matrix room.
|
||||
{-| Send a state key event to a room.
|
||||
-}
|
||||
sendStateEvent : SendStateKeyInput -> Future CredUpdate
|
||||
sendStateEvent data =
|
||||
VG.withInfo2
|
||||
(\accessToken versions ->
|
||||
let
|
||||
input : SendStateKey.SendStateKeyInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, content = data.content
|
||||
, eventType = data.eventType
|
||||
, roomId = data.roomId
|
||||
, stateKey = data.stateKey
|
||||
sendStateEvent : SendStateEventInput -> IdemChain CredUpdate (VBA a)
|
||||
sendStateEvent { content, eventType, roomId, stateKey } context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, content = content
|
||||
, eventType = eventType
|
||||
, roomId = roomId
|
||||
, stateKey = stateKey
|
||||
}
|
||||
in
|
||||
input
|
||||
|> SendStateKey.sendStateKey (Context.getVersions context)
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = identity
|
||||
, messages = [ StateEventSent input output ]
|
||||
}
|
||||
in
|
||||
SendStateKey.sendStateKey versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ StateEventSent input output
|
||||
, UpdateAccessToken accessToken
|
||||
, UpdateVersions versions
|
||||
]
|
||||
)
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
|
||||
)
|
||||
|
||||
type alias SyncInput =
|
||||
{ accessToken : AccessToken
|
||||
, baseUrl : String
|
||||
, filter : Maybe String
|
||||
{ filter : Maybe String
|
||||
, fullState : Maybe Bool
|
||||
, setPresence : Maybe Enums.UserPresence
|
||||
, since : Maybe String
|
||||
, timeout : Maybe Int
|
||||
, versions : Maybe V.Versions
|
||||
}
|
||||
|
||||
|
||||
{-| Get the latest sync from the Matrix API.
|
||||
{-| Sync the latest updates.
|
||||
-}
|
||||
syncCredentials : SyncInput -> Future CredUpdate
|
||||
syncCredentials data =
|
||||
VG.withInfo2
|
||||
(\accessToken versions ->
|
||||
let
|
||||
input : Sync.SyncInput
|
||||
input =
|
||||
{ accessToken = accessToken
|
||||
, baseUrl = data.baseUrl
|
||||
, filter = data.filter
|
||||
, fullState = data.fullState
|
||||
, setPresence = data.setPresence
|
||||
, since = data.since
|
||||
, timeout = data.timeout
|
||||
sync : SyncInput -> IdemChain CredUpdate (VBA a)
|
||||
sync data context =
|
||||
let
|
||||
input = { accessToken = Context.getAccessToken context
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, filter = data.filter
|
||||
, fullState = data.fullState
|
||||
, setPresence = data.setPresence
|
||||
, since = data.since
|
||||
, timeout = data.timeout
|
||||
}
|
||||
in
|
||||
input
|
||||
|> Sync.sync (Context.getVersions context)
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = identity
|
||||
, messages = [ SyncUpdate input output ]
|
||||
}
|
||||
in
|
||||
Sync.sync versions.versions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
MultipleUpdates
|
||||
[ SyncUpdate input output
|
||||
, UpdateAccessToken accessToken
|
||||
, UpdateVersions versions
|
||||
]
|
||||
)
|
||||
)
|
||||
|
||||
{-| Get the supported spec versions from the homeserver.
|
||||
-}
|
||||
versions : TaskChain CredUpdate { a | baseUrl : () } (VB a)
|
||||
versions context =
|
||||
let
|
||||
input = Context.getBaseUrl context
|
||||
in
|
||||
Versions.getVersions input
|
||||
|> Task.map
|
||||
(\output ->
|
||||
Chain.TaskChainPiece
|
||||
{ contextChange = Context.setVersions output.versions
|
||||
, messages = [ UpdateVersions output ]
|
||||
}
|
||||
)
|
||||
|
||||
{-| Create a task that inserts an access token into the context.
|
||||
-}
|
||||
withAccessToken : String -> TaskChain CredUpdate a { a | accessToken : () }
|
||||
withAccessToken accessToken =
|
||||
{ contextChange = Context.setAccessToken accessToken
|
||||
, messages = []
|
||||
}
|
||||
|> Chain.TaskChainPiece
|
||||
|> Task.succeed
|
||||
|> always
|
||||
|
||||
{-| Create a task that insert the base URL into the context.
|
||||
-}
|
||||
withBaseUrl : String -> TaskChain CredUpdate a { a | baseUrl : () }
|
||||
withBaseUrl baseUrl =
|
||||
{ contextChange = Context.setBaseUrl baseUrl
|
||||
, messages = []
|
||||
}
|
||||
|> Chain.TaskChainPiece
|
||||
|> Task.succeed
|
||||
|> always
|
||||
|
||||
{-| Create a task that inserts a transaction id into the context.
|
||||
-}
|
||||
withTransactionId : (Int -> String) -> TaskChain CredUpdate a { a | transactionId : () }
|
||||
withTransactionId toString =
|
||||
Time.now
|
||||
|> Task.map
|
||||
(\now ->
|
||||
{ contextChange =
|
||||
now
|
||||
|> Time.posixToMillis
|
||||
|> toString
|
||||
|> Context.setTransactionId
|
||||
, messages = []
|
||||
}
|
||||
|> Chain.TaskChainPiece
|
||||
)
|
||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
||||
(PreApi.versions data.baseUrl data.versions)
|
||||
|> always
|
||||
|
||||
{-| Create a task that inserts versions into the context.
|
||||
-}
|
||||
withVersions : V.Versions -> TaskChain CredUpdate a { a | versions : () }
|
||||
withVersions versions =
|
||||
{ contextChange = Context.setVersions versions.versions
|
||||
, messages = []
|
||||
}
|
||||
|> Chain.TaskChainPiece
|
||||
|> Task.succeed
|
||||
|> always
|
||||
|
|
|
|||
|
|
@ -0,0 +1,115 @@
|
|||
module Internal.Api.Chain exposing (..)
|
||||
{-| This module aims to simplify chaining several API tasks together.
|
||||
|
||||
Chaining tasks together is usually done through the `Task` submodule of `elm/core`,
|
||||
but this isn't always sufficient for getting complex chained tasks.
|
||||
|
||||
For example, suppose you need to run 3 consecutive tasks that each need an access
|
||||
token, and only the 1st and the 3rd require another token. You will need to pass
|
||||
on all necessary information, and preferably in a way that the compiler can
|
||||
assure that the information is present when it arrives there. Using the `Task`
|
||||
submodule, this can lead to indentation hell.
|
||||
|
||||
This module aims to allow for simple task chaining without adding too much complexity
|
||||
if you wish to pass on values.
|
||||
|
||||
The model is like a snake: _____
|
||||
/ o \
|
||||
/-|------------ | ------- | ------------- | -------- | |\/\/
|
||||
< | accessToken | baseUrl | transactionId | API call | |------< Final API call
|
||||
\-|------------ | ------- | ------------- | -------- | |/\/\
|
||||
------/
|
||||
(You're not allowed to judge my ASCII art skills unless you submit a PR with a
|
||||
superior ASCII snake model.)
|
||||
|
||||
Every task will add another value to an extensible record, which can be used
|
||||
by later tasks in the chain. Additionally, every subtask can leave a `CredUpdate`
|
||||
type as a message to the Credentials to update certain information.
|
||||
-}
|
||||
|
||||
import Internal.Tools.Exceptions as X
|
||||
import Internal.Api.Context as Context exposing (Context)
|
||||
import Task exposing (Task)
|
||||
|
||||
type alias TaskChain u a b =
|
||||
(Context a -> Task X.Error (TaskChainPiece u a b))
|
||||
|
||||
type alias IdemChain u a = TaskChain u a a
|
||||
|
||||
type TaskChainPiece u a b
|
||||
= TaskChainPiece
|
||||
{ contextChange : Context a -> Context b
|
||||
, 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 f2 f1 =
|
||||
(\context ->
|
||||
f1 context
|
||||
|> Task.andThen
|
||||
(\(TaskChainPiece old) ->
|
||||
context
|
||||
|> old.contextChange
|
||||
|> f2
|
||||
|> Task.map
|
||||
(\(TaskChainPiece new) ->
|
||||
TaskChainPiece
|
||||
{ contextChange = old.contextChange >> new.contextChange
|
||||
, messages = List.append old.messages new.messages
|
||||
}
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
{-| Optionally run a task that may render events.
|
||||
|
||||
It will always succeed, and hence will not break the chain of events.
|
||||
|
||||
This function does not work if it aims to deliver crucial context.
|
||||
-}
|
||||
maybe : TaskChain u a a -> TaskChain u a a
|
||||
maybe f =
|
||||
{ contextChange = identity
|
||||
, messages = []
|
||||
}
|
||||
|> TaskChainPiece
|
||||
|> Task.succeed
|
||||
|> always
|
||||
|> Task.onError
|
||||
|> (>>) f
|
||||
|
||||
{-| If the TaskChain fails, run this task otherwise.
|
||||
-}
|
||||
otherwise : TaskChain u a b -> TaskChain u a b -> TaskChain u a b
|
||||
otherwise f2 f1 context =
|
||||
Task.onError (always <| f2 context) (f1 context)
|
||||
|
||||
{-| 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 f1 =
|
||||
Context.init
|
||||
|> f1
|
||||
|> Task.map
|
||||
(\(TaskChainPiece data) ->
|
||||
data.messages
|
||||
)
|
||||
|
||||
|
||||
{-| If the TaskChain fails, 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 =
|
||||
if n <= 1 then
|
||||
f context
|
||||
else
|
||||
(\_ -> tryNTimes (n - 1) f context)
|
||||
|> Task.onError
|
||||
|> (|>) (f context)
|
||||
|
||||
|
|
@ -0,0 +1,99 @@
|
|||
module Internal.Api.Context exposing (..)
|
||||
{-| This module hosts functions for the `Context` type.
|
||||
|
||||
The `Context` type is a type that is passed along a chain of tasks.
|
||||
This way, the result of a task can be used in a multitude of future tasks.
|
||||
|
||||
The module has a bunch of getters and setters. If you start with a simple version
|
||||
from the `init` function, the compiler will only allow you to use getter functions
|
||||
after having set the value using a setter function.
|
||||
|
||||
Additionaly, there are remove functions which are intended to tell the compiler
|
||||
"you will have to get this value again if you'd like to use it later."
|
||||
-}
|
||||
|
||||
import Internal.Config.Leaking as L
|
||||
|
||||
type Context a =
|
||||
Context
|
||||
{ accessToken : String
|
||||
, baseUrl : String
|
||||
, transactionId : String
|
||||
, versions : List String
|
||||
}
|
||||
|
||||
type alias VB a = { a | versions : (), baseUrl : () }
|
||||
|
||||
type alias VBA a = { a | accessToken : (), baseUrl : (), versions : () }
|
||||
|
||||
type alias VBAT a = { a | accessToken : (), baseUrl : (), versions : (), transactionId : () }
|
||||
|
||||
{-| Get a default Context type. -}
|
||||
init : Context {}
|
||||
init =
|
||||
Context
|
||||
{ accessToken = L.accessToken
|
||||
, baseUrl = L.baseUrl
|
||||
, transactionId = L.transactionId
|
||||
, versions = L.versions
|
||||
}
|
||||
|
||||
{-| Get the access token from the Context. -}
|
||||
getAccessToken : Context { a | accessToken : () } -> String
|
||||
getAccessToken (Context { accessToken }) =
|
||||
accessToken
|
||||
|
||||
{-| Get the base url from the Context. -}
|
||||
getBaseUrl : Context { a | baseUrl : () } -> String
|
||||
getBaseUrl (Context { baseUrl }) =
|
||||
baseUrl
|
||||
|
||||
{-| Get the transaction id from the Context. -}
|
||||
getTransactionId : Context { a | transactionId : () } -> String
|
||||
getTransactionId (Context { transactionId }) =
|
||||
transactionId
|
||||
|
||||
{-| Get the supported spec versions from the Context. -}
|
||||
getVersions : Context { a | versions : () } -> List String
|
||||
getVersions (Context { versions }) =
|
||||
versions
|
||||
|
||||
{-| Insert an access token into the context. -}
|
||||
setAccessToken : String -> Context a -> Context { a | accessToken : () }
|
||||
setAccessToken accessToken (Context data) =
|
||||
Context { data | accessToken = accessToken }
|
||||
|
||||
{-| Insert a base url into the context. -}
|
||||
setBaseUrl : String -> Context a -> Context { a | baseUrl : () }
|
||||
setBaseUrl baseUrl (Context data) =
|
||||
Context { data | baseUrl = baseUrl }
|
||||
|
||||
{-| Insert a transaction id into the context. -}
|
||||
setTransactionId : String -> Context a -> Context { a | transactionId : () }
|
||||
setTransactionId transactionId (Context data) =
|
||||
Context { data | transactionId = transactionId }
|
||||
|
||||
{-| Insert a transaction id into the context. -}
|
||||
setVersions : List String -> Context a -> Context { a | versions : () }
|
||||
setVersions versions (Context data) =
|
||||
Context { data | versions = versions }
|
||||
|
||||
{-| Remove the access token from the Context -}
|
||||
removeAccessToken : Context { a | accessToken : () } -> Context a
|
||||
removeAccessToken (Context data) =
|
||||
Context data
|
||||
|
||||
{-| Remove the base url from the Context -}
|
||||
removeBaseUrl : Context { a | baseUrl : () } -> Context a
|
||||
removeBaseUrl (Context data) =
|
||||
Context data
|
||||
|
||||
{-| Remove the transaction id from the Context -}
|
||||
removeTransactionId : Context { a | transactionId : () } -> Context a
|
||||
removeTransactionId (Context data) =
|
||||
Context data
|
||||
|
||||
{-| Remove the versions from the Context -}
|
||||
removeVersions : Context { a | versions : () } -> Context a
|
||||
removeVersions (Context data) =
|
||||
Context data
|
||||
|
|
@ -9,7 +9,7 @@ that the credentials type needs to know about before it can make a request.
|
|||
-}
|
||||
|
||||
import Internal.Api.PreApi.Objects.Login as L
|
||||
import Internal.Api.PreApi.Objects.Versions as V
|
||||
import Internal.Api.Versions.V1.Versions as V
|
||||
import Internal.Api.Request as R
|
||||
import Internal.Tools.Exceptions as X
|
||||
import Internal.Tools.LoginValues exposing (AccessToken(..))
|
||||
|
|
|
|||
|
|
@ -1,15 +1,11 @@
|
|||
module Internal.Api.Versions.Api exposing (..)
|
||||
|
||||
import Internal.Api.Request as R
|
||||
import Internal.Api.Versions.Convert as C
|
||||
import Internal.Api.Versions.Objects as O
|
||||
import Internal.Api.Versions.SpecObjects as SO
|
||||
import Internal.Api.Versions.V1.Versions as SO
|
||||
import Internal.Tools.Exceptions as X
|
||||
import Json.Decode as D
|
||||
import Task exposing (Task)
|
||||
|
||||
|
||||
versionsV1 : { baseUrl : String } -> Task X.Error O.Versions
|
||||
versionsV1 : { baseUrl : String } -> Task X.Error SO.Versions
|
||||
versionsV1 data =
|
||||
R.rawApiCall
|
||||
{ headers = R.NoHeaders
|
||||
|
|
@ -20,5 +16,5 @@ versionsV1 data =
|
|||
, queryParams = []
|
||||
, bodyParams = []
|
||||
, timeout = Nothing
|
||||
, decoder = \_ -> D.map C.convert SO.versionsDecoder
|
||||
, decoder = always SO.versionsDecoder
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,32 +0,0 @@
|
|||
module Internal.Api.Versions.Convert exposing (..)
|
||||
|
||||
import Dict
|
||||
import Internal.Api.Versions.Objects as O
|
||||
import Internal.Api.Versions.SpecObjects as SO
|
||||
import Set
|
||||
|
||||
|
||||
implementedVersions : List String
|
||||
implementedVersions =
|
||||
[ "v1.5", "v1.4", "v1.3", "v1.2", "v1.1" ]
|
||||
|
||||
|
||||
convert : SO.Versions -> O.Versions
|
||||
convert versions =
|
||||
{ supportedVersions =
|
||||
implementedVersions
|
||||
|> List.filter (\v -> List.member v versions.versions)
|
||||
, unstableFeatures =
|
||||
versions.unstableFeatures
|
||||
|> Maybe.withDefault Dict.empty
|
||||
|> Dict.toList
|
||||
|> List.filterMap
|
||||
(\( name, enabled ) ->
|
||||
if enabled then
|
||||
Just name
|
||||
|
||||
else
|
||||
Nothing
|
||||
)
|
||||
|> Set.fromList
|
||||
}
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
module Internal.Api.Versions.Main exposing (..)
|
||||
|
||||
import Internal.Api.Versions.Api as Api
|
||||
import Internal.Api.Versions.Objects as O
|
||||
import Internal.Api.Versions.V1.Versions as SO
|
||||
import Internal.Tools.Exceptions as X
|
||||
import Task exposing (Task)
|
||||
|
||||
|
|
@ -11,7 +11,7 @@ type alias VersionsInput =
|
|||
|
||||
|
||||
type alias VersionsOutput =
|
||||
O.Versions
|
||||
SO.Versions
|
||||
|
||||
|
||||
getVersions : VersionsInput -> Task X.Error VersionsOutput
|
||||
|
|
|
|||
|
|
@ -1,9 +0,0 @@
|
|||
module Internal.Api.Versions.Objects exposing (..)
|
||||
|
||||
import Set exposing (Set)
|
||||
|
||||
|
||||
type alias Versions =
|
||||
{ supportedVersions : List String
|
||||
, unstableFeatures : Set String
|
||||
}
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
module Internal.Api.Versions.SpecObjects exposing
|
||||
( Versions
|
||||
, encodeVersions
|
||||
, versionsDecoder
|
||||
)
|
||||
|
||||
{-| Automatically generated 'SpecObjects'
|
||||
|
||||
Last generated at Unix time 1673279712
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Internal.Tools.DecodeExtra exposing (opField)
|
||||
import Internal.Tools.EncodeExtra exposing (maybeObject)
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
|
||||
|
||||
{-| Information on what the homeserver supports.
|
||||
-}
|
||||
type alias Versions =
|
||||
{ unstableFeatures : Maybe (Dict String Bool)
|
||||
, versions : List String
|
||||
}
|
||||
|
||||
|
||||
encodeVersions : Versions -> E.Value
|
||||
encodeVersions data =
|
||||
maybeObject
|
||||
[ ( "unstable_features", Maybe.map (E.dict identity E.bool) data.unstableFeatures )
|
||||
, ( "versions", Just <| E.list E.string data.versions )
|
||||
]
|
||||
|
||||
|
||||
versionsDecoder : D.Decoder Versions
|
||||
versionsDecoder =
|
||||
D.map2
|
||||
(\a b ->
|
||||
{ unstableFeatures = a, versions = b }
|
||||
)
|
||||
(opField "unstable_features" (D.dict D.bool))
|
||||
(D.field "versions" (D.list D.string))
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
version: V_all
|
||||
name: SpecObjects
|
||||
objects:
|
||||
Versions:
|
||||
description: Information on what the homeserver supports.
|
||||
fields:
|
||||
unstable_features:
|
||||
type: "{bool}"
|
||||
versions:
|
||||
type: "[string]"
|
||||
required: true
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
module Internal.Api.PreApi.Objects.Versions exposing
|
||||
module Internal.Api.Versions.V1.Versions exposing
|
||||
( Versions
|
||||
, encodeVersions
|
||||
, versionsDecoder
|
||||
|
|
@ -9,6 +9,13 @@ Values like these usually imply that there is a leakage in the implementation or
|
|||
-}
|
||||
|
||||
import Time
|
||||
import Hash
|
||||
|
||||
accessToken : String
|
||||
accessToken = "mistaken_access_token"
|
||||
|
||||
baseUrl : String
|
||||
baseUrl = "https://matrix.example.org"
|
||||
|
||||
|
||||
eventId : String
|
||||
|
|
@ -44,3 +51,11 @@ roomId =
|
|||
sender : String
|
||||
sender =
|
||||
"@alice:example.org"
|
||||
|
||||
transactionId : String
|
||||
transactionId =
|
||||
"elm" ++ (Hash.fromString "leaked_transactionId" |> Hash.toString)
|
||||
|
||||
versions : List String
|
||||
versions =
|
||||
[]
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ the `Credentials` type passes information down in the form of a `Context` type.
|
|||
|
||||
-}
|
||||
|
||||
import Internal.Api.PreApi.Objects.Versions as V
|
||||
import Internal.Api.Versions.V1.Versions as V
|
||||
import Internal.Tools.LoginValues as Login exposing (AccessToken(..))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue