From 3739043f87aa9a72d29d6b168f471a694b0da3e2 Mon Sep 17 00:00:00 2001 From: Bram Date: Thu, 4 Jan 2024 02:00:31 +0100 Subject: [PATCH] Create Timeline filter --- src/Internal/Filter/Timeline.elm | 237 ++++++++++++++++++++++++++ src/Internal/Values/Event.elm | 55 +++++- tests/Test/Filter/Timeline.elm | 284 +++++++++++++++++++++++++++++++ tests/Test/Values/Event.elm | 11 ++ 4 files changed, 586 insertions(+), 1 deletion(-) create mode 100644 src/Internal/Filter/Timeline.elm create mode 100644 tests/Test/Filter/Timeline.elm diff --git a/src/Internal/Filter/Timeline.elm b/src/Internal/Filter/Timeline.elm new file mode 100644 index 0000000..735f097 --- /dev/null +++ b/src/Internal/Filter/Timeline.elm @@ -0,0 +1,237 @@ +module Internal.Filter.Timeline exposing + ( Filter + , pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail + , match, run + , and + ) + +{-| + + +# Timeline filter + +The timeline filter creates filters for looking through a timeline, as well as +for interacting with the Matrix API. + + +## Timeline + +@docs Filter + + +## Create + +@docs pass, onlySenders, allSendersExcept, onlyTypes, allTypesExcept, fail + + +## Filter + +@docs match, run + + +## Combine + +@docs and + +-} + +import Set exposing (Set) +import Task exposing (fail) + + +{-| Placeholder Event type so the real Event doesn't need to be imported. +-} +type alias Event a = + { a | eventType : String, sender : String } + + +{-| The Timeline Filter filters events out of a timeline, guaranteeing that only +the events that meet the given criteria, meet the requirements. +-} +type Filter + = Filter + { senders : Set String + , sendersAllowOthers : Bool + , types : Set String + , typesAllowOthers : Bool + } + + +{-| Allow events from all senders, except if they are on the provided list. + +If the list is empty, all events are allowed. + +-} +allSendersExcept : List String -> Filter +allSendersExcept senders = + case senders of + [] -> + pass + + _ :: _ -> + Filter + { senders = Set.fromList senders + , sendersAllowOthers = True + , types = Set.empty + , typesAllowOthers = True + } + + +{-| Allow events of every event type, except if they are on the provided list. + +If the list is empty, all events are allowed. + +-} +allTypesExcept : List String -> Filter +allTypesExcept types = + case types of + [] -> + pass + + _ :: _ -> + Filter + { senders = Set.empty + , sendersAllowOthers = True + , types = Set.fromList types + , typesAllowOthers = True + } + + +{-| Only allow an event if it meets the criteria of two Filters. +-} +and : Filter -> Filter -> Filter +and (Filter f1) (Filter f2) = + let + stdAnd : Filter + stdAnd = + Filter + { senders = + case ( f1.sendersAllowOthers, f2.sendersAllowOthers ) of + ( True, True ) -> + Set.union f1.senders f2.senders + + ( True, False ) -> + Set.diff f2.senders f1.senders + + ( False, True ) -> + Set.diff f1.senders f2.senders + + ( False, False ) -> + Set.intersect f1.senders f2.senders + , sendersAllowOthers = f1.sendersAllowOthers && f2.sendersAllowOthers + , types = + case ( f1.typesAllowOthers, f2.typesAllowOthers ) of + ( True, True ) -> + Set.union f1.types f2.types + + ( True, False ) -> + Set.diff f2.types f1.types + + ( False, True ) -> + Set.diff f1.types f2.types + + ( False, False ) -> + Set.intersect f1.types f2.types + , typesAllowOthers = f2.typesAllowOthers && f2.typesAllowOthers + } + in + case stdAnd of + Filter f -> + if Set.isEmpty f.senders && (not f.sendersAllowOthers) then + fail + + else if Set.isEmpty f.types && (not f.typesAllowOthers) then + fail + + else + stdAnd + + +{-| Allow no events. This filter is likely quite useless in practice, but it is +used in the test environment for sanity checks and comparisons. +-} +fail : Filter +fail = + Filter + { senders = Set.empty + , sendersAllowOthers = False + , types = Set.empty + , typesAllowOthers = False + } + + +{-| Determine whether an event passes a filter. +-} +match : Filter -> Event a -> Bool +match (Filter f) { eventType, sender } = + let + mentionedSender : Bool + mentionedSender = + Set.member sender f.senders + + mentionedType : Bool + mentionedType = + Set.member eventType f.types + in + xor mentionedSender f.sendersAllowOthers + && xor mentionedType f.typesAllowOthers + + +{-| Only allow event sent by given senders. + +If an empty list is given, no events are allowed. + +-} +onlySenders : List String -> Filter +onlySenders senders = + case senders of + [] -> + fail + + _ :: _ -> + Filter + { senders = Set.fromList senders + , sendersAllowOthers = False + , types = Set.empty + , typesAllowOthers = True + } + + +{-| Only allow events of a given event type. + +If an empty list is given, no events are allowed. + +-} +onlyTypes : List String -> Filter +onlyTypes types = + case types of + [] -> + fail + + _ :: _ -> + Filter + { senders = Set.empty + , sendersAllowOthers = True + , types = Set.fromList types + , typesAllowOthers = False + } + + +{-| Create a filter that allows all events. This can be useful when trying to +combine multiple filters, or when simply all events are allowed. +-} +pass : Filter +pass = + Filter + { senders = Set.empty + , sendersAllowOthers = True + , types = Set.empty + , typesAllowOthers = True + } + + +{-| Use a filter on a list of events. +-} +run : Filter -> List (Event a) -> List (Event a) +run f events = + List.filter (match f) events diff --git a/src/Internal/Values/Event.elm b/src/Internal/Values/Event.elm index a3a37bb..9bc20ab 100644 --- a/src/Internal/Values/Event.elm +++ b/src/Internal/Values/Event.elm @@ -1,7 +1,7 @@ module Internal.Values.Event exposing ( Event , UnsignedData(..), age, prevContent, redactedBecause, transactionId - , encode, decoder + , encode, decoder, isEqual ) {-| @@ -24,6 +24,10 @@ of a room. @docs encode, decoder +## Test functions + +@docs isEqual + -} import Internal.Config.Default as Default @@ -122,6 +126,55 @@ encodeUnsignedData (UnsignedData data) = ] +{-| Compare two events and determine whether they're identical. Used mostly for +testing purposes. +-} +isEqual : Event -> Event -> Bool +isEqual e1 e2 = + if e1.eventId /= e2.eventId then + False + else if e1.originServerTs /= e2.originServerTs then + False + else if e1.roomId /= e2.roomId then + False + else if e1.sender /= e2.sender then + False + else if e1.stateKey /= e2.stateKey then + False + else if e1.eventType /= e2.eventType then + False + else + case (e1.unsigned, e2.unsigned) of + ( Nothing, Nothing ) -> + True + + ( Just _, Nothing ) -> + False + + ( Nothing, Just _ ) -> + False + + ( Just ( UnsignedData d1), Just ( UnsignedData d2 )) -> + if d1.age /= d2.age then + False + else if d1.transactionId /= d2.transactionId then + False + else if Maybe.map (E.encode 0) d1.prevContent /= Maybe.map (E.encode 0) d2.prevContent then + False + else + case (d1.redactedBecause, d2.redactedBecause) of + ( Nothing, Nothing) -> + True + + ( Nothing, Just _ ) -> + False + + ( Just _, Nothing ) -> + False + + ( Just se1, Just se2 ) -> + isEqual se1 se2 + {-| Determine the previous `content` value for this event. This field is only a `Just value` if the event is a state event, and the Matrix Vault has permission to see the previous content. diff --git a/tests/Test/Filter/Timeline.elm b/tests/Test/Filter/Timeline.elm new file mode 100644 index 0000000..a1e9b99 --- /dev/null +++ b/tests/Test/Filter/Timeline.elm @@ -0,0 +1,284 @@ +module Test.Filter.Timeline exposing (..) + +import Expect +import Fuzz exposing (Fuzzer) +import Internal.Filter.Timeline as Filter exposing (Filter) +import Internal.Values.Event as Event +import Test exposing (..) +import Test.Values.Event as TestEvent + + +fuzzer : Fuzzer Filter +fuzzer = + Fuzz.map2 Filter.and + (Fuzz.oneOf + [ Fuzz.map Filter.allSendersExcept (Fuzz.list Fuzz.string) + , Fuzz.map Filter.onlySenders (Fuzz.list Fuzz.string) + , Fuzz.constant Filter.pass + ] + ) + (Fuzz.oneOf + [ Fuzz.map Filter.allTypesExcept (Fuzz.list Fuzz.string) + , Fuzz.map Filter.onlyTypes (Fuzz.list Fuzz.string) + , Fuzz.constant Filter.pass + ] + ) + + +suite : Test +suite = + describe "Timeline filter" + [ describe "Tautological equivalences" + [ test "Pass /= fail" + (Filter.pass + |> Expect.notEqual Filter.fail + |> always + ) + , test "All senders == pass" + (Filter.allSendersExcept [] + |> Expect.equal Filter.pass + |> always + ) + , test "All types == pass" + (Filter.allTypesExcept [] + |> Expect.equal Filter.pass + |> always + ) + , test "No senders == fail" + (Filter.onlySenders [] + |> Expect.equal Filter.fail + |> always + ) + , test "No types == fail" + (Filter.onlyTypes [] + |> Expect.equal Filter.fail + |> always + ) + , fuzz2 Fuzz.string + (Fuzz.list Fuzz.string) + "Some types /= some senders" + (\head tail -> + Expect.notEqual + (Filter.onlyTypes (head :: tail)) + (Filter.onlySenders (head :: tail)) + ) + ] + , describe "Event filters" + [ fuzz TestEvent.fuzzer + "Only event type filter matches" + (\event -> + event + |> Filter.match (Filter.onlyTypes [ event.eventType ]) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "Only event sender filter matches" + (\event -> + event + |> Filter.match (Filter.onlySenders [ event.sender ]) + |> Expect.equal True + ) + , fuzz TestEvent.fuzzer + "Not event type filter doesn't match" + (\event -> + event + |> Filter.match (Filter.allTypesExcept [ event.eventType ]) + |> Expect.equal False + ) + , fuzz TestEvent.fuzzer + "Not event sender filter doesn't match" + (\event -> + event + |> Filter.match (Filter.allSendersExcept [ event.sender ]) + |> Expect.equal False + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "Only matches when in sender list" + (\event senders -> + event + |> Filter.match (Filter.onlySenders senders) + |> Expect.equal (List.member event.sender senders) + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "Only matches when in type list" + (\event types -> + event + |> Filter.match (Filter.onlyTypes types) + |> Expect.equal (List.member event.eventType types) + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "All except doesn't match when in sender list" + (\event senders -> + event + |> Filter.match (Filter.allSendersExcept senders) + |> Expect.notEqual (List.member event.sender senders) + ) + , fuzz2 TestEvent.fuzzer + (Fuzz.list Fuzz.string) + "All except doesn't match when in type list" + (\event types -> + event + |> Filter.match (Filter.allTypesExcept types) + |> Expect.notEqual (List.member event.eventType types) + ) + , fuzz (Fuzz.list Fuzz.string) + "Only list AND all except list = fail senders" + (\senders -> + Filter.onlySenders senders + |> Filter.and (Filter.allSendersExcept senders) + |> Expect.equal Filter.fail + ) + , fuzz (Fuzz.list Fuzz.string) + "Only list AND all except list = fail types" + (\types -> + Filter.onlyTypes types + |> Filter.and (Filter.allTypesExcept types) + |> Expect.equal Filter.fail + ) + ] + , describe "Use case testing" + [ fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "Only senders + only type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.onlySenders senders ) + ( Filter.onlyTypes types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (List.member e.sender senders) && + (List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + , fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "Only senders + all except type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.onlySenders senders ) + ( Filter.allTypesExcept types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (List.member e.sender senders) && + (not <| List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + , fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "All except senders + only type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.allSendersExcept senders ) + ( Filter.onlyTypes types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (not <| List.member e.sender senders) && + (List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + , fuzz3 (Fuzz.list TestEvent.fuzzer) + (Fuzz.list Fuzz.string) + (Fuzz.list Fuzz.string) + "All except senders + all except type" + (\events senders types -> + let + l1 : List Event.Event + l1 = + events + |> Filter.run + ( Filter.and + ( Filter.allSendersExcept senders ) + ( Filter.allTypesExcept types ) + ) + + l2 : List Event.Event + l2 = + ( List.filter + (\e -> + (not <| List.member e.sender senders) && + (not <| List.member e.eventType types) + ) + events + ) + in + Expect.all + [ Expect.equal (List.length l1) (List.length l2) + |> always + , List.map2 Event.isEqual l1 l2 + |> List.all identity + |> Expect.equal True + |> always + ] + () + ) + ] + ] diff --git a/tests/Test/Values/Event.elm b/tests/Test/Values/Event.elm index d41abaa..068fb30 100644 --- a/tests/Test/Values/Event.elm +++ b/tests/Test/Values/Event.elm @@ -5,6 +5,7 @@ import Internal.Values.Event as Event exposing (Event) import Json.Encode as E import Test exposing (..) import Test.Tools.Timestamp as TestTimestamp +import Expect fuzzer : Fuzzer Event @@ -65,3 +66,13 @@ valueFuzzer = , Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string) , Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer)) ] + +suite : Test +suite = + describe "Sanity check" + [ fuzz fuzzer "event = event" + (\event -> + Event.isEqual event event + |> Expect.equal True + ) + ]