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

Refactor: connect API tasks to Context

pull/1/head
Bram van den Heuvel 2023-03-14 15:18:23 +01:00
parent e7804b096f
commit e90f823000
20 changed files with 606 additions and 823 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

229
src/Internal/Api/CredUpdate.elm
View File

@ -41,6 +41,14 @@ type alias FutureTask =
Task X.Error CredUpdate
{-| Turn an API Task into a taskchain.
-}
toChain : (cout -> Chain.TaskChainPiece CredUpdate ph1 ph2) -> (Context.Context ph1 -> cin -> Task X.Error cout) -> cin -> TaskChain CredUpdate ph1 ph2
toChain transform task input context =
task context input
|> Task.map transform
{-| Turn a chain of tasks into a full executable task.
-}
toTask : TaskChain CredUpdate {} b -> FutureTask
@ -86,134 +94,79 @@ accessToken ctoken =
{ username = username, password = password }
type alias GetEventInput =
{ eventId : String, roomId : String }
{-| Get an event from the API.
-}
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
getEvent : GetEvent.EventInput -> IdemChain CredUpdate (VBA a)
getEvent input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ GetEvent input output ]
}
)
GetEvent.getEvent
input
{-| Get the supported spec versions from the homeserver.
-}
getVersions : TaskChain CredUpdate { a | baseUrl : () } (VB a)
getVersions context =
let
input =
Context.getBaseUrl context
in
Versions.getVersions input
|> Task.map
getVersions =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.setVersions output.versions
, messages = [ UpdateVersions output ]
}
)
type alias InviteInput =
{ reason : Maybe String
, roomId : String
, userId : String
}
(\context _ -> Versions.getVersions context)
()
{-| 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
invite : Invite.InviteInput -> IdemChain CredUpdate (VBA a)
invite input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ InviteSent input output ]
}
)
type alias JoinedMembersInput =
{ roomId : String }
joinedMembers : JoinedMembersInput -> IdemChain CredUpdate (VBA a)
joinedMembers { roomId } context =
let
input =
{ accessToken = Context.getAccessToken context
, baseUrl = Context.getBaseUrl context
, roomId = roomId
}
in
Invite.invite
input
|> JoinedMembers.joinedMembers (Context.getVersions context)
|> Task.map
joinedMembers : JoinedMembers.JoinedMembersInput -> IdemChain CredUpdate (VBA a)
joinedMembers input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ JoinedMembersToRoom input output ]
}
)
type alias LoginWithUsernameAndPasswordInput =
{ password : String
, username : String
}
loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> TaskChain CredUpdate (VB a) (VBA a)
loginWithUsernameAndPassword ({ username, password } as data) context =
let
input =
{ baseUrl = Context.getBaseUrl context
, username = username
, password = password
}
in
JoinedMembers.joinedMembers
input
|> LoginWithUsernameAndPassword.loginWithUsernameAndPassword (Context.getVersions context)
|> Task.map
loginWithUsernameAndPassword : LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput -> TaskChain CredUpdate (VB a) (VBA a)
loginWithUsernameAndPassword input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange =
Context.setAccessToken
{ accessToken = output.accessToken
, usernameAndPassword = Just data
, usernameAndPassword = Just input
}
, messages = [ LoggedInWithUsernameAndPassword input output ]
}
)
LoginWithUsernameAndPassword.loginWithUsernameAndPassword
input
{-| Make a VB-context based chain.
@ -244,136 +197,64 @@ makeVBAT toString cred =
|> Chain.andThen (withTransactionId toString)
type alias RedactInput =
{ eventId : String
, reason : Maybe String
, roomId : String
}
{-| Redact an event from a room.
-}
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
redact : Redact.RedactInput -> TaskChain CredUpdate (VBAT a) (VBA a)
redact input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId
, messages = [ RedactedEvent input output ]
}
)
type alias SendMessageEventInput =
{ content : E.Value
, eventType : String
, roomId : String
}
Redact.redact
input
{-| Send a message event to a room.
-}
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
sendMessageEvent : SendMessageEvent.SendMessageEventInput -> TaskChain CredUpdate (VBAT a) (VBA a)
sendMessageEvent input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = Context.removeTransactionId
, messages = [ MessageEventSent input output ]
}
)
type alias SendStateEventInput =
{ content : E.Value
, eventType : String
, roomId : String
, stateKey : String
}
SendMessageEvent.sendMessageEvent
input
{-| Send a state key event to a room.
-}
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
sendStateEvent : SendStateKey.SendStateKeyInput -> IdemChain CredUpdate (VBA a)
sendStateEvent input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ StateEventSent input output ]
}
)
type alias SyncInput =
{ filter : Maybe String
, fullState : Maybe Bool
, setPresence : Maybe Enums.UserPresence
, since : Maybe String
, timeout : Maybe Int
}
SendStateKey.sendStateKey
input
{-| Sync the latest updates.
-}
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
sync : Sync.SyncInput -> IdemChain CredUpdate (VBA a)
sync input =
toChain
(\output ->
Chain.TaskChainPiece
{ contextChange = identity
, messages = [ SyncUpdate input output ]
}
)
Sync.sync
input
{-| Insert versions, or get them if they are not provided.

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

@ -2,14 +2,13 @@ module Internal.Api.GetEvent.Api exposing (..)
import Internal.Api.GetEvent.V1.SpecObjects as SO1
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
type alias GetEventInputV1 =
{ accessToken : String
, baseUrl : String
, eventId : String
{ eventId : String
, roomId : String
}
@ -18,19 +17,12 @@ type alias GetEventOutputV1 =
SO1.ClientEvent
getEventInputV1 : GetEventInputV1 -> Task X.Error GetEventOutputV1
getEventInputV1 : GetEventInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetEventOutputV1
getEventInputV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "GET"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/rooms/{roomId}/event/{eventId}"
, pathParams =
[ ( "eventId", data.eventId )
, ( "roomId", data.roomId )
R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/event/{eventId}"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "eventId" data.eventId
, R.replaceInUrl "roomId" data.roomId
]
, queryParams = []
, bodyParams = []
, timeout = Nothing
, decoder = \_ -> SO1.clientEventDecoder
}
>> R.toTask SO1.clientEventDecoder

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

@ -1,23 +1,20 @@
module Internal.Api.Invite.Api exposing (..)
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Task exposing (Task)
type alias InviteInputV1 =
{ accessToken : String
, baseUrl : String
, roomId : String
{ roomId : String
, userId : String
}
type alias InviteInputV2 =
{ accessToken : String
, baseUrl : String
, reason : Maybe String
{ reason : Maybe String
, roomId : String
, userId : String
}
@ -27,40 +24,24 @@ type alias InviteOutputV1 =
()
inviteV1 : InviteInputV1 -> Task X.Error InviteOutputV1
inviteV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "POST"
, baseUrl = data.baseUrl
, path = "/_matrix/client/r0/rooms/{roomId}/invite"
, pathParams =
[ ( "roomId", data.roomId )
inviteV1 : InviteInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error InviteOutputV1
inviteV1 { roomId, userId } =
R.callApi "POST" "/_matrix/client/r0/rooms/{roomId}/invite"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "roomId" roomId
, R.bodyString "user_id" userId
]
, queryParams = []
, bodyParams =
[ R.RequiredString "user_id" data.userId
]
, timeout = Nothing
, decoder = always (D.map (always ()) D.value)
}
>> R.toTask (D.map (always ()) D.value)
inviteV2 : InviteInputV2 -> Task X.Error InviteOutputV1
inviteV2 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "POST"
, baseUrl = data.baseUrl
, path = "/_matrix/client/r0/rooms/{roomId}/invite"
, pathParams =
[ ( "roomId", data.roomId )
inviteV2 : InviteInputV2 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error InviteOutputV1
inviteV2 { reason, roomId, userId } =
R.callApi "POST" "/_matrix/client/v3/rooms/{roomId}/invite"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "roomId" roomId
, R.bodyString "user_id" userId
, R.bodyOpString "reason" reason
]
, queryParams = []
, bodyParams =
[ R.RequiredString "user_id" data.userId
, R.OptionalString "reason" data.reason
]
, timeout = Nothing
, decoder = always (D.map (always ()) D.value)
}
>> R.toTask (D.map (always ()) D.value)

15
src/Internal/Api/Invite/Main.elm
View File

@ -1,13 +1,14 @@
module Internal.Api.Invite.Main exposing (..)
import Internal.Api.Invite.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBA)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
invite : List String -> InviteInput -> Task X.Error InviteOutput
invite versions =
invite : Context (VBA a) -> InviteInput -> Task X.Error InviteOutput
invite context input =
VC.withBottomLayer
{ current = Api.inviteV1
, version = "r0.0.0"
@ -23,9 +24,7 @@ invite versions =
|> VC.addMiddleLayer
{ downcast =
\data ->
{ accessToken = data.accessToken
, baseUrl = data.baseUrl
, roomId = data.roomId
{ roomId = data.roomId
, userId = data.userId
}
, current = Api.inviteV2
@ -36,8 +35,10 @@ invite versions =
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias InviteInput =

47
src/Internal/Api/JoinedMembers/Api.elm
View File

@ -2,14 +2,13 @@ module Internal.Api.JoinedMembers.Api exposing (..)
import Internal.Api.JoinedMembers.V1.SpecObjects as SO1
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
type alias JoinedMembersInputV1 =
{ accessToken : String
, baseUrl : String
, roomId : String
{ roomId : String
}
@ -17,35 +16,21 @@ type alias JoinedMembersOutputV1 =
SO1.RoomMemberList
joinedMembersV1 : JoinedMembersInputV1 -> Task X.Error JoinedMembersOutputV1
joinedMembersV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "GET"
, baseUrl = data.baseUrl
, path = "/_matrix/client/r0/rooms/{roomId}/joined_members"
, pathParams =
[ ( "roomId", data.roomId )
joinedMembersV1 : JoinedMembersInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error JoinedMembersOutputV1
joinedMembersV1 { roomId } =
R.callApi "GET" "/_matrix/client/r0/rooms/{roomId}/joined_members"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "roomId" roomId
]
, queryParams = []
, bodyParams = []
, timeout = Nothing
, decoder = \_ -> SO1.roomMemberListDecoder
}
>> R.toTask SO1.roomMemberListDecoder
joinedMembersV2 : JoinedMembersInputV1 -> Task X.Error JoinedMembersOutputV1
joinedMembersV2 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "GET"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/rooms/{roomId}/joined_members"
, pathParams =
[ ( "roomId", data.roomId )
joinedMembersV2 : JoinedMembersInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error JoinedMembersOutputV1
joinedMembersV2 { roomId } =
R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/joined_members"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "roomId" roomId
]
, queryParams = []
, bodyParams = []
, timeout = Nothing
, decoder = \_ -> SO1.roomMemberListDecoder
}
>> R.toTask SO1.roomMemberListDecoder

11
src/Internal/Api/JoinedMembers/Main.elm
View File

@ -1,13 +1,14 @@
module Internal.Api.JoinedMembers.Main exposing (..)
import Internal.Api.JoinedMembers.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBA)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
joinedMembers : List String -> JoinedMembersInput -> Task X.Error JoinedMembersOutput
joinedMembers versions =
joinedMembers : Context (VBA a) -> JoinedMembersInput -> Task X.Error JoinedMembersOutput
joinedMembers context input =
VC.withBottomLayer
{ current = Api.joinedMembersV1
, version = "r0.0.0"
@ -30,8 +31,10 @@ joinedMembers versions =
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias JoinedMembersInput =

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

@ -2,14 +2,14 @@ module Internal.Api.LoginWithUsernameAndPassword.Api exposing (..)
import Internal.Api.LoginWithUsernameAndPassword.V1.Login as SO
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Encode as E
import Task exposing (Task)
type alias LoginWithUsernameAndPasswordInputV1 =
{ baseUrl : String
, password : String
{ password : String
, username : String
}
@ -18,24 +18,16 @@ type alias LoginWithUsernameAndPasswordOutputV1 =
SO.LoggedInResponse
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 -> Task X.Error LoginWithUsernameAndPasswordOutputV1
loginWithUsernameAndPasswordV1 data =
R.rawApiCall
{ headers = R.NoHeaders
, method = "POST"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/login"
, pathParams = []
, queryParams = []
, bodyParams =
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 -> Context { a | baseUrl : () } -> Task X.Error LoginWithUsernameAndPasswordOutputV1
loginWithUsernameAndPasswordV1 { username, password } =
R.callApi "POST" "/_matrix/client/v3/login"
>> R.withAttributes
[ [ ( "type", E.string "m.id.user" )
, ( "user", E.string data.username )
, ( "user", E.string username )
]
|> E.object
|> R.RequiredValue "identifier"
, R.RequiredString "password" data.password
, R.RequiredString "type" "m.login.password"
|> R.bodyValue "identifier"
, R.bodyString "password" password
, R.bodyString "type" "m.login.password"
]
, timeout = Nothing
, decoder = always SO.loggedInResponseDecoder
}
>> R.toTask SO.loggedInResponseDecoder

11
src/Internal/Api/LoginWithUsernameAndPassword/Main.elm
View File

@ -1,19 +1,22 @@
module Internal.Api.LoginWithUsernameAndPassword.Main exposing (..)
import Internal.Api.LoginWithUsernameAndPassword.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBA)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
loginWithUsernameAndPassword : List String -> LoginWithUsernameAndPasswordInput -> Task X.Error LoginWithUsernameAndPasswordOutput
loginWithUsernameAndPassword versions =
loginWithUsernameAndPassword : Context (VBA a) -> LoginWithUsernameAndPasswordInput -> Task X.Error LoginWithUsernameAndPasswordOutput
loginWithUsernameAndPassword context input =
VC.withBottomLayer
{ current = Api.loginWithUsernameAndPasswordV1
, version = "v1.5"
}
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias LoginWithUsernameAndPasswordInput =

90
src/Internal/Api/PreApi/Main.elm
View File

@ -1,90 +0,0 @@
module Internal.Api.PreApi.Main exposing (..)
{-| Certain values are required knowledge for (almost) every endpoint.
Some values aren't known right away, however.
This module takes care of values like access tokens, transaction ids and spec version lists
that the credentials type needs to know about before it can make a request.
-}
import Internal.Api.LoginWithUsernameAndPassword.V1.Login as L
import Internal.Api.Request as R
import Internal.Api.Versions.V1.Versions as V
import Internal.Tools.Exceptions as X
import Internal.Tools.LoginValues exposing (AccessToken(..))
import Internal.Tools.ValueGetter exposing (ValueGetter)
import Json.Encode as E
import Task
import Time
accessToken : String -> AccessToken -> ValueGetter X.Error String
accessToken baseUrl t =
{ value =
case t of
NoAccess ->
Nothing
AccessToken token ->
Just token
UsernameAndPassword { token } ->
token
, getValue =
case t of
UsernameAndPassword { username, password } ->
R.rawApiCall
{ headers = R.NoHeaders
, method = "POST"
, baseUrl = baseUrl
, path = "/_matrix/client/v3/login"
, pathParams = []
, queryParams = []
, bodyParams =
[ [ ( "type", E.string "m.id.user" )
, ( "user", E.string username )
]
|> E.object
|> R.RequiredValue "identifier"
, R.RequiredString "password" password
, R.RequiredString "type" "m.login.password"
]
, timeout = Nothing
, decoder = \_ -> L.loggedInResponseDecoder
}
|> Task.map .accessToken
_ ->
X.NoAccessToken
|> X.SDKException
|> Task.fail
}
transactionId : (Int -> String) -> ValueGetter X.Error String
transactionId seeder =
{ value = Nothing
, getValue =
Time.now
|> Task.map Time.posixToMillis
|> Task.map seeder
}
versions : String -> Maybe V.Versions -> ValueGetter X.Error V.Versions
versions baseUrl mVersions =
{ value = mVersions
, getValue =
R.rawApiCall
{ headers = R.NoHeaders
, method = "GET"
, baseUrl = baseUrl
, path = "/_matrix/client/versions"
, pathParams = []
, queryParams = []
, bodyParams = []
, timeout = Nothing
, decoder = \_ -> V.versionsDecoder
}
}

60
src/Internal/Api/Redact/Api.elm
View File

@ -2,16 +2,14 @@ module Internal.Api.Redact.Api exposing (..)
import Internal.Api.Redact.V1.SpecObjects as SO1
import Internal.Api.Request as R
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
type alias RedactInputV1 =
{ accessToken : String
, baseUrl : String
, roomId : String
{ roomId : String
, eventId : String
, txnId : String
, reason : Maybe String
}
@ -20,41 +18,27 @@ type alias RedactOutputV1 =
SO1.Redaction
redactV1 : RedactInputV1 -> Task X.Error RedactOutputV1
redactV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "PUT"
, baseUrl = data.baseUrl
, path = "/_matrix/client/r0/rooms/{roomId}/redact/{eventId}/{txnId}"
, pathParams =
[ ( "roomId", data.roomId )
, ( "eventId", data.eventId )
, ( "txnId", data.txnId )
redactV1 : RedactInputV1 -> Context { a | accessToken : (), baseUrl : (), transactionId : () } -> Task X.Error RedactOutputV1
redactV1 { eventId, reason, roomId } =
R.callApi "PUT" "/_matrix/client/r0/rooms/{roomId}/redact/{eventId}/{txnId}"
>> R.withAttributes
[ R.accessToken
, R.withTransactionId
, R.replaceInUrl "eventId" eventId
, R.replaceInUrl "roomId" roomId
, R.bodyOpString "reason" reason
]
, queryParams = []
, bodyParams =
[ R.OptionalString "reason" data.reason
]
, timeout = Nothing
, decoder = always SO1.redactionDecoder
}
>> R.toTask SO1.redactionDecoder
redactV2 : RedactInputV1 -> Task X.Error RedactOutputV1
redactV2 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "PUT"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/rooms/{roomId}/redact/{eventId}/{txnId}"
, pathParams =
[ ( "roomId", data.roomId )
, ( "eventId", data.eventId )
, ( "txnId", data.txnId )
redactV2 : RedactInputV1 -> Context { a | accessToken : (), baseUrl : (), transactionId : () } -> Task X.Error RedactOutputV1
redactV2 { eventId, reason, roomId } =
R.callApi "PUT" "/_matrix/client/v3/rooms/{roomId}/redact/{eventId}/{txnId}"
>> R.withAttributes
[ R.accessToken
, R.withTransactionId
, R.replaceInUrl "eventId" eventId
, R.replaceInUrl "roomId" roomId
, R.bodyOpString "reason" reason
]
, queryParams = []
, bodyParams = []
, timeout = Nothing
, decoder = always SO1.redactionDecoder
}
>> R.toTask SO1.redactionDecoder

11
src/Internal/Api/Redact/Main.elm
View File

@ -1,13 +1,14 @@
module Internal.Api.Redact.Main exposing (..)
import Internal.Api.Redact.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBAT)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
redact : List String -> RedactInput -> Task X.Error RedactOutput
redact versions =
redact : Context (VBAT a) -> RedactInput -> Task X.Error RedactOutput
redact context input =
VC.withBottomLayer
{ current = Api.redactV1
, version = "r0.0.0"
@ -30,8 +31,10 @@ redact versions =
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias RedactInput =

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

@ -1,229 +1,321 @@
module Internal.Api.Request exposing (..)
import Http
import Internal.Tools.Context as Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Json.Encode as E
import Process
import Task exposing (Task)
import Time
import Url
import Url.Builder as UrlBuilder
{-| Make a raw API call to a Matrix API.
-}
rawApiCall :
{ headers : Headers
, method : String
type ApiCall ph
= ApiCall
{ attributes : List ContextAttr
, baseUrl : String
, path : String
, pathParams : List ( String, String )
, queryParams : List QueryParam
, bodyParams : List BodyParam
, timeout : Maybe Float
, decoder : Int -> D.Decoder a
, context : Context ph
, method : String
}
-> Task X.Error a
rawApiCall data =
type alias Attribute a =
Context a -> ContextAttr
type ContextAttr
= BodyParam String E.Value
| FullBody E.Value
| Header Http.Header
| NoAttr
| QueryParam UrlBuilder.QueryParameter
| ReplaceInUrl String String
| Timeout Float
| UrlPath String
callApi : String -> String -> Context { a | baseUrl : () } -> ApiCall { a | baseUrl : () }
callApi method path context =
ApiCall
{ attributes =
[ UrlPath path
]
, baseUrl = Context.getBaseUrl context
, context = context
, method = method
}
{- GETTING VALUES
Once a user has finished building the ApiCall, we will build the task.
-}
toTask : D.Decoder a -> ApiCall ph -> Task X.Error a
toTask decoder (ApiCall data) =
Http.task
{ method = data.method
, headers = fromHeaders data.headers
, url = buildUrl data.baseUrl data.path data.pathParams data.queryParams
, body = toBody data.bodyParams
, resolver = rawApiCallResolver data.decoder
, timeout = data.timeout
}
withRateLimits : Int -> Task X.Error a -> Task X.Error a
withRateLimits timeout task =
Time.now
|> Task.onError
(\_ -> X.CouldntGetTimestamp |> X.SDKException |> Task.fail)
|> Task.andThen
(\now ->
task
|> Task.onError
(\err ->
case err of
X.ServerException (X.M_LIMIT_EXCEEDED data) ->
case data.retryAfterMs of
Just t ->
Process.sleep (toFloat t)
|> Task.andThen (\_ -> Time.now)
|> Task.andThen
(\newNow ->
let
diff : Int
diff =
timeout - (Time.posixToMillis newNow - Time.posixToMillis now)
in
if diff <= 0 then
Task.fail err
else
withRateLimits diff task
)
Nothing ->
Task.fail err
_ ->
Task.fail err
)
)
{-| Potential headers to go along with a Matrix API call.
-}
type Headers
= NoHeaders
| WithAccessToken String
| WithContentType String
| WithBoth { accessToken : String, contentType : String }
{-| Turn Headers into useful values
-}
fromHeaders : Headers -> List Http.Header
fromHeaders h =
(case h of
NoHeaders ->
[ ( "Content-Type", "application/json" ) ]
WithAccessToken token ->
[ ( "Content-Type", "application/json" ), ( "Authorization", "Bearer " ++ token ) ]
WithContentType contentType ->
[ ( "Content-Type", contentType ) ]
WithBoth data ->
[ ( "Content-Type", data.contentType ), ( "Authorization", "Bearer " ++ data.accessToken ) ]
)
|> List.map (\( a, b ) -> Http.header a b)
{-| -}
type QueryParam
= QueryParamString String String
| OpQueryParamString String (Maybe String)
| QueryParamInt String Int
| OpQueryParamInt String (Maybe Int)
| QueryParamBool String Bool
| OpQueryParamBool String (Maybe Bool)
fromQueryParam : QueryParam -> Maybe UrlBuilder.QueryParameter
fromQueryParam param =
case param of
QueryParamString key value ->
Just <| UrlBuilder.string key value
OpQueryParamString key value ->
Maybe.map (UrlBuilder.string key) value
QueryParamInt key value ->
Just <| UrlBuilder.int key value
OpQueryParamInt key value ->
Maybe.map (UrlBuilder.int key) value
QueryParamBool key value ->
if value then
Just <| UrlBuilder.string key "true"
else
Just <| UrlBuilder.string key "false"
OpQueryParamBool key value ->
Maybe.andThen (QueryParamBool key >> fromQueryParam) value
fromQueryParams : List QueryParam -> List UrlBuilder.QueryParameter
fromQueryParams =
List.map fromQueryParam
>> List.filterMap identity
buildUrl : String -> String -> List ( String, String ) -> List QueryParam -> String
buildUrl baseUrl path pathParams queryParams =
let
fullPath : String
fullPath =
List.foldl
(\( a, b ) -> String.replace ("{" ++ a ++ "}") b)
path
pathParams
|> (\s ->
if String.startsWith "/" s then
String.dropLeft 1 s
else
s
)
in
UrlBuilder.crossOrigin baseUrl [ fullPath ] (fromQueryParams queryParams)
{-| Type that gathers all parameters that go in the request body.
-}
type BodyParam
= OptionalString String (Maybe String)
| RequiredString String String
| OptionalInt String (Maybe Int)
| RequiredInt String Int
| OptionalValue String (Maybe E.Value)
| RequiredValue String E.Value
encodeBodyParam : BodyParam -> ( String, Maybe E.Value )
encodeBodyParam b =
case b of
OptionalString h s ->
( h, Maybe.map E.string s )
RequiredString h s ->
( h, Just <| E.string s )
OptionalInt h i ->
( h, Maybe.map E.int i )
RequiredInt h i ->
( h, Just <| E.int i )
OptionalValue h v ->
( h, v )
RequiredValue h v ->
( h, Just v )
toBody : List BodyParam -> Http.Body
toBody params =
case params of
(RequiredValue "*" v) :: [] ->
Http.jsonBody v
_ ->
List.map encodeBodyParam params
|> maybeObject
|> Http.jsonBody
{-| Create a body object based on optionally provided values.
-}
maybeObject : List ( String, Maybe E.Value ) -> E.Value
maybeObject =
, headers =
List.filterMap
(\( name, value ) ->
case value of
Just v ->
Just ( name, v )
(\attr ->
case attr of
Header h ->
Just h
_ ->
Nothing
)
>> E.object
data.attributes
, url = getUrl (ApiCall data)
, body =
data.attributes
|> List.filterMap
(\attr ->
case attr of
FullBody v ->
Just v
_ ->
Nothing
)
|> List.reverse
|> List.head
|> Maybe.withDefault
(List.filterMap
(\attr ->
case attr of
BodyParam key value ->
Just ( key, value )
_ ->
Nothing
)
data.attributes
|> E.object
)
|> Http.jsonBody
, resolver = rawApiCallResolver (always decoder)
, timeout =
data.attributes
|> List.filterMap
(\attr ->
case attr of
Timeout t ->
Just t
_ ->
Nothing
)
|> List.reverse
|> List.head
}
getUrl : ApiCall a -> String
getUrl (ApiCall { baseUrl, attributes }) =
UrlBuilder.crossOrigin
baseUrl
(getPath attributes |> List.singleton)
(getQueryParams attributes)
getPath : List ContextAttr -> String
getPath =
List.foldl
(\attr prior ->
case attr of
UrlPath posterior ->
posterior
ReplaceInUrl from to ->
String.replace from to prior
_ ->
prior
)
""
getQueryParams : List ContextAttr -> List UrlBuilder.QueryParameter
getQueryParams =
List.filterMap
(\attr ->
case attr of
QueryParam q ->
Just q
_ ->
Nothing
)
{- ATTRIBUTES
The following functions can alter how an ApiCall behaves,
and what information it will give to the Matrix API.
-}
withAttributes : List (Attribute a) -> ApiCall a -> ApiCall a
withAttributes attrs (ApiCall data) =
ApiCall
{ attributes =
attrs
|> List.map (\attr -> attr data.context)
|> List.append data.attributes
, baseUrl = data.baseUrl
, context = data.context
, method = data.method
}
accessToken : Attribute { a | accessToken : () }
accessToken =
Context.getAccessToken
>> Http.header "Authorization"
>> Header
bodyBool : String -> Bool -> Attribute a
bodyBool key value =
bodyValue key (E.bool value)
bodyInt : String -> Int -> Attribute a
bodyInt key value =
bodyValue key (E.int value)
bodyOpBool : String -> Maybe Bool -> Attribute a
bodyOpBool key value =
case value of
Just b ->
bodyBool key b
Nothing ->
always NoAttr
bodyOpInt : String -> Maybe Int -> Attribute a
bodyOpInt key value =
case value of
Just i ->
bodyInt key i
Nothing ->
always NoAttr
bodyOpString : String -> Maybe String -> Attribute a
bodyOpString key value =
case value of
Just s ->
bodyString key s
Nothing ->
always NoAttr
bodyOpValue : String -> Maybe E.Value -> Attribute a
bodyOpValue key value =
case value of
Just v ->
bodyValue key v
Nothing ->
always NoAttr
bodyString : String -> String -> Attribute a
bodyString key value =
bodyValue key (E.string value)
bodyValue : String -> E.Value -> Attribute a
bodyValue key value _ =
BodyParam key value
fullBody : E.Value -> Attribute a
fullBody value _ =
FullBody value
queryBool : String -> Bool -> Attribute a
queryBool key value _ =
(if value then
"true"
else
"false"
)
|> UrlBuilder.string key
|> QueryParam
queryOpBool : String -> Maybe Bool -> Attribute a
queryOpBool key value =
case value of
Just b ->
queryBool key b
Nothing ->
always NoAttr
queryInt : String -> Int -> Attribute a
queryInt key value _ =
QueryParam <| UrlBuilder.int key value
queryOpInt : String -> Maybe Int -> Attribute a
queryOpInt key value =
case value of
Just i ->
queryInt key i
Nothing ->
always NoAttr
queryOpString : String -> Maybe String -> Attribute a
queryOpString key value =
case value of
Just s ->
queryString key s
Nothing ->
always NoAttr
queryString : String -> String -> Attribute a
queryString key value _ =
QueryParam <| UrlBuilder.string key value
replaceInUrl : String -> String -> Attribute a
replaceInUrl key value _ =
ReplaceInUrl ("{" ++ key ++ "}") (Url.percentEncode value)
timeout : Maybe Float -> Attribute a
timeout mf _ =
case mf of
Just f ->
Timeout f
Nothing ->
NoAttr
withTransactionId : Attribute { a | transactionId : () }
withTransactionId =
Context.getTransactionId >> ReplaceInUrl "txnId"
rawApiCallResolver : (Int -> D.Decoder a) -> Http.Resolver X.Error a

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

@ -2,18 +2,16 @@ module Internal.Api.SendMessageEvent.Api exposing (SendMessageEventInputV1, Send
import Internal.Api.Request as R
import Internal.Api.SendMessageEvent.V1.SpecObjects as SO1
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Task exposing (Task)
type alias SendMessageEventInputV1 =
{ accessToken : String
, baseUrl : String
, content : D.Value
{ content : D.Value
, eventType : String
, roomId : String
, transactionId : String
}
@ -21,39 +19,27 @@ type alias SendMessageEventOutputV1 =
SO1.EventResponse
sendMessageEventV1 : SendMessageEventInputV1 -> Task X.Error SendMessageEventOutputV1
sendMessageEventV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "PUT"
, baseUrl = data.baseUrl
, path = "/_matrix/client/r0/rooms/{roomId}/send/{eventType}/{txnId}"
, pathParams =
[ ( "eventType", data.eventType )
, ( "roomId", data.roomId )
, ( "txnId", data.transactionId )
sendMessageEventV1 : SendMessageEventInputV1 -> Context { a | accessToken : (), baseUrl : (), transactionId : () } -> Task X.Error SendMessageEventOutputV1
sendMessageEventV1 { content, eventType, roomId } =
R.callApi "PUT" "/_matrix/client/r0/rooms/{roomId}/send/{eventType}/{txnId}"
>> R.withAttributes
[ R.accessToken
, R.withTransactionId
, R.replaceInUrl "eventType" eventType
, R.replaceInUrl "roomId" roomId
, R.fullBody content
]
, queryParams = []
, bodyParams = [ R.RequiredValue "*" data.content ]
, timeout = Nothing
, decoder = \_ -> SO1.eventResponseDecoder
}
>> R.toTask SO1.eventResponseDecoder
sendMessageEventV2 : SendMessageEventInputV1 -> Task X.Error SendMessageEventOutputV1
sendMessageEventV2 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "PUT"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}"
, pathParams =
[ ( "eventType", data.eventType )
, ( "roomId", data.roomId )
, ( "txnId", data.transactionId )
sendMessageEventV2 : SendMessageEventInputV1 -> Context { a | accessToken : (), baseUrl : (), transactionId : () } -> Task X.Error SendMessageEventOutputV1
sendMessageEventV2 { content, eventType, roomId } =
R.callApi "PUT" "/_matrix/client/v3/rooms/{roomId}/send/{eventType}/{txnId}"
>> R.withAttributes
[ R.accessToken
, R.withTransactionId
, R.replaceInUrl "eventType" eventType
, R.replaceInUrl "roomId" roomId
, R.fullBody content
]
, queryParams = []
, bodyParams = [ R.RequiredValue "*" data.content ]
, timeout = Nothing
, decoder = \_ -> SO1.eventResponseDecoder
}
>> R.toTask SO1.eventResponseDecoder

11
src/Internal/Api/SendMessageEvent/Main.elm
View File

@ -1,13 +1,14 @@
module Internal.Api.SendMessageEvent.Main exposing (..)
import Internal.Api.SendMessageEvent.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBAT)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
sendMessageEvent : List String -> SendMessageEventInput -> Task X.Error SendMessageEventOutput
sendMessageEvent versions =
sendMessageEvent : Context (VBAT a) -> SendMessageEventInput -> Task X.Error SendMessageEventOutput
sendMessageEvent context input =
VC.withBottomLayer
{ current = Api.sendMessageEventV1
, version = "r0.0.0"
@ -30,8 +31,10 @@ sendMessageEvent versions =
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias SendMessageEventInput =

57
src/Internal/Api/SendStateKey/Api.elm
View File

@ -2,15 +2,14 @@ module Internal.Api.SendStateKey.Api exposing (..)
import Internal.Api.Request as R
import Internal.Api.SendStateKey.V1.SpecObjects as SO1
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Json.Decode as D
import Task exposing (Task)
type alias SendStateKeyInputV1 =
{ accessToken : String
, baseUrl : String
, content : D.Value
{ content : D.Value
, eventType : String
, roomId : String
, stateKey : String
@ -21,39 +20,27 @@ type alias SendStateKeyOutputV1 =
SO1.EventResponse
sendStateKeyV1 : SendStateKeyInputV1 -> Task X.Error SendStateKeyOutputV1
sendStateKeyV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "PUT"
, baseUrl = data.baseUrl
, path = "/_matrix/client/r0/rooms/{roomId}/state/{eventType}/{stateKey}"
, pathParams =
[ ( "eventType", data.eventType )
, ( "roomId", data.roomId )
, ( "stateKey", data.stateKey )
sendStateKeyV1 : SendStateKeyInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error SendStateKeyOutputV1
sendStateKeyV1 { content, eventType, roomId, stateKey } =
R.callApi "PUT" "/_matrix/client/r0/rooms/{roomId}/state/{eventType}/{stateKey}"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "eventType" eventType
, R.replaceInUrl "roomId" roomId
, R.replaceInUrl "stateKey" stateKey
, R.fullBody content
]
, queryParams = []
, bodyParams = [ R.RequiredValue "*" data.content ]
, timeout = Nothing
, decoder = \_ -> SO1.eventResponseDecoder
}
>> R.toTask SO1.eventResponseDecoder
sendStateKeyV2 : SendStateKeyInputV1 -> Task X.Error SendStateKeyOutputV1
sendStateKeyV2 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "PUT"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/rooms/{roomId}/state/{eventType}/{stateKey}"
, pathParams =
[ ( "eventType", data.eventType )
, ( "roomId", data.roomId )
, ( "stateKey", data.stateKey )
sendStateKeyV2 : SendStateKeyInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error SendStateKeyOutputV1
sendStateKeyV2 { content, eventType, roomId, stateKey } =
R.callApi "PUT" "/_matrix/client/v3/rooms/{roomId}/state/{eventType}/{stateKey}"
>> R.withAttributes
[ R.accessToken
, R.replaceInUrl "eventType" eventType
, R.replaceInUrl "roomId" roomId
, R.replaceInUrl "stateKey" stateKey
, R.fullBody content
]
, queryParams = []
, bodyParams = [ R.RequiredValue "*" data.content ]
, timeout = Nothing
, decoder = \_ -> SO1.eventResponseDecoder
}
>> R.toTask SO1.eventResponseDecoder

11
src/Internal/Api/SendStateKey/Main.elm
View File

@ -1,13 +1,14 @@
module Internal.Api.SendStateKey.Main exposing (..)
import Internal.Api.SendStateKey.Api as Api
import Internal.Tools.Context as Context exposing (Context, VBA)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
sendStateKey : List String -> SendStateKeyInput -> Task X.Error SendStateKeyOutput
sendStateKey versions =
sendStateKey : Context (VBA a) -> SendStateKeyInput -> Task X.Error SendStateKeyOutput
sendStateKey context input =
VC.withBottomLayer
{ current = Api.sendStateKeyV1
, version = "r0.0.0"
@ -30,8 +31,10 @@ sendStateKey versions =
|> VC.sameForVersion "v1.3"
|> VC.sameForVersion "v1.4"
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias SendStateKeyInput =

67
src/Internal/Api/Sync/Api.elm
View File

@ -3,15 +3,14 @@ module Internal.Api.Sync.Api exposing (..)
import Internal.Api.Request as R
import Internal.Api.Sync.V1.SpecObjects as SO1
import Internal.Api.Sync.V2.SpecObjects as SO2
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Internal.Tools.SpecEnums as Enums
import Task exposing (Task)
type alias SyncInputV1 =
{ accessToken : String
, baseUrl : String
, filter : Maybe String
{ filter : Maybe String
, fullState : Maybe Bool
, setPresence : Maybe Enums.UserPresence
, since : Maybe String
@ -27,49 +26,31 @@ type alias SyncOutputV2 =
SO2.Sync
syncV1 : SyncInputV1 -> Task X.Error SyncOutputV1
syncV1 : SyncInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error SyncOutputV1
syncV1 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "GET"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/sync"
, pathParams = []
, queryParams =
[ R.OpQueryParamString "filter" data.filter
, R.OpQueryParamBool "full_state" data.fullState
, R.OpQueryParamString "set_presence" (Maybe.map Enums.fromUserPresence data.setPresence)
, R.OpQueryParamString "since" data.since
, R.OpQueryParamInt "timeout" data.timeout
R.callApi "GET" "/_matrix/client/v3/sync"
>> R.withAttributes
[ R.accessToken
, R.queryOpString "filter" data.filter
, R.queryOpBool "full_state" data.fullState
, R.queryOpString "set_presence" (Maybe.map Enums.fromUserPresence data.setPresence)
, R.queryOpString "since" data.since
, R.queryOpInt "timeout" data.timeout
, R.timeout <| Maybe.map ((*) 1000 >> toFloat) <| data.timeout
]
, bodyParams = []
, timeout =
data.timeout
|> Maybe.map ((*) 1000)
|> Maybe.map toFloat
, decoder = \_ -> SO1.syncDecoder
}
>> R.toTask SO1.syncDecoder
syncV2 : SyncInputV1 -> Task X.Error SyncOutputV2
syncV2 : SyncInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error SyncOutputV2
syncV2 data =
R.rawApiCall
{ headers = R.WithAccessToken data.accessToken
, method = "GET"
, baseUrl = data.baseUrl
, path = "/_matrix/client/v3/sync"
, pathParams = []
, queryParams =
[ R.OpQueryParamString "filter" data.filter
, R.OpQueryParamBool "full_state" data.fullState
, R.OpQueryParamString "set_presence" (Maybe.map Enums.fromUserPresence data.setPresence)
, R.OpQueryParamString "since" data.since
, R.OpQueryParamInt "timeout" data.timeout
R.callApi "GET" "/_matrix/client/v3/sync"
>> R.withAttributes
[ R.accessToken
, R.queryOpString "filter" data.filter
, R.queryOpBool "full_state" data.fullState
, R.queryOpString "set_presence" (Maybe.map Enums.fromUserPresence data.setPresence)
, R.queryOpString "since" data.since
, R.queryOpInt "timeout" data.timeout
, R.timeout <| Maybe.map ((*) 1000 >> toFloat) <| data.timeout
]
, bodyParams = []
, timeout =
data.timeout
|> Maybe.map ((*) 1000)
|> Maybe.map toFloat
, decoder = \_ -> SO2.syncDecoder
}
>> R.toTask SO2.syncDecoder

11
src/Internal/Api/Sync/Main.elm
View File

@ -2,13 +2,14 @@ module Internal.Api.Sync.Main exposing (..)
import Internal.Api.Sync.Api as Api
import Internal.Api.Sync.V2.Upcast as U2
import Internal.Tools.Context as Context exposing (Context, VBA)
import Internal.Tools.Exceptions as X
import Internal.Tools.VersionControl as VC
import Task exposing (Task)
sync : List String -> SyncInput -> Task X.Error SyncOutput
sync versions =
sync : Context (VBA a) -> SyncInput -> Task X.Error SyncOutput
sync context input =
VC.withBottomLayer
{ current = Api.syncV1
, version = "v1.2"
@ -21,8 +22,10 @@ sync versions =
, version = "v1.4"
}
|> VC.sameForVersion "v1.5"
|> VC.mostRecentFromVersionList versions
|> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
|> VC.mostRecentFromVersionList (Context.getVersions context)
|> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion)
|> (|>) input
|> (|>) context
type alias SyncInput =

18
src/Internal/Api/Versions/Api.elm
View File

@ -2,20 +2,12 @@ module Internal.Api.Versions.Api exposing (..)
import Internal.Api.Request as R
import Internal.Api.Versions.V1.Versions as SO
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
versionsV1 : { baseUrl : String } -> Task X.Error SO.Versions
versionsV1 data =
R.rawApiCall
{ headers = R.NoHeaders
, method = "GET"
, baseUrl = data.baseUrl
, path = "/_matrix/client/versions"
, pathParams = []
, queryParams = []
, bodyParams = []
, timeout = Nothing
, decoder = always SO.versionsDecoder
}
versionsV1 : Context { a | baseUrl : () } -> Task X.Error SO.Versions
versionsV1 =
R.callApi "GET" "/_matrix/client/versions"
>> R.toTask SO.versionsDecoder

9
src/Internal/Api/Versions/Main.elm
View File

@ -2,18 +2,19 @@ module Internal.Api.Versions.Main exposing (..)
import Internal.Api.Versions.Api as Api
import Internal.Api.Versions.V1.Versions as SO
import Internal.Tools.Context exposing (Context)
import Internal.Tools.Exceptions as X
import Task exposing (Task)
type alias VersionsInput =
String
()
type alias VersionsOutput =
SO.Versions
getVersions : VersionsInput -> Task X.Error VersionsOutput
getVersions baseUrl =
Api.versionsV1 { baseUrl = baseUrl }
getVersions : Context { a | baseUrl : () } -> Task X.Error VersionsOutput
getVersions context =
Api.versionsV1 context