From c32a62c2422deb5a402f1f516e733a8e44dd4cdc Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 22 Mar 2023 15:22:57 +0100 Subject: [PATCH] Get older messages from a chat --- development/build_objects.py | 10 +- src/Internal/Api/GetMessages/Api.elm | 216 ++++++++++++++++++ src/Internal/Api/GetMessages/Main.elm | 92 ++++++++ .../Api/GetMessages/V1/SpecObjects.elm | 96 ++++++++ .../Api/GetMessages/V1/SpecObjects.yaml | 46 ++++ .../Api/GetMessages/V2/SpecObjects.elm | 129 +++++++++++ .../Api/GetMessages/V2/SpecObjects.yaml | 59 +++++ src/Internal/Api/GetMessages/V2/Upcast.elm | 29 +++ .../Api/GetMessages/V3/SpecObjects.elm | 182 +++++++++++++++ .../Api/GetMessages/V3/SpecObjects.yaml | 93 ++++++++ src/Internal/Api/GetMessages/V3/Upcast.elm | 36 +++ .../Api/GetMessages/V4/SpecObjects.elm | 132 +++++++++++ .../Api/GetMessages/V4/SpecObjects.yaml | 62 +++++ src/Internal/Api/GetMessages/V4/Upcast.elm | 50 ++++ .../V3/SpecObjects.elm | 2 +- src/Internal/Api/VaultUpdate.elm | 17 ++ src/Internal/Tools/DecodeExtra.elm | 89 +++++++- src/Internal/Vault.elm | 8 +- 18 files changed, 1341 insertions(+), 7 deletions(-) create mode 100644 src/Internal/Api/GetMessages/Api.elm create mode 100644 src/Internal/Api/GetMessages/Main.elm create mode 100644 src/Internal/Api/GetMessages/V1/SpecObjects.elm create mode 100644 src/Internal/Api/GetMessages/V1/SpecObjects.yaml create mode 100644 src/Internal/Api/GetMessages/V2/SpecObjects.elm create mode 100644 src/Internal/Api/GetMessages/V2/SpecObjects.yaml create mode 100644 src/Internal/Api/GetMessages/V2/Upcast.elm create mode 100644 src/Internal/Api/GetMessages/V3/SpecObjects.elm create mode 100644 src/Internal/Api/GetMessages/V3/SpecObjects.yaml create mode 100644 src/Internal/Api/GetMessages/V3/Upcast.elm create mode 100644 src/Internal/Api/GetMessages/V4/SpecObjects.elm create mode 100644 src/Internal/Api/GetMessages/V4/SpecObjects.yaml create mode 100644 src/Internal/Api/GetMessages/V4/Upcast.elm diff --git a/development/build_objects.py b/development/build_objects.py index 48037df..e063398 100644 --- a/development/build_objects.py +++ b/development/build_objects.py @@ -342,12 +342,16 @@ def main(in_file, out_file): if 'Dict' in content: write("import Dict exposing (Dict)\n") + module_name = 'Internal.Tools.DecodeExtra' + if 'map9' in content or 'map10' in content or 'map11' in content: + module_name = 'Internal.Tools.DecodeExtra as D' + if 'opField ' in content and 'opFieldWithDefault ' in content: - write("import Internal.Tools.DecodeExtra exposing (opField, opFieldWithDefault)\n") + write(f"import {module_name} exposing (opField, opFieldWithDefault)\n") elif 'opFieldWithDefault ' in content: - write("import Internal.Tools.DecodeExtra exposing (opFieldWithDefault)\n") + write(f"import {module_name} exposing (opFieldWithDefault)\n") elif 'opField ' in content: - write("import Internal.Tools.DecodeExtra exposing (opField)\n") + write(f"import {module_name} exposing (opField)\n") if 'maybeObject' in content: write("import Internal.Tools.EncodeExtra exposing (maybeObject)\n") diff --git a/src/Internal/Api/GetMessages/Api.elm b/src/Internal/Api/GetMessages/Api.elm new file mode 100644 index 0000000..c6e81a6 --- /dev/null +++ b/src/Internal/Api/GetMessages/Api.elm @@ -0,0 +1,216 @@ +module Internal.Api.GetMessages.Api exposing (..) + +import Internal.Api.GetMessages.V1.SpecObjects as SO1 +import Internal.Api.GetMessages.V2.SpecObjects as SO2 +import Internal.Api.GetMessages.V3.SpecObjects as SO3 +import Internal.Api.GetMessages.V4.SpecObjects as SO4 +import Internal.Api.Request as R +import Internal.Tools.Context exposing (Context) +import Internal.Tools.Exceptions as X +import Internal.Tools.SpecEnums as Enums +import Task exposing (Task) + + +type alias GetMessagesInputV1 = + { direction : Enums.EventOrder + , from : Maybe String + , limit : Maybe Int + , roomId : String + } + + +type alias GetMessagesInputV2 = + { direction : Enums.EventOrder + , from : Maybe String + , limit : Maybe Int + , roomId : String + , to : Maybe String + } + + +type alias GetMessagesInputV3 = + { direction : Enums.EventOrder + , filter : Maybe String + , from : Maybe String + , limit : Maybe Int + , roomId : String + , to : Maybe String + } + + +type alias GetMessagesInputV4 = + { direction : Enums.EventOrder + , filter : Maybe String + , from : Maybe String + , limit : Maybe Int + , roomId : String + , to : Maybe String + } + + +type alias GetMessagesOutputV1 = + SO1.MessagesResponse + + +type alias GetMessagesOutputV2 = + SO2.MessagesResponse + + +type alias GetMessagesOutputV3 = + SO3.MessagesResponse + + +type alias GetMessagesOutputV4 = + SO4.MessagesResponse + + +getMessagesV1 : GetMessagesInputV1 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV1 +getMessagesV1 { direction, from, limit, roomId } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/r0/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + ] + >> R.toTask SO1.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV2 : GetMessagesInputV2 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV1 +getMessagesV2 { direction, from, limit, roomId, to } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/r0/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + , R.queryOpString "to" to + ] + >> R.toTask SO1.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV3 : GetMessagesInputV3 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV1 +getMessagesV3 { direction, filter, from, limit, roomId, to } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/r0/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + , R.queryOpString "filter" filter + , R.queryOpString "to" to + ] + >> R.toTask SO1.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV4 : GetMessagesInputV3 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV2 +getMessagesV4 { direction, filter, from, limit, roomId, to } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/r0/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + , R.queryOpString "filter" filter + , R.queryOpString "to" to + ] + >> R.toTask SO2.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV5 : GetMessagesInputV3 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV3 +getMessagesV5 { direction, filter, from, limit, roomId, to } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/r0/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + , R.queryOpString "filter" filter + , R.queryOpString "to" to + ] + >> R.toTask SO3.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV6 : GetMessagesInputV3 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV3 +getMessagesV6 { direction, filter, from, limit, roomId, to } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + , R.queryOpString "filter" filter + , R.queryOpString "to" to + ] + >> R.toTask SO3.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV7 : GetMessagesInputV3 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV4 +getMessagesV7 { direction, filter, from, limit, roomId, to } = + case from of + Just f -> + R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryString "from" f + , R.queryOpInt "limit" limit + , R.queryOpString "filter" filter + , R.queryOpString "to" to + ] + >> R.toTask SO4.messagesResponseDecoder + + Nothing -> + always <| Task.fail X.UnsupportedSpecVersion + + +getMessagesV8 : GetMessagesInputV4 -> Context { a | accessToken : (), baseUrl : () } -> Task X.Error GetMessagesOutputV4 +getMessagesV8 { direction, filter, from, limit, roomId, to } = + R.callApi "GET" "/_matrix/client/v3/rooms/{roomId}/messages" + >> R.withAttributes + [ R.accessToken + , R.replaceInUrl "roomId" roomId + , R.queryString "dir" (Enums.fromEventOrder direction) + , R.queryOpString "from" from + , R.queryOpInt "limit" limit + , R.queryOpString "filter" filter + , R.queryOpString "to" to + ] + >> R.toTask SO4.messagesResponseDecoder diff --git a/src/Internal/Api/GetMessages/Main.elm b/src/Internal/Api/GetMessages/Main.elm new file mode 100644 index 0000000..cc83838 --- /dev/null +++ b/src/Internal/Api/GetMessages/Main.elm @@ -0,0 +1,92 @@ +module Internal.Api.GetMessages.Main exposing (..) + +import Internal.Api.GetMessages.Api as Api +import Internal.Api.GetMessages.V2.Upcast as U2 +import Internal.Api.GetMessages.V3.Upcast as U3 +import Internal.Api.GetMessages.V4.Upcast as U4 +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) + + +getMessages : Context (VBA a) -> GetMessagesInput -> Task X.Error GetMessagesOutput +getMessages context input = + VC.withBottomLayer + { current = Api.getMessagesV1 + , version = "r0.0.0" + } + |> VC.sameForVersion "r0.0.1" + |> VC.sameForVersion "r0.1.0" + |> VC.addMiddleLayer + { downcast = + \data -> + { direction = data.direction + , from = data.from + , limit = data.limit + , roomId = data.roomId + } + , current = Api.getMessagesV2 + , upcast = identity -- TODO: Manually filter out events after "to", if possible. + , version = "r0.2.0" + } + |> VC.addMiddleLayer + { downcast = + \data -> + { direction = data.direction + , from = data.from + , limit = data.limit + , roomId = data.roomId + , to = data.to + } + , current = Api.getMessagesV3 + , upcast = identity -- TODO: Manually filter events based on filter input. + , version = "r0.3.0" + } + |> VC.addMiddleLayer + { downcast = identity + , current = Api.getMessagesV4 + , upcast = \f c -> Task.map U2.upcastMessagesResponse (f c) + , version = "r0.4.0" + } + |> VC.addMiddleLayer + { downcast = identity + , current = Api.getMessagesV5 + , upcast = \f c -> Task.map U3.upcastMessagesResponse (f c) + , version = "r0.5.0" + } + |> VC.sameForVersion "r0.6.0" + |> VC.sameForVersion "r0.6.1" + |> VC.addMiddleLayer + { downcast = identity + , current = Api.getMessagesV6 + , upcast = identity + , version = "v1.1" + } + |> VC.addMiddleLayer + { downcast = identity + , current = Api.getMessagesV7 + , upcast = \f c -> Task.map U4.upcastMessagesResponse (f c) + , version = "v1.2" + } + |> VC.addMiddleLayer + { downcast = identity + , current = Api.getMessagesV8 + , upcast = identity + , version = "v1.3" + } + |> VC.sameForVersion "v1.4" + |> VC.sameForVersion "v1.5" + |> VC.sameForVersion "v1.6" + |> VC.mostRecentFromVersionList (Context.getVersions context) + |> Maybe.withDefault (always <| always <| Task.fail X.UnsupportedSpecVersion) + |> (|>) input + |> (|>) context + + +type alias GetMessagesInput = + Api.GetMessagesInputV4 + + +type alias GetMessagesOutput = + Api.GetMessagesOutputV4 diff --git a/src/Internal/Api/GetMessages/V1/SpecObjects.elm b/src/Internal/Api/GetMessages/V1/SpecObjects.elm new file mode 100644 index 0000000..cc7525f --- /dev/null +++ b/src/Internal/Api/GetMessages/V1/SpecObjects.elm @@ -0,0 +1,96 @@ +module Internal.Api.GetMessages.V1.SpecObjects exposing + ( MessagesResponse + , RoomEvent + , encodeMessagesResponse + , encodeRoomEvent + , messagesResponseDecoder + , roomEventDecoder + ) + +{-| Automatically generated 'SpecObjects' + +Last generated at Unix time 1679486096 + +-} + +import Internal.Tools.DecodeExtra as D exposing (opField, opFieldWithDefault) +import Internal.Tools.EncodeExtra exposing (maybeObject) +import Internal.Tools.Timestamp exposing (Timestamp, encodeTimestamp, timestampDecoder) +import Json.Decode as D +import Json.Encode as E + + +{-| Paginated response of requested messages. +-} +type alias MessagesResponse = + { chunk : List RoomEvent + , end : Maybe String + , start : String + } + + +encodeMessagesResponse : MessagesResponse -> E.Value +encodeMessagesResponse data = + maybeObject + [ ( "chunk", Just <| E.list encodeRoomEvent data.chunk ) + , ( "end", Maybe.map E.string data.end ) + , ( "start", Just <| E.string data.start ) + ] + + +messagesResponseDecoder : D.Decoder MessagesResponse +messagesResponseDecoder = + D.map3 + (\a b c -> + { chunk = a, end = b, start = c } + ) + (opFieldWithDefault "chunk" [] (D.list roomEventDecoder)) + (opField "end" D.string) + (D.field "start" D.string) + + +{-| An event gathered by running back through paginated chunks of a room. +-} +type alias RoomEvent = + { age : Maybe Int + , content : E.Value + , eventId : String + , originServerTs : Timestamp + , prevContent : Maybe E.Value + , roomId : String + , stateKey : Maybe String + , contentType : String + , userId : String + } + + +encodeRoomEvent : RoomEvent -> E.Value +encodeRoomEvent data = + maybeObject + [ ( "age", Maybe.map E.int data.age ) + , ( "content", Just <| data.content ) + , ( "event_id", Just <| E.string data.eventId ) + , ( "origin_server_ts", Just <| encodeTimestamp data.originServerTs ) + , ( "prev_content", data.prevContent ) + , ( "room_id", Just <| E.string data.roomId ) + , ( "state_key", Maybe.map E.string data.stateKey ) + , ( "type", Just <| E.string data.contentType ) + , ( "user_id", Just <| E.string data.userId ) + ] + + +roomEventDecoder : D.Decoder RoomEvent +roomEventDecoder = + D.map9 + (\a b c d e f g h i -> + { age = a, content = b, eventId = c, originServerTs = d, prevContent = e, roomId = f, stateKey = g, contentType = h, userId = i } + ) + (opField "age" D.int) + (D.field "content" D.value) + (D.field "event_id" D.string) + (D.field "origin_server_ts" timestampDecoder) + (opField "prev_content" D.value) + (D.field "room_id" D.string) + (opField "state_key" D.string) + (D.field "type" D.string) + (D.field "user_id" D.string) diff --git a/src/Internal/Api/GetMessages/V1/SpecObjects.yaml b/src/Internal/Api/GetMessages/V1/SpecObjects.yaml new file mode 100644 index 0000000..77f0ced --- /dev/null +++ b/src/Internal/Api/GetMessages/V1/SpecObjects.yaml @@ -0,0 +1,46 @@ +version: v1 +name: SpecObjects +objects: + MessagesResponse: + description: Paginated response of requested messages. + fields: + chunk: + type: "[RoomEvent]" + required: false + default: "[]" + end: + type: string + required: false + start: + type: string + required: true + RoomEvent: + description: An event gathered by running back through paginated chunks of a room. + fields: + origin_server_ts: + type: timestamp + required: true + user_id: + type: string + required: true + event_id: + type: string + required: true + content: + type: value + required: true + room_id: + type: string + required: true + type: + type: string + required: true + age: + type: int + required: false + prev_content: + type: value + required: false + state_key: + type: string + required: false diff --git a/src/Internal/Api/GetMessages/V2/SpecObjects.elm b/src/Internal/Api/GetMessages/V2/SpecObjects.elm new file mode 100644 index 0000000..ac6587c --- /dev/null +++ b/src/Internal/Api/GetMessages/V2/SpecObjects.elm @@ -0,0 +1,129 @@ +module Internal.Api.GetMessages.V2.SpecObjects exposing + ( MessagesResponse + , RoomEvent + , UnsignedData(..) + , encodeMessagesResponse + , encodeRoomEvent + , encodeUnsignedData + , messagesResponseDecoder + , roomEventDecoder + , unsignedDataDecoder + ) + +{-| Automatically generated 'SpecObjects' + +Last generated at Unix time 1679486096 + +-} + +import Internal.Tools.DecodeExtra as D exposing (opField, opFieldWithDefault) +import Internal.Tools.EncodeExtra exposing (maybeObject) +import Internal.Tools.Timestamp exposing (Timestamp, encodeTimestamp, timestampDecoder) +import Json.Decode as D +import Json.Encode as E + + +{-| Paginated response of requested messages. +-} +type alias MessagesResponse = + { chunk : List RoomEvent + , end : Maybe String + , start : String + } + + +encodeMessagesResponse : MessagesResponse -> E.Value +encodeMessagesResponse data = + maybeObject + [ ( "chunk", Just <| E.list encodeRoomEvent data.chunk ) + , ( "end", Maybe.map E.string data.end ) + , ( "start", Just <| E.string data.start ) + ] + + +messagesResponseDecoder : D.Decoder MessagesResponse +messagesResponseDecoder = + D.map3 + (\a b c -> + { chunk = a, end = b, start = c } + ) + (opFieldWithDefault "chunk" [] (D.list roomEventDecoder)) + (opField "end" D.string) + (D.field "start" D.string) + + +{-| An event gathered by running back through paginated chunks of a room. +-} +type alias RoomEvent = + { content : E.Value + , eventId : String + , originServerTs : Timestamp + , prevContent : Maybe E.Value + , roomId : String + , sender : String + , stateKey : Maybe String + , contentType : String + , unsigned : Maybe UnsignedData + } + + +encodeRoomEvent : RoomEvent -> E.Value +encodeRoomEvent data = + maybeObject + [ ( "content", Just <| data.content ) + , ( "event_id", Just <| E.string data.eventId ) + , ( "origin_server_ts", Just <| encodeTimestamp data.originServerTs ) + , ( "prev_content", Nothing ) + , ( "room_id", Just <| E.string data.roomId ) + , ( "sender", Just <| E.string data.sender ) + , ( "state_key", Maybe.map E.string data.stateKey ) + , ( "type", Just <| E.string data.contentType ) + , ( "unsigned", Maybe.map encodeUnsignedData data.unsigned ) + ] + + +roomEventDecoder : D.Decoder RoomEvent +roomEventDecoder = + D.map9 + (\a b c d e f g h i -> + { content = a, eventId = b, originServerTs = c, prevContent = d, roomId = e, sender = f, stateKey = g, contentType = h, unsigned = i } + ) + (D.field "content" D.value) + (D.field "event_id" D.string) + (D.field "origin_server_ts" timestampDecoder) + (D.succeed Nothing) + (D.field "room_id" D.string) + (D.field "sender" D.string) + (opField "state_key" D.string) + (D.field "type" D.string) + (opField "unsigned" (D.lazy (\_ -> unsignedDataDecoder))) + + +{-| Extra information about an event that won't be signed by the homeserver. +-} +type UnsignedData + = UnsignedData + { age : Maybe Int + , redactedBecause : Maybe RoomEvent + , transactionId : Maybe String + } + + +encodeUnsignedData : UnsignedData -> E.Value +encodeUnsignedData (UnsignedData data) = + maybeObject + [ ( "age", Maybe.map E.int data.age ) + , ( "redacted_because", Maybe.map encodeRoomEvent data.redactedBecause ) + , ( "transaction_id", Maybe.map E.string data.transactionId ) + ] + + +unsignedDataDecoder : D.Decoder UnsignedData +unsignedDataDecoder = + D.map3 + (\a b c -> + UnsignedData { age = a, redactedBecause = b, transactionId = c } + ) + (opField "age" D.int) + (opField "redacted_because" roomEventDecoder) + (opField "transaction_id" D.string) diff --git a/src/Internal/Api/GetMessages/V2/SpecObjects.yaml b/src/Internal/Api/GetMessages/V2/SpecObjects.yaml new file mode 100644 index 0000000..77bbff6 --- /dev/null +++ b/src/Internal/Api/GetMessages/V2/SpecObjects.yaml @@ -0,0 +1,59 @@ +version: v2 +name: SpecObjects +objects: + MessagesResponse: + description: Paginated response of requested messages. + fields: + chunk: + type: "[RoomEvent]" + required: false + default: "[]" + end: + type: string + required: false + start: + type: string + required: true + RoomEvent: + description: An event gathered by running back through paginated chunks of a room. + fields: + content: + type: value + required: true + type: + type: string + required: true + event_id: + type: string + required: true + sender: + type: string + required: true + origin_server_ts: + type: timestamp + required: true + unsigned: + type: UnsignedData + required: false + room_id: + type: string + required: true + prev_content: + type: value + required: never + state_key: + type: string + required: false + UnsignedData: + anti_recursion: true + description: Extra information about an event that won't be signed by the homeserver. + fields: + age: + type: int + required: false + redacted_because: + type: RoomEvent + required: false + transaction_id: + type: string + required: false diff --git a/src/Internal/Api/GetMessages/V2/Upcast.elm b/src/Internal/Api/GetMessages/V2/Upcast.elm new file mode 100644 index 0000000..824842c --- /dev/null +++ b/src/Internal/Api/GetMessages/V2/Upcast.elm @@ -0,0 +1,29 @@ +module Internal.Api.GetMessages.V2.Upcast exposing (..) + +import Internal.Api.GetMessages.V1.SpecObjects as PO +import Internal.Api.GetMessages.V2.SpecObjects as SO + + +upcastMessagesResponse : PO.MessagesResponse -> SO.MessagesResponse +upcastMessagesResponse old = + { chunk = List.map upcastRoomEvent old.chunk + , start = old.start + , end = old.end + } + + +upcastRoomEvent : PO.RoomEvent -> SO.RoomEvent +upcastRoomEvent old = + { content = old.content + , eventId = old.eventId + , originServerTs = old.originServerTs + , roomId = old.roomId + , sender = old.userId + , contentType = old.contentType + , prevContent = old.prevContent + , stateKey = old.stateKey + , unsigned = + Maybe.map + (\age -> SO.UnsignedData { age = Just age, redactedBecause = Nothing, transactionId = Nothing }) + old.age + } diff --git a/src/Internal/Api/GetMessages/V3/SpecObjects.elm b/src/Internal/Api/GetMessages/V3/SpecObjects.elm new file mode 100644 index 0000000..ef6eba9 --- /dev/null +++ b/src/Internal/Api/GetMessages/V3/SpecObjects.elm @@ -0,0 +1,182 @@ +module Internal.Api.GetMessages.V3.SpecObjects exposing + ( MessagesResponse + , RoomEvent + , RoomStateEvent + , UnsignedData(..) + , encodeMessagesResponse + , encodeRoomEvent + , encodeRoomStateEvent + , encodeUnsignedData + , messagesResponseDecoder + , roomEventDecoder + , roomStateEventDecoder + , unsignedDataDecoder + ) + +{-| Automatically generated 'SpecObjects' + +Last generated at Unix time 1679486096 + +-} + +import Internal.Tools.DecodeExtra as D exposing (opField, opFieldWithDefault) +import Internal.Tools.EncodeExtra exposing (maybeObject) +import Internal.Tools.Timestamp exposing (Timestamp, encodeTimestamp, timestampDecoder) +import Json.Decode as D +import Json.Encode as E + + +{-| Paginated response of requested messages. +-} +type alias MessagesResponse = + { chunk : List RoomEvent + , end : Maybe String + , start : String + , state : List RoomStateEvent + } + + +encodeMessagesResponse : MessagesResponse -> E.Value +encodeMessagesResponse data = + maybeObject + [ ( "chunk", Just <| E.list encodeRoomEvent data.chunk ) + , ( "end", Maybe.map E.string data.end ) + , ( "start", Just <| E.string data.start ) + , ( "state", Just <| E.list encodeRoomStateEvent data.state ) + ] + + +messagesResponseDecoder : D.Decoder MessagesResponse +messagesResponseDecoder = + D.map4 + (\a b c d -> + { chunk = a, end = b, start = c, state = d } + ) + (opFieldWithDefault "chunk" [] (D.list roomEventDecoder)) + (opField "end" D.string) + (D.field "start" D.string) + (opFieldWithDefault "state" [] (D.list roomStateEventDecoder)) + + +{-| An event gathered by running back through paginated chunks of a room. +-} +type alias RoomEvent = + { content : E.Value + , eventId : String + , originServerTs : Timestamp + , prevContent : Maybe E.Value + , roomId : String + , sender : String + , stateKey : Maybe String + , contentType : String + , unsigned : Maybe UnsignedData + } + + +encodeRoomEvent : RoomEvent -> E.Value +encodeRoomEvent data = + maybeObject + [ ( "content", Just <| data.content ) + , ( "event_id", Just <| E.string data.eventId ) + , ( "origin_server_ts", Just <| encodeTimestamp data.originServerTs ) + , ( "prev_content", Nothing ) + , ( "room_id", Just <| E.string data.roomId ) + , ( "sender", Just <| E.string data.sender ) + , ( "state_key", Maybe.map E.string data.stateKey ) + , ( "type", Just <| E.string data.contentType ) + , ( "unsigned", Maybe.map encodeUnsignedData data.unsigned ) + ] + + +roomEventDecoder : D.Decoder RoomEvent +roomEventDecoder = + D.map9 + (\a b c d e f g h i -> + { content = a, eventId = b, originServerTs = c, prevContent = d, roomId = e, sender = f, stateKey = g, contentType = h, unsigned = i } + ) + (D.field "content" D.value) + (D.field "event_id" D.string) + (D.field "origin_server_ts" timestampDecoder) + (D.succeed Nothing) + (D.field "room_id" D.string) + (D.field "sender" D.string) + (opField "state_key" D.string) + (D.field "type" D.string) + (opField "unsigned" (D.lazy (\_ -> unsignedDataDecoder))) + + +{-| State event relevant to showing the chunk. +-} +type alias RoomStateEvent = + { content : E.Value + , eventId : String + , originServerTs : Timestamp + , prevContent : Maybe E.Value + , roomId : String + , sender : String + , stateKey : String + , contentType : String + , unsigned : Maybe UnsignedData + } + + +encodeRoomStateEvent : RoomStateEvent -> E.Value +encodeRoomStateEvent data = + maybeObject + [ ( "content", Just <| data.content ) + , ( "event_id", Just <| E.string data.eventId ) + , ( "origin_server_ts", Just <| encodeTimestamp data.originServerTs ) + , ( "prev_content", data.prevContent ) + , ( "room_id", Just <| E.string data.roomId ) + , ( "sender", Just <| E.string data.sender ) + , ( "state_key", Just <| E.string data.stateKey ) + , ( "type", Just <| E.string data.contentType ) + , ( "unsigned", Maybe.map encodeUnsignedData data.unsigned ) + ] + + +roomStateEventDecoder : D.Decoder RoomStateEvent +roomStateEventDecoder = + D.map9 + (\a b c d e f g h i -> + { content = a, eventId = b, originServerTs = c, prevContent = d, roomId = e, sender = f, stateKey = g, contentType = h, unsigned = i } + ) + (D.field "content" D.value) + (D.field "event_id" D.string) + (D.field "origin_server_ts" timestampDecoder) + (opField "prev_content" D.value) + (D.field "room_id" D.string) + (D.field "sender" D.string) + (D.field "state_key" D.string) + (D.field "type" D.string) + (opField "unsigned" (D.lazy (\_ -> unsignedDataDecoder))) + + +{-| Extra information about an event that won't be signed by the homeserver. +-} +type UnsignedData + = UnsignedData + { age : Maybe Int + , redactedBecause : Maybe RoomEvent + , transactionId : Maybe String + } + + +encodeUnsignedData : UnsignedData -> E.Value +encodeUnsignedData (UnsignedData data) = + maybeObject + [ ( "age", Maybe.map E.int data.age ) + , ( "redacted_because", Maybe.map encodeRoomEvent data.redactedBecause ) + , ( "transaction_id", Maybe.map E.string data.transactionId ) + ] + + +unsignedDataDecoder : D.Decoder UnsignedData +unsignedDataDecoder = + D.map3 + (\a b c -> + UnsignedData { age = a, redactedBecause = b, transactionId = c } + ) + (opField "age" D.int) + (opField "redacted_because" roomEventDecoder) + (opField "transaction_id" D.string) diff --git a/src/Internal/Api/GetMessages/V3/SpecObjects.yaml b/src/Internal/Api/GetMessages/V3/SpecObjects.yaml new file mode 100644 index 0000000..612f738 --- /dev/null +++ b/src/Internal/Api/GetMessages/V3/SpecObjects.yaml @@ -0,0 +1,93 @@ +version: v2 +name: SpecObjects +objects: + MessagesResponse: + description: Paginated response of requested messages. + fields: + chunk: + type: "[RoomEvent]" + required: false + default: "[]" + end: + type: string + required: false + start: + type: string + required: true + state: + type: "[RoomStateEvent]" + required: false + default: "[]" + RoomEvent: + description: An event gathered by running back through paginated chunks of a room. + fields: + content: + type: value + required: true + type: + type: string + required: true + event_id: + type: string + required: true + sender: + type: string + required: true + origin_server_ts: + type: timestamp + required: true + unsigned: + type: UnsignedData + required: false + room_id: + type: string + required: true + prev_content: + type: value + required: never + state_key: + type: string + required: false + RoomStateEvent: + description: State event relevant to showing the chunk. + fields: + content: + type: value + required: true + type: + type: string + required: true + event_id: + type: string + required: true + sender: + type: string + required: true + origin_server_ts: + type: timestamp + required: true + unsigned: + type: UnsignedData + required: false + room_id: + type: string + required: true + prev_content: + type: value + required: false + state_key: + type: string + required: true + UnsignedData: + anti_recursion: true + description: Extra information about an event that won't be signed by the homeserver. + fields: + age: + type: int + required: false + redacted_because: + type: RoomEvent + required: false + transaction_id: + type: string + required: false diff --git a/src/Internal/Api/GetMessages/V3/Upcast.elm b/src/Internal/Api/GetMessages/V3/Upcast.elm new file mode 100644 index 0000000..33e4e5b --- /dev/null +++ b/src/Internal/Api/GetMessages/V3/Upcast.elm @@ -0,0 +1,36 @@ +module Internal.Api.GetMessages.V3.Upcast exposing (..) + +import Internal.Api.GetMessages.V2.SpecObjects as PO +import Internal.Api.GetMessages.V3.SpecObjects as SO + + +upcastMessagesResponse : PO.MessagesResponse -> SO.MessagesResponse +upcastMessagesResponse old = + { chunk = List.map upcastRoomEvent old.chunk + , start = old.start + , end = old.end + , state = [] + } + + +upcastRoomEvent : PO.RoomEvent -> SO.RoomEvent +upcastRoomEvent old = + { content = old.content + , eventId = old.eventId + , originServerTs = old.originServerTs + , roomId = old.roomId + , sender = old.sender + , contentType = old.contentType + , prevContent = old.prevContent + , stateKey = old.stateKey + , unsigned = + old.unsigned + |> Maybe.map + (\(PO.UnsignedData data) -> + SO.UnsignedData + { age = data.age + , redactedBecause = Maybe.map upcastRoomEvent data.redactedBecause + , transactionId = data.transactionId + } + ) + } diff --git a/src/Internal/Api/GetMessages/V4/SpecObjects.elm b/src/Internal/Api/GetMessages/V4/SpecObjects.elm new file mode 100644 index 0000000..d8f3e9a --- /dev/null +++ b/src/Internal/Api/GetMessages/V4/SpecObjects.elm @@ -0,0 +1,132 @@ +module Internal.Api.GetMessages.V4.SpecObjects exposing + ( ClientEvent + , MessagesResponse + , UnsignedData(..) + , clientEventDecoder + , encodeClientEvent + , encodeMessagesResponse + , encodeUnsignedData + , messagesResponseDecoder + , unsignedDataDecoder + ) + +{-| Automatically generated 'SpecObjects' + +Last generated at Unix time 1679486096 + +-} + +import Internal.Tools.DecodeExtra exposing (opField, opFieldWithDefault) +import Internal.Tools.EncodeExtra exposing (maybeObject) +import Internal.Tools.Timestamp exposing (Timestamp, encodeTimestamp, timestampDecoder) +import Json.Decode as D +import Json.Encode as E + + +{-| An event gathered by running back through paginated chunks of a room. +-} +type alias ClientEvent = + { content : E.Value + , eventId : String + , originServerTs : Timestamp + , roomId : String + , sender : String + , stateKey : Maybe String + , contentType : String + , unsigned : Maybe UnsignedData + } + + +encodeClientEvent : ClientEvent -> E.Value +encodeClientEvent data = + maybeObject + [ ( "content", Just <| data.content ) + , ( "event_id", Just <| E.string data.eventId ) + , ( "origin_server_ts", Just <| encodeTimestamp data.originServerTs ) + , ( "room_id", Just <| E.string data.roomId ) + , ( "sender", Just <| E.string data.sender ) + , ( "state_key", Maybe.map E.string data.stateKey ) + , ( "type", Just <| E.string data.contentType ) + , ( "unsigned", Maybe.map encodeUnsignedData data.unsigned ) + ] + + +clientEventDecoder : D.Decoder ClientEvent +clientEventDecoder = + D.map8 + (\a b c d e f g h -> + { content = a, eventId = b, originServerTs = c, roomId = d, sender = e, stateKey = f, contentType = g, unsigned = h } + ) + (D.field "content" D.value) + (D.field "event_id" D.string) + (D.field "origin_server_ts" timestampDecoder) + (D.field "room_id" D.string) + (D.field "sender" D.string) + (opField "state_key" D.string) + (D.field "type" D.string) + (opField "unsigned" (D.lazy (\_ -> unsignedDataDecoder))) + + +{-| Paginated response of requested messages. +-} +type alias MessagesResponse = + { chunk : List ClientEvent + , end : Maybe String + , start : String + , state : List ClientEvent + } + + +encodeMessagesResponse : MessagesResponse -> E.Value +encodeMessagesResponse data = + maybeObject + [ ( "chunk", Just <| E.list encodeClientEvent data.chunk ) + , ( "end", Maybe.map E.string data.end ) + , ( "start", Just <| E.string data.start ) + , ( "state", Just <| E.list encodeClientEvent data.state ) + ] + + +messagesResponseDecoder : D.Decoder MessagesResponse +messagesResponseDecoder = + D.map4 + (\a b c d -> + { chunk = a, end = b, start = c, state = d } + ) + (D.field "chunk" (D.list clientEventDecoder)) + (opField "end" D.string) + (D.field "start" D.string) + (opFieldWithDefault "state" [] (D.list clientEventDecoder)) + + +{-| Extra information about an event that won't be signed by the homeserver. +-} +type UnsignedData + = UnsignedData + { age : Maybe Int + , prevContent : Maybe E.Value + , redactedBecause : Maybe ClientEvent + , transactionId : Maybe String + } + + +encodeUnsignedData : UnsignedData -> E.Value +encodeUnsignedData (UnsignedData data) = + maybeObject + [ ( "age", Maybe.map E.int data.age ) + , ( "prev_content", data.prevContent ) + , ( "redacted_because", Maybe.map encodeClientEvent data.redactedBecause ) + , ( "transaction_id", Maybe.map E.string data.transactionId ) + ] + + +unsignedDataDecoder : D.Decoder UnsignedData +unsignedDataDecoder = + D.map4 + (\a b c d -> + UnsignedData { age = a, prevContent = b, redactedBecause = c, transactionId = d } + ) + (opField "age" D.int) + (opField "prev_content" D.value) + (opField "redacted_because" clientEventDecoder) + (opField "transaction_id" D.string) diff --git a/src/Internal/Api/GetMessages/V4/SpecObjects.yaml b/src/Internal/Api/GetMessages/V4/SpecObjects.yaml new file mode 100644 index 0000000..335915a --- /dev/null +++ b/src/Internal/Api/GetMessages/V4/SpecObjects.yaml @@ -0,0 +1,62 @@ +version: v2 +name: SpecObjects +objects: + MessagesResponse: + description: Paginated response of requested messages. + fields: + chunk: + type: "[ClientEvent]" + required: true + end: + type: string + required: false + start: + type: string + required: true + state: + type: "[ClientEvent]" + required: false + default: "[]" + ClientEvent: + description: An event gathered by running back through paginated chunks of a room. + fields: + content: + type: value + required: true + event_id: + type: string + required: true + origin_server_ts: + type: timestamp + required: true + room_id: + type: string + required: true + sender: + type: string + required: true + state_key: + type: string + required: false + type: + type: string + required: true + unsigned: + type: UnsignedData + required: false + UnsignedData: + anti_recursion: true + description: Extra information about an event that won't be signed by the homeserver. + fields: + age: + type: int + required: false + prev_content: + type: value + required: false + redacted_because: + type: ClientEvent + required: false + transaction_id: + type: string + required: false diff --git a/src/Internal/Api/GetMessages/V4/Upcast.elm b/src/Internal/Api/GetMessages/V4/Upcast.elm new file mode 100644 index 0000000..fd29c97 --- /dev/null +++ b/src/Internal/Api/GetMessages/V4/Upcast.elm @@ -0,0 +1,50 @@ +module Internal.Api.GetMessages.V4.Upcast exposing (..) + +import Internal.Api.GetMessages.V3.SpecObjects as PO +import Internal.Api.GetMessages.V4.SpecObjects as SO +import Json.Encode as E + + +upcastMessagesResponse : PO.MessagesResponse -> SO.MessagesResponse +upcastMessagesResponse old = + { chunk = List.map upcastRoomEvent old.chunk + , end = old.end + , start = old.start + , state = List.map upcastRoomStateEvent old.state + } + + +upcastRoomEvent : PO.RoomEvent -> SO.ClientEvent +upcastRoomEvent old = + { content = old.content + , eventId = old.eventId + , originServerTs = old.originServerTs + , roomId = old.roomId + , sender = old.sender + , stateKey = old.stateKey + , contentType = old.contentType + , unsigned = Maybe.map (upcastUnsigned old.prevContent) old.unsigned + } + + +upcastRoomStateEvent : PO.RoomStateEvent -> SO.ClientEvent +upcastRoomStateEvent old = + { content = old.content + , eventId = old.eventId + , originServerTs = old.originServerTs + , roomId = old.roomId + , sender = old.sender + , stateKey = Just old.stateKey + , contentType = old.contentType + , unsigned = Maybe.map (upcastUnsigned old.prevContent) old.unsigned + } + + +upcastUnsigned : Maybe E.Value -> PO.UnsignedData -> SO.UnsignedData +upcastUnsigned prevContent (PO.UnsignedData old) = + SO.UnsignedData + { age = old.age + , prevContent = prevContent + , redactedBecause = Maybe.map upcastRoomEvent old.redactedBecause + , transactionId = old.transactionId + } diff --git a/src/Internal/Api/LoginWithUsernameAndPassword/V3/SpecObjects.elm b/src/Internal/Api/LoginWithUsernameAndPassword/V3/SpecObjects.elm index 914d99b..718a6f5 100644 --- a/src/Internal/Api/LoginWithUsernameAndPassword/V3/SpecObjects.elm +++ b/src/Internal/Api/LoginWithUsernameAndPassword/V3/SpecObjects.elm @@ -6,7 +6,7 @@ module Internal.Api.LoginWithUsernameAndPassword.V3.SpecObjects exposing {-| Automatically generated 'Login' -Last generated at Unix time 1679075857 +Last generated at Unix time 1679486096 -} diff --git a/src/Internal/Api/VaultUpdate.elm b/src/Internal/Api/VaultUpdate.elm index 5b655e0..cf66a4c 100644 --- a/src/Internal/Api/VaultUpdate.elm +++ b/src/Internal/Api/VaultUpdate.elm @@ -3,6 +3,7 @@ module Internal.Api.VaultUpdate exposing (..) import Internal.Api.Chain as Chain exposing (IdemChain, TaskChain) import Internal.Api.Credentials as Credentials exposing (Credentials) import Internal.Api.GetEvent.Main as GetEvent +import Internal.Api.GetMessages.Main as GetMessages import Internal.Api.Invite.Main as Invite import Internal.Api.JoinRoomById.Main as JoinRoomById import Internal.Api.JoinedMembers.Main as JoinedMembers @@ -25,6 +26,7 @@ type VaultUpdate = MultipleUpdates (List VaultUpdate) -- Updates as a result of API calls | GetEvent GetEvent.EventInput GetEvent.EventOutput + | GetMessages GetMessages.GetMessagesInput GetMessages.GetMessagesOutput | InviteSent Invite.InviteInput Invite.InviteOutput | JoinedMembersToRoom JoinedMembers.JoinedMembersInput JoinedMembers.JoinedMembersOutput | JoinedRoom JoinRoomById.JoinRoomByIdInput JoinRoomById.JoinRoomByIdOutput @@ -115,6 +117,21 @@ getEvent input = input +{-| Get a list of messages from a room. +-} +getMessages : GetMessages.GetMessagesInput -> IdemChain VaultUpdate (VBA a) +getMessages input = + toChain + (\output -> + Chain.TaskChainPiece + { contextChange = identity + , messages = [ GetMessages input output ] + } + ) + GetMessages.getMessages + input + + {-| Get the supported spec versions from the homeserver. -} getVersions : TaskChain VaultUpdate { a | baseUrl : () } (VB a) diff --git a/src/Internal/Tools/DecodeExtra.elm b/src/Internal/Tools/DecodeExtra.elm index 761cd02..1733dad 100644 --- a/src/Internal/Tools/DecodeExtra.elm +++ b/src/Internal/Tools/DecodeExtra.elm @@ -1,4 +1,7 @@ -module Internal.Tools.DecodeExtra exposing (opField, opFieldWithDefault) +module Internal.Tools.DecodeExtra exposing + ( opField, opFieldWithDefault + , map10, map11, map9 + ) {-| Module that helps while decoding JSON. @@ -49,3 +52,87 @@ return a default value. opFieldWithDefault : String -> a -> D.Decoder a -> D.Decoder a opFieldWithDefault fieldName default decoder = opField fieldName decoder |> D.map (Maybe.withDefault default) + + +map9 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> 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 value +map9 func da db dc dd de df dg dh di = + D.map8 + (\a b c d e f g ( h, i ) -> + func a b c d e f g h i + ) + da + db + dc + dd + de + df + dg + (D.map2 Tuple.pair dh di) + + +map10 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> 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 value +map10 func da db dc dd de df dg dh di dj = + D.map8 + (\a b c d e f ( g, h ) ( i, j ) -> + func a b c d e f g h i j + ) + da + db + dc + dd + de + df + (D.map2 Tuple.pair dg dh) + (D.map2 Tuple.pair di dj) + + +map11 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> 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 value +map11 func da db dc dd de df dg dh di dj dk = + D.map8 + (\a b c d e ( f, g ) ( h, i ) ( j, k ) -> + func a b c d e f g h i j k + ) + da + db + dc + dd + de + (D.map2 Tuple.pair df dg) + (D.map2 Tuple.pair dh di) + (D.map2 Tuple.pair dj dk) diff --git a/src/Internal/Vault.elm b/src/Internal/Vault.elm index 7045c4c..e910222 100644 --- a/src/Internal/Vault.elm +++ b/src/Internal/Vault.elm @@ -124,6 +124,10 @@ updateWith vaultUpdate ((Vault ({ cred, context } as data)) as vault) = Nothing -> vault + -- TODO + GetMessages _ _ -> + vault + -- TODO InviteSent _ _ -> vault @@ -272,10 +276,10 @@ sync (Vault { cred, context }) = -- TODO: The login should be different when soft_logout. -- TODO: Add support for refresh token. - X.ServerException (X.M_UNKNOWN_TOKEN { soft_logout }) -> + X.ServerException (X.M_UNKNOWN_TOKEN _) -> Api.loginMaybeSync syncInput context - X.ServerException (X.M_MISSING_TOKEN { soft_logout }) -> + X.ServerException (X.M_MISSING_TOKEN _) -> Api.loginMaybeSync syncInput context X.ServerException _ ->