Create Timeline filter
							parent
							
								
									a70e1a775b
								
							
						
					
					
						commit
						3739043f87
					
				|  | @ -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 | ||||
|  | @ -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. | ||||
|  |  | |||
|  | @ -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 | ||||
|                             ] | ||||
|                             () | ||||
|                 ) | ||||
|             ] | ||||
|         ] | ||||
|  | @ -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 | ||||
|             ) | ||||
|         ] | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue