Refactor to TaskChains
parent
bd73b97e93
commit
65591b710c
|
@ -1,21 +1,23 @@
|
||||||
module Internal.Api.All exposing (..)
|
module Internal.Api.All exposing (..)
|
||||||
|
|
||||||
import Hash
|
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.GetEvent.Main as GetEvent
|
||||||
import Internal.Api.Invite.Main as Invite
|
import Internal.Api.Invite.Main as Invite
|
||||||
import Internal.Api.JoinedMembers.Main as JoinedMembers
|
import Internal.Api.JoinedMembers.Main as JoinedMembers
|
||||||
import Internal.Api.PreApi.Main as PreApi
|
import Internal.Api.Versions.V1.Versions as V
|
||||||
import Internal.Api.PreApi.Objects.Versions as V
|
|
||||||
import Internal.Api.Redact.Main as Redact
|
import Internal.Api.Redact.Main as Redact
|
||||||
import Internal.Api.SendMessageEvent.Main as SendMessageEvent
|
import Internal.Api.SendMessageEvent.Main as SendMessageEvent
|
||||||
import Internal.Api.SendStateKey.Main as SendStateKey
|
import Internal.Api.SendStateKey.Main as SendStateKey
|
||||||
import Internal.Api.Sync.Main as Sync
|
import Internal.Api.Sync.Main as Sync
|
||||||
|
import Internal.Api.Versions.Main as Versions
|
||||||
import Internal.Tools.Exceptions as X
|
import Internal.Tools.Exceptions as X
|
||||||
import Internal.Tools.LoginValues exposing (AccessToken)
|
import Internal.Tools.LoginValues exposing (AccessToken)
|
||||||
import Internal.Tools.SpecEnums as Enums
|
import Internal.Tools.SpecEnums as Enums
|
||||||
import Internal.Tools.ValueGetter as VG
|
|
||||||
import Json.Encode as E
|
import Json.Encode as E
|
||||||
import Task exposing (Task)
|
import Task exposing (Task)
|
||||||
|
import Time
|
||||||
|
|
||||||
|
|
||||||
type CredUpdate
|
type CredUpdate
|
||||||
|
@ -32,299 +34,208 @@ type CredUpdate
|
||||||
| UpdateAccessToken String
|
| UpdateAccessToken String
|
||||||
| UpdateVersions V.Versions
|
| UpdateVersions V.Versions
|
||||||
|
|
||||||
|
type alias FutureTask = Task X.Error CredUpdate
|
||||||
|
|
||||||
type alias Future a =
|
{-| Turn a chain of tasks into a full executable task.
|
||||||
Task X.Error a
|
-}
|
||||||
|
toTask : TaskChain CredUpdate {} b -> FutureTask
|
||||||
|
toTask =
|
||||||
|
Chain.toTask
|
||||||
|
>> Task.map
|
||||||
|
(\updates ->
|
||||||
|
case updates of
|
||||||
|
[ item ] ->
|
||||||
|
item
|
||||||
|
|
||||||
|
_ ->
|
||||||
|
MultipleUpdates updates
|
||||||
|
)
|
||||||
|
|
||||||
type alias GetEventInput =
|
type alias GetEventInput =
|
||||||
{ accessToken : AccessToken
|
{ eventId : String, roomId : String }
|
||||||
, baseUrl : String
|
|
||||||
, eventId : String
|
|
||||||
, roomId : String
|
|
||||||
, versions : Maybe V.Versions
|
|
||||||
}
|
|
||||||
|
|
||||||
|
{-| Get an event from the API.
|
||||||
{-| Get a specific event from the Matrix API.
|
|
||||||
-}
|
-}
|
||||||
getEvent : GetEventInput -> Future CredUpdate
|
getEvent : GetEventInput -> IdemChain CredUpdate (VBA a)
|
||||||
getEvent data =
|
getEvent { eventId, roomId } context =
|
||||||
VG.withInfo2
|
|
||||||
(\accessToken versions ->
|
|
||||||
let
|
let
|
||||||
input : GetEvent.EventInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
, eventId = eventId
|
||||||
, baseUrl = data.baseUrl
|
, roomId = roomId
|
||||||
, eventId = data.eventId
|
|
||||||
, roomId = data.roomId
|
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
GetEvent.getEvent versions.versions input
|
input
|
||||||
|> Task.map
|
|> GetEvent.getEvent (Context.getVersions context)
|
||||||
(\output ->
|
|> Task.map (\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ GetEvent input output
|
{ contextChange = identity
|
||||||
, UpdateAccessToken accessToken
|
, messages = [ GetEvent input output ]
|
||||||
, UpdateVersions versions
|
}
|
||||||
]
|
|
||||||
)
|
)
|
||||||
)
|
|
||||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
{-| Insert versions, or get them if they are not provided.
|
||||||
(PreApi.versions data.baseUrl data.versions)
|
-}
|
||||||
|
getVersions : Maybe V.Versions -> TaskChain CredUpdate { a | baseUrl : () } (VB a)
|
||||||
|
getVersions mVersions =
|
||||||
|
case mVersions of
|
||||||
|
Just vs ->
|
||||||
|
withVersions vs
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
versions
|
||||||
|
|
||||||
type alias InviteInput =
|
type alias InviteInput =
|
||||||
{ accessToken : AccessToken
|
{ reason : Maybe String
|
||||||
, baseUrl : String
|
|
||||||
, reason : Maybe String
|
|
||||||
, roomId : String
|
, roomId : String
|
||||||
, userId : String
|
, userId : String
|
||||||
, versions : Maybe V.Versions
|
|
||||||
}
|
}
|
||||||
|
|
||||||
{-| Send an invite to join a room.
|
{-| Invite a user to a room. -}
|
||||||
-}
|
invite : InviteInput -> IdemChain CredUpdate (VBA a)
|
||||||
invite : InviteInput -> Future CredUpdate
|
invite { reason, roomId, userId } context =
|
||||||
invite data =
|
|
||||||
VG.withInfo2
|
|
||||||
(\accessToken versions ->
|
|
||||||
let
|
let
|
||||||
input : Invite.InviteInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
, reason = reason
|
||||||
, baseUrl = data.baseUrl
|
, roomId = roomId
|
||||||
, reason = data.reason
|
, userId = userId
|
||||||
, roomId = data.roomId
|
|
||||||
, userId = data.userId
|
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
Invite.invite versions.versions input
|
input
|
||||||
|
|> Invite.invite (Context.getVersions context)
|
||||||
|> Task.map
|
|> Task.map
|
||||||
(\output ->
|
(\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ InviteSent input output
|
{ contextChange = identity
|
||||||
, UpdateAccessToken accessToken
|
, messages = [ InviteSent input output ]
|
||||||
, UpdateVersions versions
|
}
|
||||||
]
|
|
||||||
)
|
)
|
||||||
)
|
|
||||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
|
||||||
(PreApi.versions data.baseUrl data.versions)
|
|
||||||
|
|
||||||
|
|
||||||
type alias JoinedMembersInput =
|
type alias JoinedMembersInput =
|
||||||
{ accessToken : AccessToken
|
{ roomId : String }
|
||||||
, baseUrl : String
|
|
||||||
, roomId : String
|
|
||||||
, versions : Maybe V.Versions
|
|
||||||
}
|
|
||||||
|
|
||||||
|
joinedMembers : JoinedMembersInput -> IdemChain CredUpdate (VBA a)
|
||||||
{-| Get a list of members who are part of a Matrix room.
|
joinedMembers { roomId } context =
|
||||||
-}
|
|
||||||
joinedMembers : JoinedMembersInput -> Future CredUpdate
|
|
||||||
joinedMembers data =
|
|
||||||
VG.withInfo2
|
|
||||||
(\accessToken versions ->
|
|
||||||
let
|
let
|
||||||
input : JoinedMembers.JoinedMembersInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
, roomId = roomId
|
||||||
, baseUrl = data.baseUrl
|
|
||||||
, roomId = data.roomId
|
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
JoinedMembers.joinedMembers versions.versions input
|
input
|
||||||
|
|> JoinedMembers.joinedMembers (Context.getVersions context)
|
||||||
|> Task.map
|
|> Task.map
|
||||||
(\output ->
|
(\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ JoinedMembersToRoom input output
|
{ contextChange = identity
|
||||||
, UpdateAccessToken accessToken
|
, messages = [ JoinedMembersToRoom input output ]
|
||||||
, UpdateVersions versions
|
}
|
||||||
]
|
|
||||||
)
|
)
|
||||||
)
|
|
||||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
|
||||||
(PreApi.versions data.baseUrl data.versions)
|
|
||||||
|
|
||||||
|
type alias RedactInput =
|
||||||
type alias RedactEventInput =
|
{ eventId : String
|
||||||
{ accessToken : AccessToken
|
|
||||||
, baseUrl : String
|
|
||||||
, eventId : String
|
|
||||||
, reason : Maybe String
|
, reason : Maybe String
|
||||||
, roomId : String
|
, roomId : String
|
||||||
, versions : Maybe V.Versions
|
|
||||||
, extraTransactionNoise : String
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{-| Redact an event from a room.
|
||||||
{-| Redact an event from a Matrix room.
|
|
||||||
-}
|
-}
|
||||||
redact : RedactEventInput -> Future CredUpdate
|
redact : RedactInput -> TaskChain CredUpdate (VBAT a) (VBA a)
|
||||||
redact data =
|
redact { eventId, reason, roomId } context =
|
||||||
VG.withInfo3
|
|
||||||
(\accessToken versions transactionId ->
|
|
||||||
let
|
let
|
||||||
input : Redact.RedactInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
, eventId = eventId
|
||||||
, baseUrl = data.baseUrl
|
, reason = reason
|
||||||
, roomId = data.roomId
|
, roomId = roomId
|
||||||
, eventId = data.eventId
|
, txnId = Context.getTransactionId context
|
||||||
, txnId = transactionId
|
|
||||||
, reason = data.reason
|
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
-- TODO: As an option, the API may get this event to see
|
input
|
||||||
-- what the event looks like now.
|
|> Redact.redact (Context.getVersions context)
|
||||||
Redact.redact versions.versions input
|
|
||||||
|> Task.map
|
|> Task.map
|
||||||
(\output ->
|
(\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ RedactedEvent input output
|
{ contextChange = Context.removeTransactionId
|
||||||
]
|
, messages = [ 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 =
|
type alias SendMessageEventInput =
|
||||||
{ accessToken : AccessToken
|
{ content : E.Value
|
||||||
, baseUrl : String
|
|
||||||
, content : E.Value
|
|
||||||
, eventType : String
|
, eventType : String
|
||||||
, roomId : String
|
, roomId : String
|
||||||
, versions : Maybe V.Versions
|
|
||||||
, extraTransactionNoise : String
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{-| Send a message event to a room.
|
||||||
{-| Send a message event into a Matrix room.
|
|
||||||
-}
|
-}
|
||||||
sendMessageEvent : SendMessageEventInput -> Future CredUpdate
|
sendMessageEvent : SendMessageEventInput -> TaskChain CredUpdate (VBAT a) (VBA a)
|
||||||
sendMessageEvent data =
|
sendMessageEvent { content, eventType, roomId } context =
|
||||||
VG.withInfo3
|
|
||||||
(\accessToken versions transactionId ->
|
|
||||||
let
|
let
|
||||||
input : SendMessageEvent.SendMessageEventInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
, content = content
|
||||||
, baseUrl = data.baseUrl
|
, eventType = eventType
|
||||||
, content = data.content
|
, roomId = roomId
|
||||||
, eventType = data.eventType
|
, transactionId = Context.getTransactionId context
|
||||||
, roomId = data.roomId
|
|
||||||
, transactionId = transactionId
|
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
SendMessageEvent.sendMessageEvent versions.versions input
|
input
|
||||||
|
|> SendMessageEvent.sendMessageEvent (Context.getVersions context)
|
||||||
|> Task.map
|
|> Task.map
|
||||||
(\output ->
|
(\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ MessageEventSent input output
|
{ contextChange = Context.removeTransactionId
|
||||||
, UpdateAccessToken accessToken
|
, messages = [ MessageEventSent input output ]
|
||||||
, 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 SendStateEventInput =
|
||||||
type alias SendStateKeyInput =
|
{ content : E.Value
|
||||||
{ accessToken : AccessToken
|
|
||||||
, baseUrl : String
|
|
||||||
, content : E.Value
|
|
||||||
, eventType : String
|
, eventType : String
|
||||||
, roomId : String
|
, roomId : String
|
||||||
, stateKey : String
|
, stateKey : String
|
||||||
, versions : Maybe V.Versions
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{-| Send a state key event to a room.
|
||||||
{-| Send a state event into a Matrix room.
|
|
||||||
-}
|
-}
|
||||||
sendStateEvent : SendStateKeyInput -> Future CredUpdate
|
sendStateEvent : SendStateEventInput -> IdemChain CredUpdate (VBA a)
|
||||||
sendStateEvent data =
|
sendStateEvent { content, eventType, roomId, stateKey } context =
|
||||||
VG.withInfo2
|
|
||||||
(\accessToken versions ->
|
|
||||||
let
|
let
|
||||||
input : SendStateKey.SendStateKeyInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
, content = content
|
||||||
, baseUrl = data.baseUrl
|
, eventType = eventType
|
||||||
, content = data.content
|
, roomId = roomId
|
||||||
, eventType = data.eventType
|
, stateKey = stateKey
|
||||||
, roomId = data.roomId
|
|
||||||
, stateKey = data.stateKey
|
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
SendStateKey.sendStateKey versions.versions input
|
input
|
||||||
|
|> SendStateKey.sendStateKey (Context.getVersions context)
|
||||||
|> Task.map
|
|> Task.map
|
||||||
(\output ->
|
(\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ StateEventSent input output
|
{ contextChange = identity
|
||||||
, UpdateAccessToken accessToken
|
, messages = [ StateEventSent input output ]
|
||||||
, UpdateVersions versions
|
}
|
||||||
]
|
|
||||||
)
|
)
|
||||||
)
|
|
||||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
|
||||||
(PreApi.versions data.baseUrl data.versions)
|
|
||||||
|
|
||||||
|
|
||||||
type alias SyncInput =
|
type alias SyncInput =
|
||||||
{ accessToken : AccessToken
|
{ filter : Maybe String
|
||||||
, baseUrl : String
|
|
||||||
, filter : Maybe String
|
|
||||||
, fullState : Maybe Bool
|
, fullState : Maybe Bool
|
||||||
, setPresence : Maybe Enums.UserPresence
|
, setPresence : Maybe Enums.UserPresence
|
||||||
, since : Maybe String
|
, since : Maybe String
|
||||||
, timeout : Maybe Int
|
, timeout : Maybe Int
|
||||||
, versions : Maybe V.Versions
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{-| Sync the latest updates.
|
||||||
{-| Get the latest sync from the Matrix API.
|
|
||||||
-}
|
-}
|
||||||
syncCredentials : SyncInput -> Future CredUpdate
|
sync : SyncInput -> IdemChain CredUpdate (VBA a)
|
||||||
syncCredentials data =
|
sync data context =
|
||||||
VG.withInfo2
|
|
||||||
(\accessToken versions ->
|
|
||||||
let
|
let
|
||||||
input : Sync.SyncInput
|
input = { accessToken = Context.getAccessToken context
|
||||||
input =
|
, baseUrl = Context.getBaseUrl context
|
||||||
{ accessToken = accessToken
|
|
||||||
, baseUrl = data.baseUrl
|
|
||||||
, filter = data.filter
|
, filter = data.filter
|
||||||
, fullState = data.fullState
|
, fullState = data.fullState
|
||||||
, setPresence = data.setPresence
|
, setPresence = data.setPresence
|
||||||
|
@ -332,15 +243,79 @@ syncCredentials data =
|
||||||
, timeout = data.timeout
|
, timeout = data.timeout
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
Sync.sync versions.versions input
|
input
|
||||||
|
|> Sync.sync (Context.getVersions context)
|
||||||
|> Task.map
|
|> Task.map
|
||||||
(\output ->
|
(\output ->
|
||||||
MultipleUpdates
|
Chain.TaskChainPiece
|
||||||
[ SyncUpdate input output
|
{ contextChange = identity
|
||||||
, UpdateAccessToken accessToken
|
, messages = [ SyncUpdate input output ]
|
||||||
, 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 ]
|
||||||
|
}
|
||||||
)
|
)
|
||||||
(PreApi.accessToken data.baseUrl data.accessToken)
|
|
||||||
(PreApi.versions data.baseUrl data.versions)
|
{-| 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
|
||||||
|
)
|
||||||
|
|> 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.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.Api.Request as R
|
||||||
import Internal.Tools.Exceptions as X
|
import Internal.Tools.Exceptions as X
|
||||||
import Internal.Tools.LoginValues exposing (AccessToken(..))
|
import Internal.Tools.LoginValues exposing (AccessToken(..))
|
||||||
|
|
|
@ -1,15 +1,11 @@
|
||||||
module Internal.Api.Versions.Api exposing (..)
|
module Internal.Api.Versions.Api exposing (..)
|
||||||
|
|
||||||
import Internal.Api.Request as R
|
import Internal.Api.Request as R
|
||||||
import Internal.Api.Versions.Convert as C
|
import Internal.Api.Versions.V1.Versions as SO
|
||||||
import Internal.Api.Versions.Objects as O
|
|
||||||
import Internal.Api.Versions.SpecObjects as SO
|
|
||||||
import Internal.Tools.Exceptions as X
|
import Internal.Tools.Exceptions as X
|
||||||
import Json.Decode as D
|
|
||||||
import Task exposing (Task)
|
import Task exposing (Task)
|
||||||
|
|
||||||
|
versionsV1 : { baseUrl : String } -> Task X.Error SO.Versions
|
||||||
versionsV1 : { baseUrl : String } -> Task X.Error O.Versions
|
|
||||||
versionsV1 data =
|
versionsV1 data =
|
||||||
R.rawApiCall
|
R.rawApiCall
|
||||||
{ headers = R.NoHeaders
|
{ headers = R.NoHeaders
|
||||||
|
@ -20,5 +16,5 @@ versionsV1 data =
|
||||||
, queryParams = []
|
, queryParams = []
|
||||||
, bodyParams = []
|
, bodyParams = []
|
||||||
, timeout = Nothing
|
, 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 (..)
|
module Internal.Api.Versions.Main exposing (..)
|
||||||
|
|
||||||
import Internal.Api.Versions.Api as Api
|
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 Internal.Tools.Exceptions as X
|
||||||
import Task exposing (Task)
|
import Task exposing (Task)
|
||||||
|
|
||||||
|
@ -11,7 +11,7 @@ type alias VersionsInput =
|
||||||
|
|
||||||
|
|
||||||
type alias VersionsOutput =
|
type alias VersionsOutput =
|
||||||
O.Versions
|
SO.Versions
|
||||||
|
|
||||||
|
|
||||||
getVersions : VersionsInput -> Task X.Error VersionsOutput
|
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
|
( Versions
|
||||||
, encodeVersions
|
, encodeVersions
|
||||||
, versionsDecoder
|
, versionsDecoder
|
|
@ -9,6 +9,13 @@ Values like these usually imply that there is a leakage in the implementation or
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import Time
|
import Time
|
||||||
|
import Hash
|
||||||
|
|
||||||
|
accessToken : String
|
||||||
|
accessToken = "mistaken_access_token"
|
||||||
|
|
||||||
|
baseUrl : String
|
||||||
|
baseUrl = "https://matrix.example.org"
|
||||||
|
|
||||||
|
|
||||||
eventId : String
|
eventId : String
|
||||||
|
@ -44,3 +51,11 @@ roomId =
|
||||||
sender : String
|
sender : String
|
||||||
sender =
|
sender =
|
||||||
"@alice:example.org"
|
"@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(..))
|
import Internal.Tools.LoginValues as Login exposing (AccessToken(..))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue