From 7e345c2b0528c514f003de01bf134d7142d51a62 Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 1 Mar 2023 15:58:40 +0100 Subject: [PATCH] Connect internal Credentials, Room, Event WARNING: contains a few syntax errors - still work in progress --- src/Internal/Credentials.elm | 73 +++++++++++++ src/Internal/Event.elm | 159 ++++++++++++++++++++++++++++ src/Internal/Room.elm | 45 +++++++- src/Internal/Tools/Hashdict.elm | 19 ++++ src/Internal/Tools/ValueGetter.elm | 78 +++++++------- src/Internal/Values/Credentials.elm | 14 +++ src/Internal/Values/Event.elm | 27 +++-- src/Internal/Values/Room.elm | 18 ++-- 8 files changed, 377 insertions(+), 56 deletions(-) create mode 100644 src/Internal/Event.elm diff --git a/src/Internal/Credentials.elm b/src/Internal/Credentials.elm index a3a1848..cee77bf 100644 --- a/src/Internal/Credentials.elm +++ b/src/Internal/Credentials.elm @@ -7,8 +7,13 @@ This file combines the internal functions with the API endpoints to create a ful -} +import Dict +import Internal.Api.All as Api import Internal.Room as Room +import Internal.Event as Event import Internal.Values.Credentials as Internal +import Internal.Values.Event as IEvent +import Internal.Values.Room as IRoom {-| You can consider the `Credentials` type as a large ring of keys, @@ -50,3 +55,71 @@ getRoomById roomId credentials = , versions = Internal.getVersions credentials } ) + +{-| Insert an internal room type into the credentials. +-} +insertInternalRoom : IRoom.Room -> Credentials -> Credentials +insertInternalRoom = Internal.insertRoom + +{-| Internal a full room type into the credentials. -} +insertRoom : Room.Room -> Credentials -> Credentials +insertRoom = Room.internalValue >> insertInternalRoom + +{-| Update the Credentials type with new values -} +updateWith : Api.CredUpdate -> Credentials -> Credentials +updateWith credUpdate credentials = + case credUpdate of + Api.MultipleUpdates updates -> + List.foldl updateWith credentials updates + + Api.GetEvent input output -> + case getRoomById input.roomId credentials of + Just room -> + output + |> IEvent.initFromGetEvent + |> Room.addInternalEvent + |> (|>) room + |> insertRoom + |> (|>) credentials + + Nothing -> + credentials + + Api.JoinedMembersToRoom _ _ -> + credentials -- TODO + + Api.MessageEventSent _ _ -> + credentials -- TODO + + Api.StateEventSent _ _ -> + credentials -- TODO + + Api.SyncUpdate input output -> + let + rooms = + output.rooms + |> Maybe.map .join + |> Maybe.withDefault Dict.empty + |> Dict.toList + |> List.map + (\(roomId, jroom)-> + case getRoomById roomId credentials of + -- Update existing room + Just room -> + room + |> Room.internalValue + |> IRoom.addEvents + + + -- Add new room + Nothing -> + jroom + ) + in + credentials + + Api.UpdateAccessToken token -> + Internal.addAccessToken token credentials + + Api.UpdateVersions versions -> + Internal.addVersions versions credentials diff --git a/src/Internal/Event.elm b/src/Internal/Event.elm new file mode 100644 index 0000000..ffe9a5d --- /dev/null +++ b/src/Internal/Event.elm @@ -0,0 +1,159 @@ +module Internal.Event exposing (..) + +{-| This module represents the event type in the Matrix API. + +Users can use this type to reply to events, to link them, look for other events, +resend other events or forward them elsewhere. + +-} + +import Internal.Api.GetEvent.Main as GetEvent +import Internal.Api.GetEvent.V1.SpecObjects as GetEventSO +import Internal.Api.PreApi.Objects.Versions as V +import Internal.Api.Sync.V1.SpecObjects as SyncSO +import Internal.Tools.LoginValues exposing (AccessToken) +import Internal.Tools.Timestamp exposing (Timestamp) +import Internal.Values.Event as Internal +import Json.Encode as E + + +{-| The central event type. This type will be used by the user and will be directly interacted with. +-} +type Event + = Event + { event : Internal.Event + , accessToken : AccessToken + , baseUrl : String + , versions : Maybe V.Versions + } + + +{-| Using the credentials' background information and an internal event type, +create an interactive event type. +-} +init : { accessToken : AccessToken, baseUrl : String, versions : Maybe V.Versions } -> Internal.Event -> Event +init { accessToken, baseUrl, versions } event = + Event + { event = event + , accessToken = accessToken + , baseUrl = baseUrl + , versions = versions + } + + +{-| Create an internal event type from an API endpoint event object. +This function is placed in this file to respect file hierarchy and avoid circular imports. +-} +initFromGetEvent : GetEvent.EventOutput -> Internal.Event +initFromGetEvent output = + Internal.init + { content = output.content + , eventId = output.eventId + , originServerTs = output.originServerTs + , roomId = output.roomId + , sender = output.sender + , stateKey = output.stateKey + , contentType = output.contentType + , unsigned = + output.unsigned + |> Maybe.map + (\(GetEventSO.UnsignedData data) -> + { age = data.age + , prevContent = data.prevContent + , redactedBecause = Maybe.map initFromGetEvent data.redactedBecause + , transactionId = data.transactionId + } + ) + } + + +{-| Create an internal event type from an API endpoint event object. +This function is placed in this file to respect file hierarchy and avoid circular imports. +-} +initFromClientEventWithoutRoomId : String -> SyncSO.ClientEventWithoutRoomId -> Internal.Event +initFromClientEventWithoutRoomId rId output = + Internal.init + { content = output.content + , eventId = output.eventId + , originServerTs = output.originServerTs + , roomId = rId + , sender = output.sender + , stateKey = output.stateKey + , contentType = output.contentType + , unsigned = + output.unsigned + |> Maybe.map + (\(SyncSO.UnsignedData data) -> + { age = data.age + , prevContent = data.prevContent + , redactedBecause = Maybe.map (initFromClientEventWithoutRoomId roomId) data.redactedBecause + , transactionId = data.transactionId + } + ) + } + + +{-| Get the internal event type that is hidden in the interactive event type. +-} +internalValue : Event -> Internal.Event +internalValue (Event { event }) = + event + + + +{- GETTER FUNCTIONS -} + + +content : Event -> E.Value +content = + internalValue >> Internal.content + + +eventId : Event -> String +eventId = + internalValue >> Internal.eventId + + +originServerTs : Event -> Timestamp +originServerTs = + internalValue >> Internal.originServerTs + + +roomId : Event -> String +roomId = + internalValue >> Internal.roomId + + +sender : Event -> String +sender = + internalValue >> Internal.sender + + +stateKey : Event -> Maybe String +stateKey = + internalValue >> Internal.stateKey + + +contentType : Event -> String +contentType = + internalValue >> Internal.contentType + + +age : Event -> Maybe Int +age = + internalValue >> Internal.age + + +redactedBecause : Event -> Maybe Event +redactedBecause (Event data) = + data.event + |> Internal.redactedBecause + |> Maybe.map + (\event -> + Event { data | event = event } + ) + + +transactionId : Event -> Maybe String +transactionId = + internalValue >> Internal.transactionId diff --git a/src/Internal/Room.elm b/src/Internal/Room.elm index a9e51ff..44c510a 100644 --- a/src/Internal/Room.elm +++ b/src/Internal/Room.elm @@ -5,14 +5,22 @@ module Internal.Room exposing (..) import Internal.Api.All as Api import Internal.Api.PreApi.Objects.Versions as V +import Internal.Event as Event exposing (Event) import Internal.Tools.Exceptions as X import Internal.Tools.LoginValues exposing (AccessToken) +import Internal.Values.Event as IEvent import Internal.Values.Room as Internal import Json.Encode as E import Task exposing (Task) -{-| The Room type. +{-| The `Room` type represents a Matrix Room. It contains context information +such as the `accessToken` that allows the retrieval of new information from +the Matrix API if necessary. + +The `Room` type contains utilities to inquire about the room and send messages +to it. + -} type Room = Room @@ -23,6 +31,24 @@ type Room } +{-| Adds an internal event to the `Room`. An internal event is a custom event +that has been generated by the client. +-} +addInternalEvent : IEvent.Event -> Room -> Room +addInternalEvent ievent (Room ({ room } as data)) = + Room { data | room = Internal.addEvent ievent room } + + +{-| Adds an `Event` object to the `Room`. An `Event` is a value from the +`Internal.Event` module that is used to represent an event in a Matrix room. +-} +addEvent : Event -> Room -> Room +addEvent = + Event.internalValue >> addInternalEvent + + +{-| Creates a new `Room` object with the given parameters. +-} init : { accessToken : AccessToken, baseUrl : String, versions : Maybe V.Versions } -> Internal.Room -> Room init { accessToken, baseUrl, versions } room = Room @@ -33,13 +59,22 @@ init { accessToken, baseUrl, versions } room = } -{-| Get the room's id. +{-| Retrieves the `Internal.Room` type contained within the given `Room`. +-} +internalValue : Room -> Internal.Room +internalValue (Room { room }) = + room + + +{-| Retrieves the ID of the Matrix room associated with the given `Room`. -} roomId : Room -> String -roomId (Room { room }) = - Internal.roomId room +roomId = + internalValue >> Internal.roomId +{-| Sends a new event to the Matrix room associated with the given `Room`. +-} sendEvent : Room -> { eventType : String, content : E.Value } -> Task X.Error Api.CredUpdate sendEvent (Room { room, accessToken, baseUrl, versions }) { eventType, content } = Api.sendMessageEvent @@ -53,6 +88,8 @@ sendEvent (Room { room, accessToken, baseUrl, versions }) { eventType, content } } +{-| Sends a new text message to the Matrix room associated with the given `Room`. +-} sendMessage : Room -> String -> Task X.Error Api.CredUpdate sendMessage (Room { room, accessToken, baseUrl, versions }) text = Api.sendMessageEvent diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm index 7830e3e..1835233 100644 --- a/src/Internal/Tools/Hashdict.elm +++ b/src/Internal/Tools/Hashdict.elm @@ -21,6 +21,17 @@ empty hash = Hashdict { hash = hash, values = Dict.empty } +fromList : (a -> String) -> List a -> Hashdict a +fromList hash xs = + Hashdict + { hash = hash + , values = + xs + |> List.map (\x -> ( hash x, x )) + |> Dict.fromList + } + + get : String -> Hashdict a -> Maybe a get k (Hashdict h) = Dict.get k h.values @@ -36,6 +47,14 @@ keys (Hashdict h) = Dict.keys h.values +union : Hashdict a -> Hashdict a -> Hashdict a +union (Hashdict h1) (Hashdict h2) = + Hashdict + { hash = h1.hash + , values = Dict.union h1.values h2.values + } + + values : Hashdict a -> List a values (Hashdict h) = Dict.values h.values diff --git a/src/Internal/Tools/ValueGetter.elm b/src/Internal/Tools/ValueGetter.elm index e73a689..4dfe90b 100644 --- a/src/Internal/Tools/ValueGetter.elm +++ b/src/Internal/Tools/ValueGetter.elm @@ -22,23 +22,23 @@ HTTP call that needs that value. import Task exposing (Task) -{-| A ValueGetter type takes care of values that MIGHT be available. +{-| A ValueGetter x type takes care of values that MIGHT be available. If a value is not available, then the task can be used to get a new value. -} -type alias ValueGetter a = +type alias ValueGetter x a = { value : Maybe a, getValue : Task x a } {-| Convert a `ValueGetter` type to a task. If a previous value has already been given, then use that value. Otherwise, use the `getValue` task to get a new value. -} -toTask : ValueGetter a -> Task x a +toTask : ValueGetter x a -> Task x a toTask { value, getValue } = Maybe.map Task.succeed value |> Maybe.withDefault getValue -withInfo : (a -> Task x result) -> ValueGetter a -> Task x result +withInfo : (a -> Task x result) -> ValueGetter x a -> Task x result withInfo task info1 = Task.andThen (\a -> @@ -49,8 +49,8 @@ withInfo task info1 = withInfo2 : (a -> b -> Task x result) - -> ValueGetter a - -> ValueGetter b + -> ValueGetter x a + -> ValueGetter x b -> Task x result withInfo2 task info1 info2 = Task.andThen @@ -66,9 +66,9 @@ withInfo2 task info1 info2 = withInfo3 : (a -> b -> c -> Task x result) - -> ValueGetter a - -> ValueGetter b - -> ValueGetter c + -> ValueGetter x a + -> ValueGetter x b + -> ValueGetter x c -> Task x result withInfo3 task info1 info2 info3 = Task.andThen @@ -88,10 +88,10 @@ withInfo3 task info1 info2 info3 = withInfo4 : (a -> b -> c -> d -> Task x result) - -> ValueGetter a - -> ValueGetter b - -> ValueGetter c - -> ValueGetter d + -> ValueGetter x a + -> ValueGetter x b + -> ValueGetter x c + -> ValueGetter x d -> Task x result withInfo4 task info1 info2 info3 info4 = Task.andThen @@ -115,11 +115,11 @@ withInfo4 task info1 info2 info3 info4 = withInfo5 : (a -> b -> c -> d -> e -> Task x result) - -> ValueGetter a - -> ValueGetter b - -> ValueGetter c - -> ValueGetter d - -> ValueGetter e + -> ValueGetter x a + -> ValueGetter x b + -> ValueGetter x c + -> ValueGetter x d + -> ValueGetter x e -> Task x result withInfo5 task info1 info2 info3 info4 info5 = Task.andThen @@ -147,12 +147,12 @@ withInfo5 task info1 info2 info3 info4 info5 = withInfo6 : (a -> b -> c -> d -> e -> f -> Task x result) - -> ValueGetter a - -> ValueGetter b - -> ValueGetter c - -> ValueGetter d - -> ValueGetter e - -> ValueGetter f + -> ValueGetter x a + -> ValueGetter x b + -> ValueGetter x c + -> ValueGetter x d + -> ValueGetter x e + -> ValueGetter x f -> Task x result withInfo6 task info1 info2 info3 info4 info5 info6 = Task.andThen @@ -184,13 +184,13 @@ withInfo6 task info1 info2 info3 info4 info5 info6 = withInfo7 : (a -> b -> c -> d -> e -> f -> g -> Task x result) - -> ValueGetter a - -> ValueGetter b - -> ValueGetter c - -> ValueGetter d - -> ValueGetter e - -> ValueGetter f - -> ValueGetter g + -> ValueGetter x a + -> ValueGetter x b + -> ValueGetter x c + -> ValueGetter x d + -> ValueGetter x e + -> ValueGetter x f + -> ValueGetter x g -> Task x result withInfo7 task info1 info2 info3 info4 info5 info6 info7 = Task.andThen @@ -226,14 +226,14 @@ withInfo7 task info1 info2 info3 info4 info5 info6 info7 = withInfo8 : (a -> b -> c -> d -> e -> f -> g -> h -> Task x result) - -> ValueGetter a - -> ValueGetter b - -> ValueGetter c - -> ValueGetter d - -> ValueGetter e - -> ValueGetter f - -> ValueGetter g - -> ValueGetter h + -> ValueGetter x a + -> ValueGetter x b + -> ValueGetter x c + -> ValueGetter x d + -> ValueGetter x e + -> ValueGetter x f + -> ValueGetter x g + -> ValueGetter x h -> Task x result withInfo8 task info1 info2 info3 info4 info5 info6 info7 info8 = Task.andThen diff --git a/src/Internal/Values/Credentials.elm b/src/Internal/Values/Credentials.elm index 12f5e6a..9b46466 100644 --- a/src/Internal/Values/Credentials.elm +++ b/src/Internal/Values/Credentials.elm @@ -14,6 +14,20 @@ type Credentials = Credentials { access : AccessToken, baseUrl : String, rooms : Hashdict Room, versions : Maybe V.Versions } +{-| Add a new access token based on prior information. +-} +addAccessToken : String -> Credentials -> Credentials +addAccessToken token (Credentials ({ access } as data)) = + Credentials { data | access = Login.addToken token access } + + +{-| Add the list of versions that is supported by the homeserver. +-} +addVersions : V.Versions -> Credentials -> Credentials +addVersions versions (Credentials data) = + Credentials { data | versions = Just versions } + + {-| Get the stringed access token the Credentials type is using, if any. -} getAccessToken : Credentials -> Maybe String diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 009fa11..b373a61 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -23,6 +23,27 @@ type Event } +init : + { content : E.Value + , eventId : String + , originServerTs : Timestamp + , roomId : String + , sender : String + , stateKey : Maybe String + , contentType : String + , unsigned : + Maybe + { age : Maybe Int + , prevContent : Maybe E.Value + , redactedBecause : Maybe Event + , transactionId : Maybe String + } + } + -> Event +init = + Event + + {- GETTER FUNCTIONS -} @@ -74,12 +95,6 @@ redactedBecause (Event e) = |> Maybe.andThen .redactedBecause -age : Event -> Maybe Int -age (Event e) = - e.unsigned - |> Maybe.andThen .age - - transactionId : Event -> Maybe String transactionId (Event e) = e.unsigned diff --git a/src/Internal/Values/Room.elm b/src/Internal/Values/Room.elm index 6948715..4686b24 100644 --- a/src/Internal/Values/Room.elm +++ b/src/Internal/Values/Room.elm @@ -1,6 +1,7 @@ module Internal.Values.Room exposing (..) import Dict exposing (Dict) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.SpecEnums exposing (SessionDescriptionType(..)) import Internal.Values.Event as Event exposing (BlindEvent, Event) import Internal.Values.StateManager exposing (StateManager) @@ -12,12 +13,19 @@ type Room = Room { accountData : Dict String E.Value , ephemeral : List BlindEvent - , events : Dict String Event + , events : Hashdict Event , roomId : String , timeline : Timeline } +{-| Add the data of a single event to the hashdict of events. +-} +addEvent : Event -> Room -> Room +addEvent event (Room ({ events } as room)) = + Room { room | events = Hashdict.insert event events } + + {-| Add new events as the most recent events. -} addEvents : @@ -31,11 +39,7 @@ addEvents : addEvents ({ events } as data) (Room room) = Room { room - | events = - events - |> List.map (\e -> ( Event.eventId e, e )) - |> Dict.fromList - |> (\x -> Dict.union x room.events) + | events = List.foldl Hashdict.insert room.events events , timeline = Timeline.addNewEvents data room.timeline } @@ -44,7 +48,7 @@ addEvents ({ events } as data) (Room room) = -} getEventById : String -> Room -> Maybe Event getEventById eventId (Room room) = - Dict.get eventId room.events + Hashdict.get eventId room.events {-| Get the room's id.