From c7204c4c4155a5b11d0c966739cab6d8b7f2a1ad Mon Sep 17 00:00:00 2001 From: Bram Date: Sat, 13 Jul 2024 13:39:33 +0200 Subject: [PATCH 01/13] Remove Debug.log from API definition --- src/Internal/Api/Sync/Api.elm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Internal/Api/Sync/Api.elm b/src/Internal/Api/Sync/Api.elm index ed094eb..38e34ed 100644 --- a/src/Internal/Api/Sync/Api.elm +++ b/src/Internal/Api/Sync/Api.elm @@ -106,7 +106,7 @@ syncV1 data = , method = "GET" , path = [ "_matrix", "client", "v3", "sync" ] , toUpdate = - Debug.log "Handling output v1" >> V1.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received" + V1.updateSyncResponse { filter = Filter.pass, since = data.since } } @@ -128,7 +128,7 @@ syncV2 data = , method = "GET" , path = [ "_matrix", "client", "v3", "sync" ] , toUpdate = - Debug.log "Handling output v2" >> V2.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received" + V2.updateSyncResponse { filter = Filter.pass, since = data.since } } @@ -150,7 +150,7 @@ syncV3 data = , method = "GET" , path = [ "_matrix", "client", "v3", "sync" ] , toUpdate = - Debug.log "Handling output v3" >> V3.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received" + V3.updateSyncResponse { filter = Filter.pass, since = data.since } } @@ -172,5 +172,5 @@ syncV4 data = , method = "GET" , path = [ "_matrix", "client", "v3", "sync" ] , toUpdate = - Debug.log "Handling output v4" >> V4.updateSyncResponse { filter = Filter.pass, since = data.since } >> Debug.log "Received" + V4.updateSyncResponse { filter = Filter.pass, since = data.since } } From 0521ca2f3ea714cbc63a452623f3278ee0a71fbf Mon Sep 17 00:00:00 2001 From: Bram Date: Tue, 16 Jul 2024 12:41:09 +0200 Subject: [PATCH 02/13] Add sendMessageEvent to Room API --- src/Matrix/Room.elm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index a3e24ae..5909c70 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -1,6 +1,7 @@ module Matrix.Room exposing ( Room, mostRecentEvents, roomId , getAccountData + , sendMessageEvent ) {-| @@ -35,8 +36,19 @@ other users. @docs getAccountData + +## Sending events + +Besides reading the latest events, one can also send new events to the Matrix +room. These events are JSON objects that can be shaped in any way or form that +you like. To help other users with decoding your JSON objects, you pass an +`eventType` string which helps them figure out the nature of your JSON object. + +@docs sendMessageEvent + -} +import Internal.Api.Main as Api import Internal.Values.Envelope as Envelope import Internal.Values.Room as Internal import Json.Encode as E @@ -70,3 +82,25 @@ mostRecentEvents : Room -> List Types.Event mostRecentEvents (Room room) = Envelope.mapList Internal.mostRecentEvents room |> List.map Types.Event + + +{-| Send a message event to a given room. +-} +sendMessageEvent : + { content : E.Value + , eventType : String + , room : Room + , toMsg : Types.VaultUpdate -> msg + , transactionId : String + } + -> Cmd msg +sendMessageEvent data = + case data.room of + Room room -> + Api.sendMessageEvent room + { content = data.content + , eventType = data.eventType + , roomId = roomId data.room + , toMsg = Types.VaultUpdate >> data.toMsg + , transactionId = data.transactionId + } From 87ebcbcd21fd6f303783cc7273524b5dcfb50ce6 Mon Sep 17 00:00:00 2001 From: Bram Date: Wed, 17 Jul 2024 14:13:13 +0200 Subject: [PATCH 03/13] Add sendStateEvent to Room API --- src/Internal/Api/Main.elm | 29 +++- src/Internal/Api/SendStateEvent/Api.elm | 177 ++++++++++++++++++++++++ src/Internal/Api/Task.elm | 14 +- src/Matrix/Room.elm | 26 +++- 4 files changed, 240 insertions(+), 6 deletions(-) create mode 100644 src/Internal/Api/SendStateEvent/Api.elm diff --git a/src/Internal/Api/Main.elm b/src/Internal/Api/Main.elm index bf9b1ea..c0d3f2b 100644 --- a/src/Internal/Api/Main.elm +++ b/src/Internal/Api/Main.elm @@ -1,6 +1,6 @@ module Internal.Api.Main exposing ( Msg - , sendMessageEvent, sync + , sendMessageEvent, sendStateEvent, sync ) {-| @@ -18,7 +18,7 @@ This module is used as reference for getting ## Actions -@docs sendMessageEvent, sync +@docs sendMessageEvent, sendStateEvent, sync -} @@ -59,6 +59,31 @@ sendMessageEvent env data = (Context.apiFormat env.context) +{-| Send a state event to a room. +-} +sendStateEvent : + E.Envelope a + -> + { content : Json.Value + , eventType : String + , roomId : String + , stateKey : String + , toMsg : Msg -> msg + } + -> Cmd msg +sendStateEvent env data = + ITask.run + data.toMsg + (ITask.sendStateEvent + { content = data.content + , eventType = data.eventType + , roomId = data.roomId + , stateKey = data.stateKey + } + ) + (Context.apiFormat env.context) + + {-| Sync with the Matrix API to stay up-to-date. -} sync : diff --git a/src/Internal/Api/SendStateEvent/Api.elm b/src/Internal/Api/SendStateEvent/Api.elm new file mode 100644 index 0000000..f69e377 --- /dev/null +++ b/src/Internal/Api/SendStateEvent/Api.elm @@ -0,0 +1,177 @@ +module Internal.Api.SendStateEvent.Api exposing (..) + +{-| + + +# Send state event + +This module sends state events to Matrix rooms. + +@docs Phantom, sendStateEvent + +-} + +import Internal.Api.Api as A +import Internal.Api.Invite.Api exposing (Phantom) +import Internal.Api.Request as R +import Internal.Config.Log exposing (log) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json +import Internal.Values.Envelope as E + + +{-| Send a state event to a Matrix room. +-} +sendStateEvent : SendStateEventInput -> A.TaskChain (Phantom a) (Phantom a) +sendStateEvent = + A.startWithVersion "r0.0.0" sendStateEventV1 + |> A.sameForVersion "r0.0.1" + |> A.sameForVersion "r0.1.0" + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.3.0" + |> A.sameForVersion "r0.4.0" + |> A.sameForVersion "r0.5.0" + |> A.sameForVersion "r0.6.0" + |> A.forVersion "r0.6.1" sendStateEventV2 + |> A.forVersion "v1.1" sendStateEventV3 + |> A.sameForVersion "v1.2" + |> A.sameForVersion "v1.3" + |> A.sameForVersion "v1.4" + |> A.sameForVersion "v1.5" + |> A.sameForVersion "v1.6" + |> A.sameForVersion "v1.7" + |> A.sameForVersion "v1.8" + |> A.sameForVersion "v1.9" + |> A.sameForVersion "v1.10" + |> A.sameForVersion "v1.11" + |> A.versionChain + + +{-| Context needed for sending a state event +-} +type alias Phantom a = + { a | accessToken : (), baseUrl : (), versions : () } + + +type alias PhantomV1 a = + { a | accessToken : (), baseUrl : () } + + +type alias SendStateEventInput = + { content : Json.Value + , eventType : String + , roomId : String + , stateKey : String + } + + +type alias SendStateEventInputV1 a = + { a + | content : Json.Value + , eventType : String + , roomId : String + , stateKey : String + } + + +type alias SendStateEventOutputV1 = + { eventId : Maybe String } + + +type alias SendStateEventOutputV2 = + { eventId : String } + + +sendStateEventV1 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +sendStateEventV1 { content, eventType, roomId, stateKey } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV1 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ] + , toUpdate = + \out -> + ( E.More [] + , out.eventId + |> Text.logs.sendEvent + |> log.debug + |> List.singleton + ) + } + + +sendStateEventV2 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +sendStateEventV2 { content, eventType, roomId, stateKey } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV2 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "r0", "rooms", roomId, "state", eventType, stateKey ] + , toUpdate = + \out -> + ( E.More [] + , out.eventId + |> Maybe.Just + |> Text.logs.sendEvent + |> log.debug + |> List.singleton + ) + } + + +sendStateEventV3 : SendStateEventInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +sendStateEventV3 { content, eventType, roomId, stateKey } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV2 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "v3", "rooms", roomId, "state", eventType, stateKey ] + , toUpdate = + \out -> + ( E.More [] + , out.eventId + |> Maybe.Just + |> Text.logs.sendEvent + |> log.debug + |> List.singleton + ) + } + + +coderV1 : Json.Coder SendStateEventOutputV1 +coderV1 = + Json.object1 + { name = "EventResponse" + , description = + [ "This object is returned after a state event has been sent." + ] + , init = SendStateEventOutputV1 + } + (Json.field.optional.value + { fieldName = "event_id" + , toField = .eventId + , description = [ "A unique identifier for the event." ] + , coder = Json.string + } + ) + + +coderV2 : Json.Coder SendStateEventOutputV2 +coderV2 = + Json.object1 + { name = "EventResponse" + , description = + [ "This object is returned after a state event has been sent." + ] + , init = SendStateEventOutputV2 + } + (Json.field.required + { fieldName = "event_id" + , toField = .eventId + , description = [ "A unique identifier for the event." ] + , coder = Json.string + } + ) diff --git a/src/Internal/Api/Task.elm b/src/Internal/Api/Task.elm index 43d3845..8d4c741 100644 --- a/src/Internal/Api/Task.elm +++ b/src/Internal/Api/Task.elm @@ -1,6 +1,6 @@ module Internal.Api.Task exposing ( Task, run, Backpack - , sendMessageEvent, sync + , sendMessageEvent, sendStateEvent, sync ) {-| @@ -23,7 +23,7 @@ up-to-date. ## Tasks -@docs sendMessageEvent, sync +@docs sendMessageEvent, sendStateEvent, sync -} @@ -33,6 +33,7 @@ import Internal.Api.LoginWithUsernameAndPassword.Api import Internal.Api.Now.Api import Internal.Api.Request as Request import Internal.Api.SendMessageEvent.Api +import Internal.Api.SendStateEvent.Api import Internal.Api.Sync.Api import Internal.Api.Versions.Api import Internal.Config.Log exposing (Log, log) @@ -232,6 +233,15 @@ sendMessageEvent input = |> finishTask +{-| Send a state event to a room. +-} +sendStateEvent : { content : Json.Value, eventType : String, roomId : String, stateKey : String } -> Task +sendStateEvent input = + makeVBA + |> C.andThen (Internal.Api.SendStateEvent.Api.sendStateEvent input) + |> finishTask + + {-| Sync with the Matrix API to stay up-to-date. -} sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index 5909c70..8feff52 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -1,7 +1,7 @@ module Matrix.Room exposing ( Room, mostRecentEvents, roomId , getAccountData - , sendMessageEvent + , sendMessageEvent, sendStateEvent ) {-| @@ -44,7 +44,7 @@ room. These events are JSON objects that can be shaped in any way or form that you like. To help other users with decoding your JSON objects, you pass an `eventType` string which helps them figure out the nature of your JSON object. -@docs sendMessageEvent +@docs sendMessageEvent, sendStateEvent -} @@ -104,3 +104,25 @@ sendMessageEvent data = , toMsg = Types.VaultUpdate >> data.toMsg , transactionId = data.transactionId } + + +{-| Send a state event to a given room. +-} +sendStateEvent : + { content : E.Value + , eventType : String + , room : Room + , stateKey : String + , toMsg : Types.VaultUpdate -> msg + } + -> Cmd msg +sendStateEvent data = + case data.room of + Room room -> + Api.sendStateEvent room + { content = data.content + , eventType = data.eventType + , roomId = roomId data.room + , stateKey = data.stateKey + , toMsg = Types.VaultUpdate >> data.toMsg + } From 5319f4714576be2f93f695e18b3b219eccd8c0f7 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 19 Jul 2024 08:51:19 +0200 Subject: [PATCH 04/13] Move user from Vault to Envelop Context --- .../Api/LoginWithUsernameAndPassword/Api.elm | 14 ++-- src/Internal/Config/Text.elm | 4 + src/Internal/Tools/DecodeExtra.elm | 37 ++++++++- src/Internal/Tools/Json.elm | 83 ++++++++++++++++++- src/Internal/Values/Context.elm | 16 +++- src/Internal/Values/Envelope.elm | 12 ++- src/Internal/Values/Vault.elm | 22 +---- src/Matrix.elm | 10 ++- 8 files changed, 159 insertions(+), 39 deletions(-) diff --git a/src/Internal/Api/LoginWithUsernameAndPassword/Api.elm b/src/Internal/Api/LoginWithUsernameAndPassword/Api.elm index b5cddcd..55bb897 100644 --- a/src/Internal/Api/LoginWithUsernameAndPassword/Api.elm +++ b/src/Internal/Api/LoginWithUsernameAndPassword/Api.elm @@ -191,7 +191,7 @@ loginWithUsernameAndPasswordV1 { username, password } = } , E.RemovePasswordIfNecessary , out.user - |> Maybe.map (V.SetUser >> E.ContentUpdate) + |> Maybe.map E.SetUser |> E.Optional ] , Text.logs.loggedInAs username @@ -233,7 +233,7 @@ loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, p } , E.RemovePasswordIfNecessary , out.user - |> Maybe.map (V.SetUser >> E.ContentUpdate) + |> Maybe.map E.SetUser |> E.Optional , out.deviceId |> Maybe.map E.SetDeviceId @@ -285,7 +285,7 @@ loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, p } , E.RemovePasswordIfNecessary , out.user - |> Maybe.map (V.SetUser >> E.ContentUpdate) + |> Maybe.map E.SetUser |> E.Optional , out.deviceId |> Maybe.map E.SetDeviceId @@ -337,7 +337,7 @@ loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, p } , E.RemovePasswordIfNecessary , out.user - |> Maybe.map (V.SetUser >> E.ContentUpdate) + |> Maybe.map E.SetUser |> E.Optional , out.wellKnown |> Maybe.map (.homeserver >> .baseUrl) @@ -393,7 +393,7 @@ loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, p } , E.RemovePasswordIfNecessary , out.user - |> Maybe.map (V.SetUser >> E.ContentUpdate) + |> Maybe.map E.SetUser |> E.Optional , out.wellKnown |> Maybe.map (.homeserver >> .baseUrl) @@ -450,7 +450,7 @@ loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisp } , E.RemovePasswordIfNecessary , out.user - |> Maybe.map (V.SetUser >> E.ContentUpdate) + |> Maybe.map E.SetUser |> E.Optional , out.wellKnown |> Maybe.map (.homeserver >> .baseUrl) @@ -506,7 +506,7 @@ loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisp , value = out.accessToken } , E.RemovePasswordIfNecessary - , E.ContentUpdate (V.SetUser out.user) + , E.SetUser out.user , out.wellKnown |> Maybe.map (.homeserver >> .baseUrl) |> Maybe.map E.SetBaseUrl diff --git a/src/Internal/Config/Text.elm b/src/Internal/Config/Text.elm index fbeba89..c43084e 100644 --- a/src/Internal/Config/Text.elm +++ b/src/Internal/Config/Text.elm @@ -278,6 +278,7 @@ fields : , serverName : Desc , suggestedAccessToken : Desc , transaction : Desc + , user : Desc , versions : Desc } , envelope : @@ -409,6 +410,9 @@ fields = , transaction = [ "A unique identifier for a transaction initiated by the user." ] + , user = + [ "The Matrix user the Vault is representing." + ] , versions = [ "The versions of the Matrix protocol that are supported by the server." ] diff --git a/src/Internal/Tools/DecodeExtra.elm b/src/Internal/Tools/DecodeExtra.elm index b7a0ae8..12feceb 100644 --- a/src/Internal/Tools/DecodeExtra.elm +++ b/src/Internal/Tools/DecodeExtra.elm @@ -1,6 +1,6 @@ module Internal.Tools.DecodeExtra exposing ( opField, opFieldWithDefault - , map9, map10, map11, map12 + , map9, map10, map11, map12, map13 ) {-| @@ -18,7 +18,7 @@ This module contains helper functions that help decode JSON. ## Extended map functions -@docs map9, map10, map11, map12 +@docs map9, map10, map11, map12, map13 -} @@ -185,3 +185,36 @@ map12 func da db dc dd de df dg dh di dj dk dl = (D.map2 Tuple.pair dg dh) (D.map2 Tuple.pair di dj) (D.map2 Tuple.pair dk dl) + + +{-| Try 12 decoders and combine the result. +-} +map13 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> value) + -> D.Decoder a + -> D.Decoder b + -> D.Decoder c + -> D.Decoder d + -> D.Decoder e + -> D.Decoder f + -> D.Decoder g + -> D.Decoder h + -> D.Decoder i + -> D.Decoder j + -> D.Decoder k + -> D.Decoder l + -> D.Decoder m + -> D.Decoder value +map13 func da db dc dd de df dg dh di dj dk dl dm = + D.map8 + (\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) -> + func a b c d e f g h i j k l m + ) + da + db + dc + (D.map2 Tuple.pair dd de) + (D.map2 Tuple.pair df dg) + (D.map2 Tuple.pair dh di) + (D.map2 Tuple.pair dj dk) + (D.map2 Tuple.pair dl dm) diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 799298a..2d24b7f 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -5,7 +5,7 @@ module Internal.Tools.Json exposing , Docs(..), RequiredField(..), toDocs , list, listWithOne, slowDict, fastDict, fastIntDict, set, iddict, maybe , Field, field, parser - , object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12 + , object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13 ) {-| @@ -62,7 +62,7 @@ first. Once all fields are constructed, the user can create JSON objects. -@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12 +@docs object1, object2, object3, object4, object5, object6, object7, object8, object9, object10, object11, object12, object13 -} @@ -1272,6 +1272,85 @@ object12 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl = } +{-| Define an object with 13 keys +-} +object13 : + Descriptive { init : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> object } + -> Field a object + -> Field b object + -> Field c object + -> Field d object + -> Field e object + -> Field f object + -> Field g object + -> Field h object + -> Field i object + -> Field j object + -> Field k object + -> Field l object + -> Field m object + -> Coder object +object13 { name, description, init } fa fb fc fd fe ff fg fh fi fj fk fl fm = + Coder + { encoder = + objectEncoder + [ toEncodeField fa + , toEncodeField fb + , toEncodeField fc + , toEncodeField fd + , toEncodeField fe + , toEncodeField ff + , toEncodeField fg + , toEncodeField fh + , toEncodeField fi + , toEncodeField fj + , toEncodeField fk + , toEncodeField fl + , toEncodeField fm + ] + , decoder = + D.map13 + (\( a, la ) ( b, lb ) ( c, lc ) ( d, ld ) ( e, le ) ( f, lf ) ( g, lg ) ( h, lh ) ( i, li ) ( j, lj ) ( k, lk ) ( l, ll ) ( m, lm ) -> + ( init a b c d e f g h i j k l m + , List.concat [ la, lb, lc, ld, le, lf, lg, lh, li, lj, lk, ll, lm ] + ) + ) + (toDecoderField fa) + (toDecoderField fb) + (toDecoderField fc) + (toDecoderField fd) + (toDecoderField fe) + (toDecoderField ff) + (toDecoderField fg) + (toDecoderField fh) + (toDecoderField fi) + (toDecoderField fj) + (toDecoderField fk) + (toDecoderField fl) + (toDecoderField fm) + , docs = + DocsObject + { name = name + , description = description + , keys = + [ toDocsField fa + , toDocsField fb + , toDocsField fc + , toDocsField fd + , toDocsField fe + , toDocsField ff + , toDocsField fg + , toDocsField fh + , toDocsField fi + , toDocsField fj + , toDocsField fk + , toDocsField fl + , toDocsField fm + ] + } + } + + {-| Define a parser that converts a string into a custom Elm type. -} parser : { name : String, p : P.Parser ( a, List Log ), toString : a -> String } -> Coder a diff --git a/src/Internal/Values/Context.elm b/src/Internal/Values/Context.elm index d53783d..a81b0d1 100644 --- a/src/Internal/Values/Context.elm +++ b/src/Internal/Values/Context.elm @@ -71,6 +71,7 @@ import Internal.Config.Text as Text import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Json as Json import Internal.Tools.Timestamp as Timestamp exposing (Timestamp) +import Internal.Values.User as User exposing (User) import Set exposing (Set) import Time @@ -101,6 +102,7 @@ type alias Context = , serverName : String , suggestedAccessToken : Maybe String , transaction : Maybe String + , user : Maybe User , username : Maybe String , versions : Maybe Versions } @@ -152,7 +154,7 @@ fromApiFormat (APIContext c) = -} coder : Json.Coder Context coder = - Json.object12 + Json.object13 { name = Text.docs.context.name , description = Text.docs.context.description , init = Context @@ -227,6 +229,13 @@ coder = , coder = Json.string } ) + (Json.field.optional.value + { fieldName = "user" + , toField = .user + , description = Text.fields.context.user + , coder = User.coder + } + ) (Json.field.optional.value { fieldName = "username" , toField = .username @@ -305,8 +314,8 @@ encode = {-| A basic, untouched version of the Context, containing no information. -} -init : String -> Context -init sn = +init : String -> Maybe User -> Context +init sn mu = { accessTokens = Hashdict.empty .value , baseUrl = Nothing , deviceId = Nothing @@ -317,6 +326,7 @@ init sn = , serverName = sn , suggestedAccessToken = Nothing , transaction = Nothing + , user = mu , username = Nothing , versions = Nothing } diff --git a/src/Internal/Values/Envelope.elm b/src/Internal/Values/Envelope.elm index 82c8d81..7cd9757 100644 --- a/src/Internal/Values/Envelope.elm +++ b/src/Internal/Values/Envelope.elm @@ -56,6 +56,7 @@ import Internal.Tools.Json as Json import Internal.Tools.Timestamp exposing (Timestamp) import Internal.Values.Context as Context exposing (AccessToken, Context, Versions) import Internal.Values.Settings as Settings +import Internal.Values.User exposing (User) import Recursion import Recursion.Fold @@ -87,6 +88,7 @@ type EnvelopeUpdate a | SetNextBatch String | SetNow Timestamp | SetRefreshToken String + | SetUser User | SetVersions Versions @@ -188,10 +190,10 @@ getContent = {-| Create a new enveloped data type. All settings are set to default values from the [Internal.Config.Default](Internal-Config-Default) module. -} -init : { serverName : String, content : a } -> Envelope a +init : { content : a, serverName : String, user : Maybe User } -> Envelope a init data = { content = data.content - , context = Context.init data.serverName + , context = Context.init data.serverName data.user , settings = Settings.init } @@ -374,6 +376,12 @@ update updateContent eu startData = { data | context = { context | refreshToken = Just r } } ) + SetUser u -> + Recursion.base + (\({ context } as data) -> + { data | context = { context | user = Just u } } + ) + SetVersions vs -> Recursion.base (\({ context } as data) -> diff --git a/src/Internal/Values/Vault.elm b/src/Internal/Values/Vault.elm index 3e048d3..d3eb906 100644 --- a/src/Internal/Values/Vault.elm +++ b/src/Internal/Values/Vault.elm @@ -54,7 +54,6 @@ type alias Vault = { accountData : Dict String Json.Value , nextBatch : Maybe String , rooms : Hashdict Room - , user : Maybe User } @@ -68,14 +67,13 @@ type VaultUpdate | Optional (Maybe VaultUpdate) | SetAccountData String Json.Value | SetNextBatch String - | SetUser User {-| Convert a Vault to and from a JSON object. -} coder : Json.Coder Vault coder = - Json.object4 + Json.object3 { name = Text.docs.vault.name , description = Text.docs.vault.description , init = Vault @@ -101,13 +99,6 @@ coder = , coder = Hashdict.coder .roomId Room.coder } ) - (Json.field.optional.value - { fieldName = "user" - , toField = .user - , description = Text.fields.vault.user - , coder = User.coder - } - ) {-| Get a given room by its room id. @@ -126,12 +117,11 @@ getAccountData key vault = {-| Initiate a new Vault type. -} -init : Maybe User -> Vault -init mUser = +init : Vault +init = { accountData = Dict.empty , nextBatch = Nothing , rooms = Hashdict.empty .roomId - , user = mUser } @@ -196,12 +186,6 @@ update vaultUpdate startVault = (\vault -> { vault | nextBatch = Just nb } ) - - SetUser user -> - Recursion.base - (\vault -> - { vault | user = Just user } - ) ) vaultUpdate startVault diff --git a/src/Matrix.elm b/src/Matrix.elm index 6c66953..e9dcd89 100644 --- a/src/Matrix.elm +++ b/src/Matrix.elm @@ -97,8 +97,9 @@ fromUserId uid = |> Maybe.map (\u -> Envelope.init - { serverName = "https://" ++ User.domain u - , content = Internal.init (Just u) + { content = Internal.init + , serverName = "https://" ++ User.domain u + , user = Just u } |> Envelope.mapContext (\c -> { c | username = Just uid }) ) @@ -113,13 +114,14 @@ you can either insert `alice` or `@alice:example.org`. -} fromUsername : { username : String, host : String, port_ : Maybe Int } -> Vault fromUsername { username, host, port_ } = - { serverName = + { content = Internal.init + , serverName = port_ |> Maybe.map String.fromInt |> Maybe.map ((++) ":") |> Maybe.withDefault "" |> (++) host - , content = Internal.init (User.fromString username) + , user = User.fromString username } |> Envelope.init |> Envelope.mapContext (\c -> { c | username = Just username }) From 8b2db7bff6592dedd11e67dd7d9ce51e8835bdfc Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 19 Jul 2024 09:01:42 +0200 Subject: [PATCH 05/13] Add setAccountData to Matrix rooms --- src/Internal/Api/Main.elm | 39 ++++++- src/Internal/Api/SetRoomAccountData/Api.elm | 112 ++++++++++++++++++++ src/Internal/Api/Task.elm | 14 ++- src/Internal/Tools/Json.elm | 17 ++- src/Matrix/Room.elm | 24 ++++- 5 files changed, 198 insertions(+), 8 deletions(-) create mode 100644 src/Internal/Api/SetRoomAccountData/Api.elm diff --git a/src/Internal/Api/Main.elm b/src/Internal/Api/Main.elm index c0d3f2b..5999d5b 100644 --- a/src/Internal/Api/Main.elm +++ b/src/Internal/Api/Main.elm @@ -1,6 +1,6 @@ module Internal.Api.Main exposing ( Msg - , sendMessageEvent, sendStateEvent, sync + , sendMessageEvent, sendStateEvent, setRoomAccountData, sync ) {-| @@ -18,7 +18,7 @@ This module is used as reference for getting ## Actions -@docs sendMessageEvent, sendStateEvent, sync +@docs sendMessageEvent, sendStateEvent, setRoomAccountData, sync -} @@ -26,6 +26,8 @@ import Internal.Api.Task as ITask exposing (Backpack) import Internal.Tools.Json as Json import Internal.Values.Context as Context import Internal.Values.Envelope as E +import Internal.Values.User as User +import Internal.Values.Vault as V {-| Update message type that is being returned. @@ -84,6 +86,39 @@ sendStateEvent env data = (Context.apiFormat env.context) +{-| Set the account data for a Matrix room. +-} +setRoomAccountData : + E.Envelope a + -> + { content : Json.Value + , eventType : String + , roomId : String + , toMsg : Msg -> msg + } + -> Cmd msg +setRoomAccountData env data = + case env.context.user of + Just u -> + ITask.run + data.toMsg + (ITask.setRoomAccountData + { content = data.content + , eventType = data.eventType + , roomId = data.roomId + , userId = User.toString u + } + ) + (Context.apiFormat env.context) + + Nothing -> + Cmd.none + + + +-- TODO: Return error about lacking user capabilities + + {-| Sync with the Matrix API to stay up-to-date. -} sync : diff --git a/src/Internal/Api/SetRoomAccountData/Api.elm b/src/Internal/Api/SetRoomAccountData/Api.elm new file mode 100644 index 0000000..a23005e --- /dev/null +++ b/src/Internal/Api/SetRoomAccountData/Api.elm @@ -0,0 +1,112 @@ +module Internal.Api.SetRoomAccountData.Api exposing (..) + +{-| + + +# Set Room Account Data + +This module allows the developer to set account data to a Matrix room. + +@docs Phantom, setRoomAccountData + +-} + +import Internal.Api.Api as A +import Internal.Api.Invite.Api exposing (Phantom) +import Internal.Api.Request as R +import Internal.Config.Log exposing (log) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json +import Internal.Values.Envelope as E +import Internal.Values.Room as R +import Internal.Values.Vault as V + + +{-| Set account data to a Matrix room. +-} +setRoomAccountData : SetRoomAccountDataInput -> A.TaskChain (Phantom a) (Phantom a) +setRoomAccountData = + A.startWithVersion "r0.0.0" setRoomAccountDataV1 + |> A.sameForVersion "r0.0.1" + |> A.sameForVersion "r0.1.0" + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.3.0" + |> A.sameForVersion "r0.4.0" + |> A.sameForVersion "r0.5.0" + |> A.sameForVersion "r0.6.0" + |> A.sameForVersion "r0.6.1" + |> A.forVersion "v1.1" setRoomAccountDataV2 + |> A.sameForVersion "v1.2" + |> A.sameForVersion "v1.3" + |> A.sameForVersion "v1.4" + |> A.sameForVersion "v1.5" + |> A.sameForVersion "v1.6" + |> A.sameForVersion "v1.7" + |> A.sameForVersion "v1.8" + |> A.sameForVersion "v1.9" + |> A.sameForVersion "v1.10" + |> A.sameForVersion "v1.11" + |> A.versionChain + + +{-| Context needed for setting account data on a room. +-} +type alias Phantom a = + { a | accessToken : (), baseUrl : (), versions : () } + + +type alias PhantomV1 a = + { a | accessToken : (), baseUrl : () } + + +type alias SetRoomAccountDataInput = + { content : Json.Value, eventType : String, roomId : String, userId : String } + + +type alias SetRoomAccountDataInputV1 a = + { a | content : Json.Value, eventType : String, roomId : String, userId : String } + + +type alias SetRoomAccountDataOutputV1 = + () + + +setRoomAccountDataV1 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +setRoomAccountDataV1 { content, eventType, roomId, userId } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV1 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "r0", "user", userId, "rooms", roomId, "account_data", eventType ] + , toUpdate = + \() -> + ( R.SetAccountData eventType content + |> V.MapRoom roomId + |> E.ContentUpdate + , [] + ) + } + + +setRoomAccountDataV2 : SetRoomAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +setRoomAccountDataV2 { content, eventType, roomId, userId } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV1 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "v3", "user", userId, "rooms", roomId, "account_data", eventType ] + , toUpdate = + \() -> + ( R.SetAccountData eventType content + |> V.MapRoom roomId + |> E.ContentUpdate + , [] + ) + } + + +coderV1 : Json.Coder SetRoomAccountDataOutputV1 +coderV1 = + Json.unit diff --git a/src/Internal/Api/Task.elm b/src/Internal/Api/Task.elm index 8d4c741..9ecb948 100644 --- a/src/Internal/Api/Task.elm +++ b/src/Internal/Api/Task.elm @@ -1,6 +1,6 @@ module Internal.Api.Task exposing ( Task, run, Backpack - , sendMessageEvent, sendStateEvent, sync + , sendMessageEvent, sendStateEvent, setRoomAccountData, sync ) {-| @@ -23,7 +23,7 @@ up-to-date. ## Tasks -@docs sendMessageEvent, sendStateEvent, sync +@docs sendMessageEvent, sendStateEvent, setRoomAccountData, sync -} @@ -34,6 +34,7 @@ import Internal.Api.Now.Api import Internal.Api.Request as Request import Internal.Api.SendMessageEvent.Api import Internal.Api.SendStateEvent.Api +import Internal.Api.SetRoomAccountData.Api import Internal.Api.Sync.Api import Internal.Api.Versions.Api import Internal.Config.Log exposing (Log, log) @@ -242,6 +243,15 @@ sendStateEvent input = |> finishTask +{-| Set account data for a Matrix room. +-} +setRoomAccountData : { content : Json.Value, eventType : String, roomId : String, userId : String } -> Task +setRoomAccountData input = + makeVBA + |> C.andThen (Internal.Api.SetRoomAccountData.Api.setRoomAccountData input) + |> finishTask + + {-| Sync with the Matrix API to stay up-to-date. -} sync : { fullState : Maybe Bool, presence : Maybe String, since : Maybe String, timeout : Maybe Int } -> Task diff --git a/src/Internal/Tools/Json.elm b/src/Internal/Tools/Json.elm index 2d24b7f..e697f46 100644 --- a/src/Internal/Tools/Json.elm +++ b/src/Internal/Tools/Json.elm @@ -1,5 +1,5 @@ module Internal.Tools.Json exposing - ( Coder, string, bool, int, float, value + ( Coder, string, bool, int, float, value, unit , Encoder, encode, Decoder, decode, Value , succeed, fail, andThen, lazy, map , Docs(..), RequiredField(..), toDocs @@ -29,7 +29,7 @@ data types. Because this module uses dynamic builder types, this also means it is relatively easy to write documentation for any data type that uses this module to build its encoders and decoders. -@docs Coder, string, bool, int, float, value +@docs Coder, string, bool, int, float, value, unit ## JSON Coding @@ -165,6 +165,7 @@ type Docs | DocsRiskyMap (Descriptive { content : Docs, failure : List String }) | DocsSet Docs | DocsString + | DocsUnit | DocsValue @@ -1462,6 +1463,18 @@ toEncodeField (Field data) = ( data.fieldName, data.toField >> data.encoder ) +{-| Completely ignore whatever needs to be encoded, and simply return a unit +value. +-} +unit : Coder () +unit = + Coder + { encoder = \() -> E.object [] + , decoder = D.succeed ( (), [] ) + , docs = DocsUnit + } + + {-| Do not do anything useful with a JSON value, just bring it to Elm as a JavaScript value. -} diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index 8feff52..95d10b9 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -1,6 +1,6 @@ module Matrix.Room exposing ( Room, mostRecentEvents, roomId - , getAccountData + , getAccountData, setAccountData , sendMessageEvent, sendStateEvent ) @@ -34,7 +34,7 @@ data is linked to the user account: other logged in devices can see the account data too, as the server synchronizes it, but the server shouldn´t show it to other users. -@docs getAccountData +@docs getAccountData, setAccountData ## Sending events @@ -126,3 +126,23 @@ sendStateEvent data = , stateKey = data.stateKey , toMsg = Types.VaultUpdate >> data.toMsg } + + +{-| Set account data to a Matrix room. +-} +setAccountData : + { content : E.Value + , eventType : String + , room : Room + , toMsg : Types.VaultUpdate -> msg + } + -> Cmd msg +setAccountData data = + case data.room of + Room room -> + Api.setRoomAccountData room + { content = data.content + , eventType = data.eventType + , roomId = roomId data.room + , toMsg = Types.VaultUpdate >> data.toMsg + } From 3566d3ee7ac8dd771b06875bfa4779fa36b54d13 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 19 Jul 2024 09:02:01 +0200 Subject: [PATCH 06/13] Solve elm test bugs from moving user --- tests/Test/Values/Context.elm | 12 ++++++++---- tests/Test/Values/Envelope.elm | 6 +++--- tests/Test/Values/Vault.elm | 4 +--- 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/tests/Test/Values/Context.elm b/tests/Test/Values/Context.elm index 888287d..b9d09cf 100644 --- a/tests/Test/Values/Context.elm +++ b/tests/Test/Values/Context.elm @@ -8,6 +8,7 @@ import Internal.Values.Context as Context exposing (Context, Versions) import Set import Test exposing (..) import Test.Tools.Timestamp as TestTimestamp +import Test.Values.User as TestUser fuzzer : Fuzzer Context @@ -17,22 +18,25 @@ fuzzer = maybeString = Fuzz.maybe Fuzz.string in - Fuzz.map8 (\a b c d ( e, f ) ( g, h ) ( i, j ) ( k, l ) -> Context a b c d e f g h i j k l) + Fuzz.map8 (\a b c ( d, e ) ( f, g ) ( h, i ) ( j, k ) ( l, m ) -> Context a b c d e f g h i j k l m) (Fuzz.constant <| Hashdict.empty .value) maybeString maybeString - maybeString (Fuzz.pair + maybeString (Fuzz.maybe TestTimestamp.fuzzer) - maybeString ) (Fuzz.pair maybeString + maybeString + ) + (Fuzz.pair Fuzz.string + maybeString ) (Fuzz.pair maybeString - maybeString + (Fuzz.maybe TestUser.fuzzer) ) (Fuzz.pair maybeString diff --git a/tests/Test/Values/Envelope.elm b/tests/Test/Values/Envelope.elm index 81bb569..2f1b2fb 100644 --- a/tests/Test/Values/Envelope.elm +++ b/tests/Test/Values/Envelope.elm @@ -25,7 +25,7 @@ suite = [ fuzz Fuzz.string "currentVersion" (\s -> - { content = s, serverName = "" } + { content = s, serverName = "", user = Nothing } |> Envelope.init |> Envelope.extractSettings .currentVersion |> Expect.equal Default.currentVersion @@ -33,7 +33,7 @@ suite = , fuzz Fuzz.string "deviceName" (\s -> - { content = s, serverName = "" } + { content = s, serverName = "", user = Nothing } |> Envelope.init |> Envelope.extractSettings .deviceName |> Expect.equal Default.deviceName @@ -41,7 +41,7 @@ suite = , fuzz Fuzz.string "syncTime" (\s -> - { content = s, serverName = "" } + { content = s, serverName = "", user = Nothing } |> Envelope.init |> Envelope.extractSettings .syncTime |> Expect.equal Default.syncTime diff --git a/tests/Test/Values/Vault.elm b/tests/Test/Values/Vault.elm index f1c90a0..5cf1aae 100644 --- a/tests/Test/Values/Vault.elm +++ b/tests/Test/Values/Vault.elm @@ -7,12 +7,11 @@ import Internal.Values.Vault exposing (Vault) import Test exposing (..) import Test.Tools.Hashdict as TestHashdict import Test.Values.Room as TestRoom -import Test.Values.User as TestUser vault : Fuzzer Vault vault = - Fuzz.map4 Vault + Fuzz.map3 Vault (Fuzz.string |> Fuzz.map (\k -> ( k, Json.encode Json.int 0 )) |> Fuzz.list @@ -20,4 +19,3 @@ vault = ) (Fuzz.maybe Fuzz.string) (TestHashdict.fuzzer .roomId TestRoom.fuzzer) - (Fuzz.maybe TestUser.fuzzer) From 41bee45693f8284459dbd288d493b71c39e3c261 Mon Sep 17 00:00:00 2001 From: Bram Date: Sun, 21 Jul 2024 10:38:34 +0200 Subject: [PATCH 07/13] Add global account data functions --- src/Internal/Api/Main.elm | 31 ++++++- src/Internal/Api/SetAccountData/Api.elm | 108 ++++++++++++++++++++++++ src/Internal/Api/Task.elm | 14 ++- src/Matrix.elm | 32 +++++++ 4 files changed, 181 insertions(+), 4 deletions(-) create mode 100644 src/Internal/Api/SetAccountData/Api.elm diff --git a/src/Internal/Api/Main.elm b/src/Internal/Api/Main.elm index 5999d5b..76baebb 100644 --- a/src/Internal/Api/Main.elm +++ b/src/Internal/Api/Main.elm @@ -1,6 +1,6 @@ module Internal.Api.Main exposing ( Msg - , sendMessageEvent, sendStateEvent, setRoomAccountData, sync + , sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync ) {-| @@ -18,7 +18,7 @@ This module is used as reference for getting ## Actions -@docs sendMessageEvent, sendStateEvent, setRoomAccountData, sync +@docs sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync -} @@ -86,6 +86,33 @@ sendStateEvent env data = (Context.apiFormat env.context) +{-| Set global account data. +-} +setAccountData : + E.Envelope a + -> + { content : Json.Value + , eventType : String + , toMsg : Msg -> msg + } + -> Cmd msg +setAccountData env data = + case env.context.user of + Just u -> + ITask.run + data.toMsg + (ITask.setAccountData + { content = data.content + , eventType = data.eventType + , userId = User.toString u + } + ) + (Context.apiFormat env.context) + + Nothing -> + Cmd.none + + {-| Set the account data for a Matrix room. -} setRoomAccountData : diff --git a/src/Internal/Api/SetAccountData/Api.elm b/src/Internal/Api/SetAccountData/Api.elm new file mode 100644 index 0000000..32eabe7 --- /dev/null +++ b/src/Internal/Api/SetAccountData/Api.elm @@ -0,0 +1,108 @@ +module Internal.Api.SetAccountData.Api exposing (Phantom, setAccountData) + +{-| + + +# Set Account Data + +This module allows the developer to set global account data. + +@docs Phantom, setAccountData + +-} + +import Internal.Api.Api as A +import Internal.Api.Invite.Api exposing (Phantom) +import Internal.Api.Request as R +import Internal.Config.Log exposing (log) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json +import Internal.Values.Envelope as E +import Internal.Values.Room as R +import Internal.Values.Vault as V + + +setAccountData : SetAccountDataInput -> A.TaskChain (Phantom a) (Phantom a) +setAccountData = + A.startWithVersion "r0.0.0" setAccountDataV1 + |> A.sameForVersion "r0.0.1" + |> A.sameForVersion "r0.1.0" + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.3.0" + |> A.sameForVersion "r0.4.0" + |> A.sameForVersion "r0.5.0" + |> A.sameForVersion "r0.6.0" + |> A.sameForVersion "r0.6.1" + |> A.forVersion "v1.1" setAccountDataV2 + |> A.sameForVersion "v1.2" + |> A.sameForVersion "v1.3" + |> A.sameForVersion "v1.4" + |> A.sameForVersion "v1.5" + |> A.sameForVersion "v1.6" + |> A.sameForVersion "v1.7" + |> A.sameForVersion "v1.8" + |> A.sameForVersion "v1.9" + |> A.sameForVersion "v1.10" + |> A.sameForVersion "v1.11" + |> A.versionChain + + +{-| Context needed for setting global account data. +-} +type alias Phantom a = + { a | accessToken : (), baseUrl : (), versions : () } + + +type alias PhantomV1 a = + { a | accessToken : (), baseUrl : () } + + +type alias SetAccountDataInput = + { content : Json.Value, eventType : String, userId : String } + + +type alias SetAccountDataInputV1 a = + { a | content : Json.Value, eventType : String, userId : String } + + +type alias SetAccountDataOutput = + () + + +setAccountDataV1 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +setAccountDataV1 { content, eventType, userId } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV1 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "r0", "user", userId, "account_data", eventType ] + , toUpdate = + \() -> + ( V.SetAccountData eventType content + |> E.ContentUpdate + , [] + ) + } + + +setAccountDataV2 : SetAccountDataInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +setAccountDataV2 { content, eventType, userId } = + A.request + { attributes = [ R.accessToken, R.fullBody content ] + , coder = coderV1 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "v3", "user", userId, "account_data", eventType ] + , toUpdate = + \() -> + ( V.SetAccountData eventType content + |> E.ContentUpdate + , [] + ) + } + + +coderV1 : Json.Coder SetAccountDataOutput +coderV1 = + Json.unit diff --git a/src/Internal/Api/Task.elm b/src/Internal/Api/Task.elm index 9ecb948..deb1585 100644 --- a/src/Internal/Api/Task.elm +++ b/src/Internal/Api/Task.elm @@ -1,6 +1,6 @@ module Internal.Api.Task exposing ( Task, run, Backpack - , sendMessageEvent, sendStateEvent, setRoomAccountData, sync + , sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync ) {-| @@ -23,7 +23,7 @@ up-to-date. ## Tasks -@docs sendMessageEvent, sendStateEvent, setRoomAccountData, sync +@docs sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync -} @@ -34,6 +34,7 @@ import Internal.Api.Now.Api import Internal.Api.Request as Request import Internal.Api.SendMessageEvent.Api import Internal.Api.SendStateEvent.Api +import Internal.Api.SetAccountData.Api import Internal.Api.SetRoomAccountData.Api import Internal.Api.Sync.Api import Internal.Api.Versions.Api @@ -243,6 +244,15 @@ sendStateEvent input = |> finishTask +{-| Set global account data. +-} +setAccountData : { content : Json.Value, eventType : String, userId : String } -> Task +setAccountData input = + makeVBA + |> C.andThen (Internal.Api.SetAccountData.Api.setAccountData input) + |> finishTask + + {-| Set account data for a Matrix room. -} setRoomAccountData : { content : Json.Value, eventType : String, roomId : String, userId : String } -> Task diff --git a/src/Matrix.elm b/src/Matrix.elm index e9dcd89..7ea641a 100644 --- a/src/Matrix.elm +++ b/src/Matrix.elm @@ -2,6 +2,7 @@ module Matrix exposing ( Vault, fromUserId, fromUsername , VaultUpdate, update, sync, logs , rooms, fromRoomId + , getAccountData, setAccountData , addAccessToken, sendMessageEvent ) @@ -33,6 +34,11 @@ support a monolithic public registry. (: @docs rooms, fromRoomId +## Account data + +@docs getAccountData, setAccountData + + ## Debugging @docs addAccessToken, sendMessageEvent @@ -80,6 +86,13 @@ fromRoomId roomId (Vault vault) = |> Maybe.map Types.Room +{-| Get global account data. +-} +getAccountData : String -> Vault -> Maybe E.Value +getAccountData key (Vault vault) = + Envelope.extract (Internal.getAccountData key) vault + + {-| Use a fully-fledged Matrix ID to connect. case Matrix.fromUserId "@alice:example.org" of @@ -199,6 +212,25 @@ sendMessageEvent data = } +{-| Set global account data. +-} +setAccountData : + { content : E.Value + , eventType : String + , room : Vault + , toMsg : Types.VaultUpdate -> msg + } + -> Cmd msg +setAccountData data = + case data.room of + Vault vault -> + Api.setAccountData vault + { content = data.content + , eventType = data.eventType + , toMsg = Types.VaultUpdate >> data.toMsg + } + + {-| Synchronize the Vault with the Matrix API. Effectively, this task asks the Matrix API to provide the latest information, From a2582f36f9a81af3070703be5a317b6715a0fb77 Mon Sep 17 00:00:00 2001 From: Bram Date: Mon, 22 Jul 2024 12:58:52 +0200 Subject: [PATCH 08/13] Add invite function --- .../Api/{Invite => InviteUser}/Api.elm | 8 +++--- src/Internal/Api/Main.elm | 27 +++++++++++++++++-- src/Internal/Api/SendStateEvent/Api.elm | 1 - src/Internal/Api/SetAccountData/Api.elm | 1 - src/Internal/Api/SetRoomAccountData/Api.elm | 1 - src/Internal/Api/Task.elm | 15 +++++++++-- src/Matrix/Room.elm | 21 ++++++++++++++- 7 files changed, 62 insertions(+), 12 deletions(-) rename src/Internal/Api/{Invite => InviteUser}/Api.elm (94%) diff --git a/src/Internal/Api/Invite/Api.elm b/src/Internal/Api/InviteUser/Api.elm similarity index 94% rename from src/Internal/Api/Invite/Api.elm rename to src/Internal/Api/InviteUser/Api.elm index e39c118..3b9efe8 100644 --- a/src/Internal/Api/Invite/Api.elm +++ b/src/Internal/Api/InviteUser/Api.elm @@ -1,4 +1,4 @@ -module Internal.Api.Invite.Api exposing (InviteInput, Phantom, invite) +module Internal.Api.InviteUser.Api exposing (InviteInput, Phantom, inviteUser) {-| @@ -14,7 +14,7 @@ room. If the user was invited to the room, the homeserver will append a m.room.member event to the room. -@docs InviteInput, Phantom, invite +@docs InviteInput, Phantom, inviteUser -} @@ -31,8 +31,8 @@ import Internal.Values.Vault as V {-| Invite a user to a room. -} -invite : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1) -invite = +inviteUser : InviteInput -> A.TaskChain (Phantom ph1) (Phantom ph1) +inviteUser = A.startWithVersion "r0.0.0" inviteV1 |> A.sameForVersion "r0.0.1" |> A.sameForVersion "r0.1.0" diff --git a/src/Internal/Api/Main.elm b/src/Internal/Api/Main.elm index 76baebb..6be46ab 100644 --- a/src/Internal/Api/Main.elm +++ b/src/Internal/Api/Main.elm @@ -1,6 +1,6 @@ module Internal.Api.Main exposing ( Msg - , sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync + , inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync ) {-| @@ -18,7 +18,7 @@ This module is used as reference for getting ## Actions -@docs sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync +@docs inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync -} @@ -28,6 +28,7 @@ import Internal.Values.Context as Context import Internal.Values.Envelope as E import Internal.Values.User as User import Internal.Values.Vault as V +import Internal.Values.User exposing (User) {-| Update message type that is being returned. @@ -35,6 +36,28 @@ import Internal.Values.Vault as V type alias Msg = Backpack +{-| Invite a user to a room. +-} +inviteUser : + E.Envelope a + -> + { reason : Maybe String + , roomId : String + , toMsg : Msg -> msg + , user : User + } + -> Cmd msg +inviteUser env data = + ITask.run + data.toMsg + (ITask.inviteUser + { reason = data.reason + , roomId = data.roomId + , user = data.user + } + ) + (Context.apiFormat env.context) + {-| Send a message event. -} diff --git a/src/Internal/Api/SendStateEvent/Api.elm b/src/Internal/Api/SendStateEvent/Api.elm index f69e377..a1e6656 100644 --- a/src/Internal/Api/SendStateEvent/Api.elm +++ b/src/Internal/Api/SendStateEvent/Api.elm @@ -12,7 +12,6 @@ This module sends state events to Matrix rooms. -} import Internal.Api.Api as A -import Internal.Api.Invite.Api exposing (Phantom) import Internal.Api.Request as R import Internal.Config.Log exposing (log) import Internal.Config.Text as Text diff --git a/src/Internal/Api/SetAccountData/Api.elm b/src/Internal/Api/SetAccountData/Api.elm index 32eabe7..f55a3b3 100644 --- a/src/Internal/Api/SetAccountData/Api.elm +++ b/src/Internal/Api/SetAccountData/Api.elm @@ -12,7 +12,6 @@ This module allows the developer to set global account data. -} import Internal.Api.Api as A -import Internal.Api.Invite.Api exposing (Phantom) import Internal.Api.Request as R import Internal.Config.Log exposing (log) import Internal.Config.Text as Text diff --git a/src/Internal/Api/SetRoomAccountData/Api.elm b/src/Internal/Api/SetRoomAccountData/Api.elm index a23005e..eb74e0f 100644 --- a/src/Internal/Api/SetRoomAccountData/Api.elm +++ b/src/Internal/Api/SetRoomAccountData/Api.elm @@ -12,7 +12,6 @@ This module allows the developer to set account data to a Matrix room. -} import Internal.Api.Api as A -import Internal.Api.Invite.Api exposing (Phantom) import Internal.Api.Request as R import Internal.Config.Log exposing (log) import Internal.Config.Text as Text diff --git a/src/Internal/Api/Task.elm b/src/Internal/Api/Task.elm index deb1585..da2297a 100644 --- a/src/Internal/Api/Task.elm +++ b/src/Internal/Api/Task.elm @@ -1,6 +1,6 @@ module Internal.Api.Task exposing ( Task, run, Backpack - , sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync + , inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync ) {-| @@ -23,12 +23,13 @@ up-to-date. ## Tasks -@docs sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync +@docs inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync -} import Internal.Api.BaseUrl.Api import Internal.Api.Chain as C +import Internal.Api.InviteUser.Api import Internal.Api.LoginWithUsernameAndPassword.Api import Internal.Api.Now.Api import Internal.Api.Request as Request @@ -46,6 +47,7 @@ import Internal.Values.Envelope as E exposing (EnvelopeUpdate(..)) import Internal.Values.Room exposing (RoomUpdate(..)) import Internal.Values.Vault exposing (VaultUpdate(..)) import Task +import Internal.Values.User exposing (User) {-| A Backpack is the ultimate message type that gets sent back by the Elm @@ -207,6 +209,15 @@ finishTask uftask = ) +{-| Invite a user to a room. +-} +inviteUser : { reason : Maybe String, roomId : String, user : User } -> Task +inviteUser input = + makeVBA + |> C.andThen (Internal.Api.InviteUser.Api.inviteUser input) + |> finishTask + + {-| Establish a Task Chain context where the base URL and supported list of versions are known. -} diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index 95d10b9..5f3f456 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -44,7 +44,7 @@ room. These events are JSON objects that can be shaped in any way or form that you like. To help other users with decoding your JSON objects, you pass an `eventType` string which helps them figure out the nature of your JSON object. -@docs sendMessageEvent, sendStateEvent +@docs inviteUser, sendMessageEvent, sendStateEvent -} @@ -68,6 +68,25 @@ getAccountData key (Room room) = Envelope.extract (Internal.getAccountData key) room +{-| Invite a user to a room. +-} +invite : + { reason : Maybe String + , room : Room + , toMsg : Types.VaultUpdate -> msg + , user : Types.User + } + -> Cmd msg +invite data = + case (data.room, data.user) of + (Room room, Types.User user) -> + Api.inviteUser room + { reason = data.reason + , roomId = roomId data.room + , toMsg = Types.VaultUpdate >> data.toMsg + , user = user.content + } + {-| Get a room's room id. This is an opaque string that distinguishes rooms from each other. -} From 61a8e18714aaccf6eb78e2c46cf35f363e2e480a Mon Sep 17 00:00:00 2001 From: Bram Date: Wed, 24 Jul 2024 14:03:12 +0200 Subject: [PATCH 09/13] Add kick + invite + ban user to Matrix.Room --- src/Internal/Api/BanUser/Api.elm | 116 +++++++++++++++++++ src/Internal/Api/KickUser/Api.elm | 178 ++++++++++++++++++++++++++++++ src/Internal/Api/Main.elm | 56 +++++++++- src/Internal/Api/Task.elm | 31 +++++- src/Matrix/Room.elm | 49 +++++++- 5 files changed, 420 insertions(+), 10 deletions(-) create mode 100644 src/Internal/Api/BanUser/Api.elm create mode 100644 src/Internal/Api/KickUser/Api.elm diff --git a/src/Internal/Api/BanUser/Api.elm b/src/Internal/Api/BanUser/Api.elm new file mode 100644 index 0000000..df06bf2 --- /dev/null +++ b/src/Internal/Api/BanUser/Api.elm @@ -0,0 +1,116 @@ +module Internal.Api.BanUser.Api exposing (Phantom, banUser) + +{-| + +# Ban user + +This module helps to ban users from a room. + +@docs Phantom, banUser + +-} + +import Internal.Api.Api as A +import Internal.Api.Request as R +import Internal.Config.Log exposing (log) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json +import Internal.Values.Envelope as E +import Internal.Values.Room as R +import Internal.Values.User as User exposing (User) +import Internal.Values.Vault as V + + +banUser : BanUserInput -> A.TaskChain (Phantom a) (Phantom a) +banUser = + A.startWithVersion "r0.0.0" banUserV1 + |> A.sameForVersion "r0.0.1" + |> A.sameForVersion "r0.1.0" + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.3.0" + |> A.sameForVersion "r0.4.0" + |> A.sameForVersion "r0.5.0" + |> A.sameForVersion "r0.6.0" + |> A.sameForVersion "r0.6.1" + |> A.forVersion "v1.1" banUserV2 + |> A.sameForVersion "v1.2" + |> A.sameForVersion "v1.3" + |> A.sameForVersion "v1.4" + |> A.sameForVersion "v1.5" + |> A.sameForVersion "v1.6" + |> A.sameForVersion "v1.7" + |> A.sameForVersion "v1.8" + |> A.sameForVersion "v1.9" + |> A.sameForVersion "v1.10" + |> A.sameForVersion "v1.11" + |> A.versionChain + + +type alias Phantom a = + { a | accessToken : (), baseUrl : (), versions : () } + + +type alias PhantomV1 a = + { a | accessToken : (), baseUrl : () } + + +type alias BanUserInput = + { reason : Maybe String + , roomId : String + , user : User + } + + +type alias BanUserInputV1 a = + { a | reason : Maybe String, roomId : String, user : User } + + + +type alias BanUserOutputV1 = + () + + +banUserV1 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +banUserV1 { reason, roomId, user } = + A.request + { attributes = + [ R.accessToken + , R.bodyOpString "reason" reason + , R.bodyString "user_id" (User.toString user) + ] + , coder = coderV1 + , contextChange = always identity + , method = "POST" + , path = [ "_matrix", "client", "r0", "rooms", roomId, "ban" ] + , toUpdate = + \() -> + ( E.More [] + , [] + ) + } + + +banUserV2 : BanUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +banUserV2 { reason, roomId, user } = + A.request + { attributes = + [ R.accessToken + , R.bodyOpString "reason" reason + , R.bodyString "user_id" (User.toString user) + ] + , coder = coderV1 + , contextChange = always identity + , method = "POST" + , path = [ "_matrix", "client", "v3", "rooms", roomId, "ban" ] + , toUpdate = + \() -> + ( E.More [] + , [] + ) + } + + +coderV1 : Json.Coder BanUserOutputV1 +coderV1 = + Json.unit diff --git a/src/Internal/Api/KickUser/Api.elm b/src/Internal/Api/KickUser/Api.elm new file mode 100644 index 0000000..e33b5cb --- /dev/null +++ b/src/Internal/Api/KickUser/Api.elm @@ -0,0 +1,178 @@ +module Internal.Api.KickUser.Api exposing (Phantom, kickUser) + +{-| + + +# Kick user + +This module helps to kick users from a room. + +@docs Phantom, kickUser + +-} + +import Internal.Api.Api as A +import Internal.Api.Request as R +import Internal.Config.Log exposing (log) +import Internal.Config.Text as Text +import Internal.Tools.Json as Json +import Internal.Values.Envelope as E +import Internal.Values.Room as R +import Internal.Values.User as User exposing (User) +import Internal.Values.Vault as V + + +kickUser : KickUserInput -> A.TaskChain (Phantom a) (Phantom a) +kickUser = + A.startWithVersion "r0.0.0" kickUserV1 + |> A.sameForVersion "r0.0.1" + -- NOTE: Kicking a user was first added in r0.1.0 + |> A.forVersion "r0.1.0" kickUserV2 + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.2.0" + |> A.sameForVersion "r0.3.0" + |> A.sameForVersion "r0.4.0" + |> A.sameForVersion "r0.5.0" + |> A.sameForVersion "r0.6.0" + |> A.sameForVersion "r0.6.1" + |> A.forVersion "v1.1" kickUserV3 + |> A.sameForVersion "v1.2" + |> A.sameForVersion "v1.3" + |> A.sameForVersion "v1.4" + |> A.sameForVersion "v1.5" + |> A.sameForVersion "v1.6" + |> A.sameForVersion "v1.7" + |> A.sameForVersion "v1.8" + |> A.sameForVersion "v1.9" + |> A.sameForVersion "v1.10" + |> A.sameForVersion "v1.11" + |> A.versionChain + + +type alias Phantom a = + { a | accessToken : (), baseUrl : (), versions : () } + + +type alias PhantomV1 a = + { a | accessToken : (), baseUrl : () } + + +type alias KickUserInput = + { avatarUrl : Maybe String + , displayname : Maybe String + , reason : Maybe String + , roomId : String + , user : User + } + + +type alias KickUserInputV1 a = + { a + | avatarUrl : Maybe String + , displayname : Maybe String + , reason : Maybe String + , roomId : String + , user : User + } + + +type alias KickUserInputV2 a = + { a | reason : Maybe String, roomId : String, user : User } + + +type alias KickUserOutputV1 = + { eventId : Maybe String } + + +type alias KickUserOutputV2 = + () + + +kickUserV1 : KickUserInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +kickUserV1 { avatarUrl, displayname, reason, roomId, user } = + A.request + { attributes = + [ R.accessToken + , R.bodyString "membership" "kick" + , R.bodyOpString "avatar_url" avatarUrl + , R.bodyOpString "displayname" displayname + , R.bodyOpString "reason" reason + ] + , coder = coderV1 + , contextChange = always identity + , method = "PUT" + , path = [ "_matrix", "client", "r0", "rooms", roomId, "state", "m.room.member", User.toString user ] + , toUpdate = + \out -> + ( E.More [] + , [ "The kick API endpoint does not exist before spec version r0.1.0 - falling back to sending state event directly." + |> log.debug + , out.eventId + |> Text.logs.sendEvent + |> log.debug + ] + ) + } + + +kickUserV2 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +kickUserV2 { reason, roomId, user } = + A.request + { attributes = + [ R.accessToken + , R.bodyOpString "reason" reason + , R.bodyString "user_id" (User.toString user) + ] + , coder = coderV2 + , contextChange = always identity + , method = "POST" + , path = [ "_matrix", "client", "r0", "rooms", roomId, "kick" ] + , toUpdate = + \() -> + ( E.More [] + , [] + ) + } + + +kickUserV3 : KickUserInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 a) +kickUserV3 { reason, roomId, user } = + A.request + { attributes = + [ R.accessToken + , R.bodyOpString "reason" reason + , R.bodyString "user_id" (User.toString user) + ] + , coder = coderV2 + , contextChange = always identity + , method = "POST" + , path = [ "_matrix", "client", "v3", "rooms", roomId, "kick" ] + , toUpdate = + \() -> + ( E.More [] + , [] + ) + } + + +coderV1 : Json.Coder KickUserOutputV1 +coderV1 = + Json.object1 + { name = "EventResponse" + , description = + [ "This object is returned after a state event has been sent." + ] + , init = KickUserOutputV1 + } + (Json.field.optional.value + { fieldName = "event_id" + , toField = .eventId + , description = [ "A unique identifier for the event." ] + , coder = Json.string + } + ) + + +coderV2 : Json.Coder KickUserOutputV2 +coderV2 = + Json.unit diff --git a/src/Internal/Api/Main.elm b/src/Internal/Api/Main.elm index 6be46ab..385d7ed 100644 --- a/src/Internal/Api/Main.elm +++ b/src/Internal/Api/Main.elm @@ -1,6 +1,6 @@ module Internal.Api.Main exposing ( Msg - , inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync + , banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync ) {-| @@ -18,7 +18,7 @@ This module is used as reference for getting ## Actions -@docs inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync +@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync -} @@ -26,9 +26,8 @@ import Internal.Api.Task as ITask exposing (Backpack) import Internal.Tools.Json as Json import Internal.Values.Context as Context import Internal.Values.Envelope as E -import Internal.Values.User as User +import Internal.Values.User as User exposing (User) import Internal.Values.Vault as V -import Internal.Values.User exposing (User) {-| Update message type that is being returned. @@ -36,6 +35,30 @@ import Internal.Values.User exposing (User) type alias Msg = Backpack + +{-| Ban a user from a room. +-} +banUser : + E.Envelope a + -> + { reason : Maybe String + , roomId : String + , toMsg : Msg -> msg + , user : User + } + -> Cmd msg +banUser env data = + ITask.run + data.toMsg + (ITask.banUser + { reason = data.reason + , roomId = data.roomId + , user = data.user + } + ) + (Context.apiFormat env.context) + + {-| Invite a user to a room. -} inviteUser : @@ -59,6 +82,31 @@ inviteUser env data = (Context.apiFormat env.context) +{-| Kick a user from a room. +-} +kickUser : + E.Envelope a + -> + { reason : Maybe String + , roomId : String + , toMsg : Msg -> msg + , user : User + } + -> Cmd msg +kickUser env data = + ITask.run + data.toMsg + (ITask.kickUser + { avatarUrl = Nothing + , displayname = Nothing + , reason = data.reason + , roomId = data.roomId + , user = data.user + } + ) + (Context.apiFormat env.context) + + {-| Send a message event. -} sendMessageEvent : diff --git a/src/Internal/Api/Task.elm b/src/Internal/Api/Task.elm index da2297a..7e0e189 100644 --- a/src/Internal/Api/Task.elm +++ b/src/Internal/Api/Task.elm @@ -1,6 +1,6 @@ module Internal.Api.Task exposing ( Task, run, Backpack - , inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync + , banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync ) {-| @@ -23,13 +23,15 @@ up-to-date. ## Tasks -@docs inviteUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync +@docs banUser, inviteUser, kickUser, sendMessageEvent, sendStateEvent, setAccountData, setRoomAccountData, sync -} +import Internal.Api.BanUser.Api import Internal.Api.BaseUrl.Api import Internal.Api.Chain as C import Internal.Api.InviteUser.Api +import Internal.Api.KickUser.Api import Internal.Api.LoginWithUsernameAndPassword.Api import Internal.Api.Now.Api import Internal.Api.Request as Request @@ -45,9 +47,9 @@ import Internal.Tools.Json as Json import Internal.Values.Context as Context exposing (APIContext) import Internal.Values.Envelope as E exposing (EnvelopeUpdate(..)) import Internal.Values.Room exposing (RoomUpdate(..)) +import Internal.Values.User exposing (User) import Internal.Values.Vault exposing (VaultUpdate(..)) import Task -import Internal.Values.User exposing (User) {-| A Backpack is the ultimate message type that gets sent back by the Elm @@ -69,6 +71,13 @@ complete Task type. type alias UFTask a b = C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b +{-| Ban a user from a room. +-} +banUser : { reason : Maybe String, roomId : String, user : User } -> Task +banUser input = + makeVBA + |> C.andThen (Internal.Api.BanUser.Api.banUser input) + |> finishTask {-| Get an access token to talk to the Matrix API -} @@ -218,6 +227,22 @@ inviteUser input = |> finishTask +{-| Kick a user from a room. +-} +kickUser : + { avatarUrl : Maybe String + , displayname : Maybe String + , reason : Maybe String + , roomId : String + , user : User + } + -> Task +kickUser input = + makeVBA + |> C.andThen (Internal.Api.KickUser.Api.kickUser input) + |> finishTask + + {-| Establish a Task Chain context where the base URL and supported list of versions are known. -} diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index 5f3f456..5faa250 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -2,6 +2,7 @@ module Matrix.Room exposing ( Room, mostRecentEvents, roomId , getAccountData, setAccountData , sendMessageEvent, sendStateEvent + , invite, kick, ban ) {-| @@ -46,6 +47,10 @@ you like. To help other users with decoding your JSON objects, you pass an @docs inviteUser, sendMessageEvent, sendStateEvent +## Moderating users + +@docs invite, kick, ban + -} import Internal.Api.Main as Api @@ -60,6 +65,24 @@ import Types exposing (Room(..)) type alias Room = Types.Room +{-| Ban a user from a room. +-} +ban : + { reason : Maybe String + , room : Room + , toMsg : Types.VaultUpdate -> msg + , user : Types.User + } + -> Cmd msg +ban data = + case ( data.room, data.user ) of + ( Room room, Types.User user ) -> + Api.kickUser room + { reason = data.reason + , roomId = roomId data.room + , toMsg = Types.VaultUpdate >> data.toMsg + , user = Envelope.getContent user + } {-| Get a piece of account data linked to a certain string key. -} @@ -78,15 +101,35 @@ invite : } -> Cmd msg invite data = - case (data.room, data.user) of - (Room room, Types.User user) -> + case ( data.room, data.user ) of + ( Room room, Types.User user ) -> Api.inviteUser room { reason = data.reason , roomId = roomId data.room , toMsg = Types.VaultUpdate >> data.toMsg - , user = user.content + , user = Envelope.getContent user } +{-| Kick a user from a room. +-} +kick : + { reason : Maybe String + , room : Room + , toMsg : Types.VaultUpdate -> msg + , user : Types.User + } + -> Cmd msg +kick data = + case ( data.room, data.user ) of + ( Room room, Types.User user ) -> + Api.kickUser room + { reason = data.reason + , roomId = roomId data.room + , toMsg = Types.VaultUpdate >> data.toMsg + , user = Envelope.getContent user + } + + {-| Get a room's room id. This is an opaque string that distinguishes rooms from each other. -} From a8d879afbb8f3c6e9954b0c1477a4b5aa65605e8 Mon Sep 17 00:00:00 2001 From: Bram Date: Wed, 24 Jul 2024 14:05:49 +0200 Subject: [PATCH 10/13] elm-format --- src/Internal/Api/BanUser/Api.elm | 2 +- src/Internal/Api/Task.elm | 2 ++ src/Matrix/Room.elm | 4 ++++ 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Internal/Api/BanUser/Api.elm b/src/Internal/Api/BanUser/Api.elm index df06bf2..e187014 100644 --- a/src/Internal/Api/BanUser/Api.elm +++ b/src/Internal/Api/BanUser/Api.elm @@ -2,6 +2,7 @@ module Internal.Api.BanUser.Api exposing (Phantom, banUser) {-| + # Ban user This module helps to ban users from a room. @@ -66,7 +67,6 @@ type alias BanUserInputV1 a = { a | reason : Maybe String, roomId : String, user : User } - type alias BanUserOutputV1 = () diff --git a/src/Internal/Api/Task.elm b/src/Internal/Api/Task.elm index 7e0e189..76e27bb 100644 --- a/src/Internal/Api/Task.elm +++ b/src/Internal/Api/Task.elm @@ -71,6 +71,7 @@ complete Task type. type alias UFTask a b = C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b + {-| Ban a user from a room. -} banUser : { reason : Maybe String, roomId : String, user : User } -> Task @@ -79,6 +80,7 @@ banUser input = |> C.andThen (Internal.Api.BanUser.Api.banUser input) |> finishTask + {-| Get an access token to talk to the Matrix API -} getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () } diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index 5faa250..6cf5d5f 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -47,6 +47,7 @@ you like. To help other users with decoding your JSON objects, you pass an @docs inviteUser, sendMessageEvent, sendStateEvent + ## Moderating users @docs invite, kick, ban @@ -65,6 +66,7 @@ import Types exposing (Room(..)) type alias Room = Types.Room + {-| Ban a user from a room. -} ban : @@ -84,6 +86,7 @@ ban data = , user = Envelope.getContent user } + {-| Get a piece of account data linked to a certain string key. -} getAccountData : String -> Room -> Maybe E.Value @@ -110,6 +113,7 @@ invite data = , user = Envelope.getContent user } + {-| Kick a user from a room. -} kick : From 8d28fe63b94c1fb0770c86e4f537d0b4e658f1db Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 25 Jul 2024 19:15:30 +0200 Subject: [PATCH 11/13] Fix bugs --- src/Internal/Api/InviteUser/Api.elm | 3 ++- src/Matrix/Room.elm | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Internal/Api/InviteUser/Api.elm b/src/Internal/Api/InviteUser/Api.elm index 3b9efe8..b70b457 100644 --- a/src/Internal/Api/InviteUser/Api.elm +++ b/src/Internal/Api/InviteUser/Api.elm @@ -107,7 +107,8 @@ inviteV2 : InviteInputV2 a -> A.TaskChain (PhantomV1 ph1) (PhantomV1 ph1) inviteV2 { reason, roomId, user } = A.request { attributes = - [ R.bodyOpString "reason" reason + [ R.accessToken + , R.bodyOpString "reason" reason , R.bodyString "user_id" (User.toString user) , R.onStatusCode 400 "M_UNKNOWN" , R.onStatusCode 403 "M_FORBIDDEN" diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index 6cf5d5f..a1f3696 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -79,7 +79,7 @@ ban : ban data = case ( data.room, data.user ) of ( Room room, Types.User user ) -> - Api.kickUser room + Api.banUser room { reason = data.reason , roomId = roomId data.room , toMsg = Types.VaultUpdate >> data.toMsg From c6d388bff6bfdf1dbdea95382d23f47f8633567a Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 26 Jul 2024 09:25:03 +0200 Subject: [PATCH 12/13] Remove invalid function from documentation --- src/Matrix/Room.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm index a1f3696..6c1a6c7 100644 --- a/src/Matrix/Room.elm +++ b/src/Matrix/Room.elm @@ -45,7 +45,7 @@ room. These events are JSON objects that can be shaped in any way or form that you like. To help other users with decoding your JSON objects, you pass an `eventType` string which helps them figure out the nature of your JSON object. -@docs inviteUser, sendMessageEvent, sendStateEvent +@docs sendMessageEvent, sendStateEvent ## Moderating users From e42ff718096181754dd36440d9cb8ec14d5a9714 Mon Sep 17 00:00:00 2001 From: Bram Date: Fri, 26 Jul 2024 09:34:06 +0200 Subject: [PATCH 13/13] Prepare develop for master elm-test --fuzz 1000 --seed 105375026504828 --- elm.json | 2 +- src/Internal/Config/Default.elm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/elm.json b/elm.json index 0eed841..5c10da6 100644 --- a/elm.json +++ b/elm.json @@ -3,7 +3,7 @@ "name": "noordstar/elm-matrix-sdk-beta", "summary": "Matrix SDK for instant communication. Unstable beta version for testing only.", "license": "EUPL-1.1", - "version": "3.4.0", + "version": "3.5.0", "exposed-modules": [ "Matrix", "Matrix.Event", diff --git a/src/Internal/Config/Default.elm b/src/Internal/Config/Default.elm index 606468e..d1734c9 100644 --- a/src/Internal/Config/Default.elm +++ b/src/Internal/Config/Default.elm @@ -29,7 +29,7 @@ will assume until overriden by the user. -} currentVersion : String currentVersion = - "beta 3.4.0" + "beta 3.5.0" {-| The default device name that is being communicated with the Matrix API.