Create Timeline filter

pull/17/head
Bram 2024-01-04 02:00:31 +01:00
parent a70e1a775b
commit 3739043f87
4 changed files with 586 additions and 1 deletions

View File

@ -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

View File

@ -1,7 +1,7 @@
module Internal.Values.Event exposing module Internal.Values.Event exposing
( Event ( Event
, UnsignedData(..), age, prevContent, redactedBecause, transactionId , UnsignedData(..), age, prevContent, redactedBecause, transactionId
, encode, decoder , encode, decoder, isEqual
) )
{-| {-|
@ -24,6 +24,10 @@ of a room.
@docs encode, decoder @docs encode, decoder
## Test functions
@docs isEqual
-} -}
import Internal.Config.Default as Default 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 {-| 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 `Just value` if the event is a state event, and the Matrix Vault has permission
to see the previous content. to see the previous content.

View File

@ -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
]
()
)
]
]

View File

@ -5,6 +5,7 @@ import Internal.Values.Event as Event exposing (Event)
import Json.Encode as E import Json.Encode as E
import Test exposing (..) import Test exposing (..)
import Test.Tools.Timestamp as TestTimestamp import Test.Tools.Timestamp as TestTimestamp
import Expect
fuzzer : Fuzzer Event fuzzer : Fuzzer Event
@ -65,3 +66,13 @@ valueFuzzer =
, Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string) , Fuzz.map (E.list E.string) (Fuzz.list Fuzz.string)
, Fuzz.map Event.encode (Fuzz.lazy (\_ -> fuzzer)) , 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
)
]