From 4797ba2f931a50d8833cb322004e226eb0a300ec Mon Sep 17 00:00:00 2001 From: Bram van den Heuvel Date: Wed, 8 Feb 2023 16:52:54 +0100 Subject: [PATCH] Add new Elm types I have had a few helpful Elm ideas and lessons while at FOSDEM, which may help the project in positive ways. For example, the fact that the file `Leaking.elm` exists, suggests that the code has a few downsides that may shine through when a refactor is made. For this reason, some features will be reworked and reprogrammed. Luckily, Elm's homepage claims that this language is easy to refactor. :) --- src/Internal/Config/Leaking.elm | 5 + src/Internal/Tools/Fold.elm | 49 ++++++ src/Internal/Tools/Hashdict.elm | 41 +++++ src/Internal/Values/Credentials.elm | 45 ++++++ src/Internal/Values/Event.elm | 45 ++++-- src/Internal/Values/Room.elm | 55 +++++++ src/Internal/Values/StateManager.elm | 40 +++-- src/Internal/Values/Timeline.elm | 226 +++++++++++++++++++++++++++ 8 files changed, 481 insertions(+), 25 deletions(-) create mode 100644 src/Internal/Tools/Fold.elm create mode 100644 src/Internal/Tools/Hashdict.elm create mode 100644 src/Internal/Values/Credentials.elm create mode 100644 src/Internal/Values/Room.elm create mode 100644 src/Internal/Values/Timeline.elm diff --git a/src/Internal/Config/Leaking.elm b/src/Internal/Config/Leaking.elm index c172beb..c86800f 100644 --- a/src/Internal/Config/Leaking.elm +++ b/src/Internal/Config/Leaking.elm @@ -31,6 +31,11 @@ originServerTs = Time.millisToPosix 0 +prevBatch : String +prevBatch = + "this_previous_batch_does_not_exist" + + roomId : String roomId = "!unknown-room:example.org" diff --git a/src/Internal/Tools/Fold.elm b/src/Internal/Tools/Fold.elm new file mode 100644 index 0000000..9443e3c --- /dev/null +++ b/src/Internal/Tools/Fold.elm @@ -0,0 +1,49 @@ +module Internal.Tools.Fold exposing (..) + +{-| This module allows users to iterate over lists in more intelligent ways. +-} + + +type FoldingState a + = Calculating a + | AnswerFound a + + +type FoldingResponse a + = ContinueWith a + | AnswerWith a + | AnswerWithPrevious + + +{-| Fold until a given condition is met. +The first argument is a function that returns a `Maybe b`. As soon as that value is `Nothing`, the function will ignore the rest of the list and return the most recent value. +-} +untilCompleted : ((a -> FoldingState b -> FoldingState b) -> FoldingState b -> List a -> FoldingState b) -> (a -> b -> FoldingResponse b) -> b -> List a -> b +untilCompleted folder updater startValue items = + folder + (\piece oldValue -> + case oldValue of + AnswerFound x -> + AnswerFound x + + Calculating x -> + case updater piece x of + ContinueWith y -> + Calculating y + + AnswerWith y -> + AnswerFound y + + AnswerWithPrevious -> + AnswerFound x + ) + (Calculating startValue) + items + |> (\resp -> + case resp of + Calculating x -> + x + + AnswerFound x -> + x + ) diff --git a/src/Internal/Tools/Hashdict.elm b/src/Internal/Tools/Hashdict.elm new file mode 100644 index 0000000..7830e3e --- /dev/null +++ b/src/Internal/Tools/Hashdict.elm @@ -0,0 +1,41 @@ +module Internal.Tools.Hashdict exposing (..) + +{-| This module abstracts the `Dict` type with one function that chooses the unique identifier for each type. + +For example, this is used to store events by their event id, or store rooms by their room id. + +-} + +import Dict exposing (Dict) + + +type Hashdict a + = Hashdict + { hash : a -> String + , values : Dict String a + } + + +empty : (a -> String) -> Hashdict a +empty hash = + Hashdict { hash = hash, values = Dict.empty } + + +get : String -> Hashdict a -> Maybe a +get k (Hashdict h) = + Dict.get k h.values + + +insert : a -> Hashdict a -> Hashdict a +insert v (Hashdict h) = + Hashdict { h | values = Dict.insert (h.hash v) v h.values } + + +keys : Hashdict a -> List String +keys (Hashdict h) = + Dict.keys h.values + + +values : Hashdict a -> List a +values (Hashdict h) = + Dict.values h.values diff --git a/src/Internal/Values/Credentials.elm b/src/Internal/Values/Credentials.elm new file mode 100644 index 0000000..c145f58 --- /dev/null +++ b/src/Internal/Values/Credentials.elm @@ -0,0 +1,45 @@ +module Internal.Values.Credentials exposing (..) + +import Dict exposing (Dict) +import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) +import Internal.Values.Room as Room exposing (Room) + + +type Credentials + = Credentials { access : AccessToken, homeserver : String, rooms : Hashdict Room } + + +type AccessToken + = AccessToken String + | NoAccess + | UsernameAndPassword { username : String, password : String, accessToken : Maybe String } + +defaultCredentials : String -> Credentials +defaultCredentials homeserver = + Credentials + { access = NoAccess + , homeserver = homeserver + , rooms = Hashdict.empty Room.roomId + } + +fromAccessToken : { accessToken : String, homeserver : String } -> Credentials +fromAccessToken { accessToken, homeserver } = + case defaultCredentials homeserver of + Credentials c -> + Credentials { c | access = AccessToken accessToken } + +fromLoginCredentials : { username : String, password : String, homeserver : String } -> Credentials +fromLoginCredentials { username, password, homeserver } = + case defaultCredentials homeserver of + Credentials c -> + Credentials { c | access = UsernameAndPassword { username = username, password = password, accessToken = Nothing } } + +getRoomById : String -> Credentials -> Maybe Room +getRoomById roomId (Credentials cred) = + Hashdict.get roomId cred.rooms + + +insertRoom : Room -> Credentials -> Credentials +insertRoom room (Credentials cred) = + Credentials + { cred | rooms = Hashdict.insert room cred.rooms } diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index 2e46762..009fa11 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -3,8 +3,9 @@ module Internal.Values.Event exposing (..) import Internal.Tools.Timestamp exposing (Timestamp) import Json.Encode as E -type Event = - Event + +type Event + = Event { content : E.Value , eventId : String , originServerTs : Timestamp @@ -12,70 +13,88 @@ type Event = , sender : String , stateKey : Maybe String , contentType : String - , unsigned : Maybe { age : Maybe Int - , prevContent : Maybe E.Value - , redactedBecause : Maybe Event - , transactionId : Maybe String - } + , unsigned : + Maybe + { age : Maybe Int + , prevContent : Maybe E.Value + , redactedBecause : Maybe Event + , transactionId : Maybe String + } } + + {- GETTER FUNCTIONS -} + content : Event -> E.Value content (Event e) = e.content + eventId : Event -> String eventId (Event e) = e.eventId + originServerTs : Event -> Timestamp originServerTs (Event e) = e.originServerTs + roomId : Event -> String roomId (Event e) = e.roomId - + + sender : Event -> String sender (Event e) = e.sender + stateKey : Event -> Maybe String stateKey (Event e) = e.stateKey + contentType : Event -> String contentType (Event e) = e.contentType + age : Event -> Maybe Int age (Event e) = e.unsigned - |> Maybe.andThen .age + |> Maybe.andThen .age + redactedBecause : Event -> Maybe Event redactedBecause (Event e) = e.unsigned - |> Maybe.andThen .redactedBecause + |> Maybe.andThen .redactedBecause age : Event -> Maybe Int age (Event e) = e.unsigned - |> Maybe.andThen .age + |> Maybe.andThen .age + transactionId : Event -> Maybe String transactionId (Event e) = e.unsigned - |> Maybe.andThen .transactionId + |> Maybe.andThen .transactionId + + +type BlindEvent + = BlindEvent { contentType : String, content : E.Value } -type BlindEvent = BlindEvent { contentType : String, content : E.Value } blindContent : BlindEvent -> E.Value blindContent (BlindEvent be) = be.content + blindContentType : BlindEvent -> String blindContentType (BlindEvent be) = be.contentType diff --git a/src/Internal/Values/Room.elm b/src/Internal/Values/Room.elm new file mode 100644 index 0000000..c83a91f --- /dev/null +++ b/src/Internal/Values/Room.elm @@ -0,0 +1,55 @@ +module Internal.Values.Room exposing (..) + +import Dict exposing (Dict) +import Internal.Tools.Fold as Fold +import Internal.Tools.SpecEnums exposing (SessionDescriptionType(..)) +import Internal.Values.Event as Event exposing (BlindEvent, Event) +import Internal.Values.StateManager as StateManager exposing (StateManager) +import Internal.Values.Timeline as Timeline exposing (Timeline) +import Json.Encode as E + + +type Room + = Room + { accountData : Dict String E.Value + , ephemeral : List BlindEvent + , events : Dict String Event + , roomId : String + , timeline : Timeline + } + + +{-| Add new events as the most recent events. +-} +addEvents : + { events : List Event + , nextBatch : String + , prevBatch : String + , stateDelta : Maybe StateManager + } + -> Room + -> Room +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) + , timeline = Timeline.addNewEvents data room.timeline + } + + +{-| Get an event by its id. +-} +getEventById : String -> Room -> Maybe Event +getEventById eventId (Room room) = + Dict.get eventId room.events + + +{-| Get the room's id. +-} +roomId : Room -> String +roomId (Room room) = + room.roomId diff --git a/src/Internal/Values/StateManager.elm b/src/Internal/Values/StateManager.elm index ac44e19..913caaa 100644 --- a/src/Internal/Values/StateManager.elm +++ b/src/Internal/Values/StateManager.elm @@ -3,26 +3,42 @@ module Internal.Values.StateManager exposing (..) import Dict exposing (Dict) import Internal.Values.Event as Event exposing (Event) -type alias StateManager = Dict (String, String) Event + +type alias StateManager = + Dict ( String, String ) Event + + +addEvent : Event -> StateManager -> StateManager +addEvent event oldManager = + case Event.stateKey event of + Just key -> + Dict.insert ( Event.contentType event, key ) event oldManager + + Nothing -> + oldManager + getStateEvent : String -> String -> StateManager -> Maybe Event getStateEvent eventType stateKey = Dict.get ( eventType, stateKey ) + updateRoomStateWith : StateManager -> StateManager -> StateManager -updateRoomStateWith = Dict.union +updateRoomStateWith = + Dict.union + + +fromEvent : Event -> StateManager +fromEvent event = + Dict.empty + |> addEvent event + fromEventList : List Event -> StateManager fromEventList = - List.filterMap - (\event -> - event - |> Event.stateKey - |> Maybe.map - (\key -> - ( ( Event.contentType event, key ), event ) - ) - ) - >> Dict.fromList + List.foldl addEvent Dict.empty +empty : StateManager +empty = + Dict.empty diff --git a/src/Internal/Values/Timeline.elm b/src/Internal/Values/Timeline.elm new file mode 100644 index 0000000..cdbdb72 --- /dev/null +++ b/src/Internal/Values/Timeline.elm @@ -0,0 +1,226 @@ +module Internal.Values.Timeline exposing (..) + +{-| This module shapes the Timeline type used to keep track of timelines in Matrix rooms. +-} + +import Internal.Config.Leaking as Leaking +import Internal.Tools.Fold as Fold +import Internal.Values.Event as Event exposing (Event) +import Internal.Values.Room exposing (stateAtEvent) +import Internal.Values.StateManager as StateManager exposing (StateManager) + + +type Timeline + = Timeline + { prevBatch : String + , nextBatch : String + , events : List Event + , stateAtStart : StateManager + , previous : BeforeTimeline + } + + +type BeforeTimeline + = Endless String + | Gap Timeline + | StartOfTimeline + + +{-| Add a new batch of events to the front of the timeline. +-} +addNewEvents : + { events : List Event + , nextBatch : String + , prevBatch : String + , stateDelta : Maybe StateManager + } + -> Timeline + -> Timeline +addNewEvents { events, nextBatch, prevBatch, stateDelta } (Timeline t) = + Timeline + (if prevBatch == t.nextBatch then + { t + | events = t.events ++ events + , nextBatch = nextBatch + } + + else + { prevBatch = prevBatch + , nextBatch = nextBatch + , events = events + , stateAtStart = + t + |> Timeline + |> mostRecentState + |> StateManager.updateRoomStateWith + (stateDelta + |> Maybe.withDefault StateManager.empty + ) + , previous = Gap (Timeline t) + } + ) + + +{-| Create a new timeline. +-} +newFromEvents : + { events : List Event + , nextBatch : String + , prevBatch : Maybe String + , stateDelta : Maybe StateManager + } + -> Timeline +newFromEvents { events, nextBatch, prevBatch, stateDelta } = + Timeline + { events = events + , nextBatch = nextBatch + , prevBatch = + prevBatch + |> Maybe.withDefault Leaking.prevBatch + , previous = + prevBatch + |> Maybe.map Endless + |> Maybe.withDefault StartOfTimeline + , stateAtStart = + stateDelta + |> Maybe.withDefault StateManager.empty + } + + +{-| Insert events starting from a known batch token. +-} +insertEvents : + { events : List Event + , nextBatch : String + , prevBatch : String + , stateDelta : Maybe StateManager + } + -> Timeline + -> Timeline +insertEvents ({ events, nextBatch, prevBatch, stateDelta } as data) (Timeline t) = + Timeline + (if t.nextBatch == prevBatch then + { t + | events = t.events ++ events + , nextBatch = nextBatch + } + + else if nextBatch == t.prevBatch then + case t.previous of + Gap (Timeline prevT) -> + if prevT.nextBatch == prevBatch then + { events = prevT.events ++ events ++ t.events + , nextBatch = t.nextBatch + , prevBatch = prevT.prevBatch + , stateAtStart = prevT.stateAtStart + , previous = prevT.previous + } + + else + { t + | events = events ++ t.events + , prevBatch = prevBatch + , stateAtStart = + stateDelta + |> Maybe.withDefault StateManager.empty + } + + _ -> + { t + | events = events ++ t.events + , prevBatch = prevBatch + , stateAtStart = + stateDelta + |> Maybe.withDefault StateManager.empty + } + + else + case t.previous of + Gap prevT -> + { t + | previous = + prevT + |> insertEvents data + |> Gap + } + + _ -> + t + ) + + +{-| Get the longest uninterrupted length of most recent events. +-} +localSize : Timeline -> Int +localSize = + mostRecentEvents >> List.length + + +{-| Get a list of the most recent events recorded. +-} +mostRecentEvents : Timeline -> List Event +mostRecentEvents (Timeline t) = + t.events + + +{-| Get the needed `since` parameter to get the latest events. +-} +nextSyncToken : Timeline -> String +nextSyncToken (Timeline t) = + t.nextBatch + + +{-| Get the state of the room after the most recent event. +-} +mostRecentState : Timeline -> StateManager +mostRecentState (Timeline t) = + t.stateAtStart + |> StateManager.updateRoomStateWith + (StateManager.fromEventList t.events) + + +{-| Get the timeline's room state at any given event. The function returns `Nothing` if the event is not found in the timeline. +-} +stateAtEvent : Event -> Timeline -> Maybe StateManager +stateAtEvent event (Timeline t) = + if + t.events + |> List.map Event.eventId + |> List.member (Event.eventId event) + then + Fold.untilCompleted + List.foldl + (\e -> + StateManager.addEvent e + >> (if Event.eventId e == Event.eventId event then + Fold.AnswerWith + + else + Fold.ContinueWith + ) + ) + t.stateAtStart + t.events + |> Just + + else + case t.previous of + Gap prevT -> + stateAtEvent event prevT + + _ -> + Nothing + + +{-| Count how many events the current timeline is storing. +-} +size : Timeline -> Int +size (Timeline t) = + (case t.previous of + Gap prev -> + size prev + + _ -> + 0 + ) + + List.length t.events