Implement part of a push-based notification system

src/Main.elm

@@ -5,6 +5,7 @@ import Scylla.Room exposing (OpenRooms, applySync)
 import Scylla.Sync exposing (..)
 import Scylla.Sync.Events exposing (toMessageEvent, getType, getSender, getUnsigned)
 import Scylla.Sync.AccountData exposing (..)
+import Scylla.Sync.Push exposing (..)
 import Scylla.ListUtils exposing (..)
 import Scylla.Messages exposing (..)
 import Scylla.Login exposing (..)
@@ -51,7 +52,6 @@ init _ url key =
             , sending = Dict.empty
             , transactionId = 0
             , userData = Dict.empty
-            , roomNames = Dict.empty
             , connected = True
             , searchText = ""
             , rooms = emptyOpenRooms
@@ -314,10 +314,13 @@ updateSyncResponse model r notify =
         userDataCmd sr = newUsersCmd model
             <| newUsers model
             <| allUsers sr
-        notification sr = findFirstBy
+        notification sr = 
+            getPushRuleset model.accountData
+            |> Maybe.map (\rs -> getNotificationEvents rs sr)
+            |> Maybe.withDefault []
+            |> findFirstBy
                 (\(s, e) -> e.originServerTs)
                 (\(s, e) -> e.sender /= model.loginUsername)
-            <| getNotificationEvents sr
         notificationCmd sr = if notify
             then Maybe.withDefault Cmd.none
                     <| Maybe.map (\(s, e) -> sendNotificationPort

src/Scylla/Model.elm

@@ -4,6 +4,7 @@ import Scylla.Sync exposing (SyncResponse, HistoryResponse)
 import Scylla.ListUtils exposing (findFirst)
 import Scylla.Room exposing (OpenRooms)
 import Scylla.Sync.Rooms exposing (JoinedRoom)
+import Scylla.Sync.Push exposing (Ruleset)
 import Scylla.Sync.AccountData exposing (AccountData, directMessagesDecoder)
 import Scylla.Login exposing (LoginResponse, Username, Password)
 import Scylla.UserData exposing (UserData)
@@ -36,7 +37,6 @@ type alias Model =
     , sending : Dict Int (RoomId, SendingMessage)
     , transactionId : Int
     , userData : Dict Username UserData
-    , roomNames : Dict RoomId String
     , connected : Bool
     , searchText : String
     , rooms : OpenRooms

src/Scylla/Notification.elm

@@ -1,6 +1,7 @@
 port module Scylla.Notification exposing (..)
 import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
 import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
+import Scylla.Sync.Push exposing (Ruleset, getEventNotification)
 import Json.Decode as Decode exposing (string, field)
 import Dict
 
@@ -18,13 +19,14 @@ getText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
     Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
     _ -> ""
 
-getNotificationEvents : SyncResponse -> List (String, MessageEvent)
-getNotificationEvents s =
-    let
-        applyPair k = List.map (\v -> (k, v))
-    in
-        List.sortBy (\(k, v) -> v.originServerTs)
-        <| List.filterMap (\(k, e) -> Maybe.map (\me -> (k, me)) <| toMessageEvent e)
-        <| Dict.foldl (\k v a -> a ++ applyPair k v) []
-        <| joinedRoomsTimelineEvents s
-
+getNotificationEvents : Ruleset -> SyncResponse -> List (String, MessageEvent)
+getNotificationEvents rs s = s.rooms
+    |> Maybe.andThen .join
+    |> Maybe.map (Dict.map (\k v -> v.timeline
+        |> Maybe.andThen .events
+        |> Maybe.map (List.filter <| getEventNotification rs k)
+        |> Maybe.map (List.filterMap <| toMessageEvent)
+        |> Maybe.withDefault []))
+    |> Maybe.withDefault Dict.empty
+    |> Dict.toList
+    |> List.concatMap (\(k, vs) -> List.map (\v -> (k, v)) vs)

src/Scylla/Sync/AccountData.elm

@@ -2,7 +2,8 @@ module Scylla.Sync.AccountData exposing (..)
 import Scylla.ListUtils exposing (..)
 import Scylla.Sync.DecodeTools exposing (maybeDecode)
 import Scylla.Sync.Events exposing (Event, eventDecoder)
-import Json.Decode as Decode exposing (Decoder, list, decodeValue)
+import Scylla.Sync.Push exposing (Ruleset, rulesetDecoder)
+import Json.Decode as Decode exposing (Decoder, list, field, decodeValue)
 import Dict exposing (Dict)
 
 type alias AccountData =
@@ -48,3 +49,6 @@ getAccountData key d ad = ad.events
 
 getDirectMessages : AccountData -> Maybe DirectMessages
 getDirectMessages = getAccountData "m.direct" directMessagesDecoder
+
+getPushRuleset : AccountData -> Maybe Ruleset
+getPushRuleset = getAccountData "m.push_rules" (field "global" rulesetDecoder)

src/Scylla/Sync/Events.elm

@@ -38,8 +38,8 @@ type RoomEvent
 
 roomEventDecoder : Decoder RoomEvent
 roomEventDecoder = oneOf
-    [ Decode.map MessageRoomEvent messageEventDecoder
-    , Decode.map StateRoomEvent stateEventDecoder
+    [ Decode.map StateRoomEvent stateEventDecoder
+    , Decode.map MessageRoomEvent messageEventDecoder
     ]
 
 type alias MessageEvent =
@@ -124,6 +124,12 @@ getType re =
         StateRoomEvent e -> e.type_
         MessageRoomEvent e -> e.type_
 
+getContent : RoomEvent -> Decode.Value
+getContent re =
+    case re of
+        StateRoomEvent e -> e.content
+        MessageRoomEvent e -> e.content
+
 toStateEvent : RoomEvent -> Maybe StateEvent
 toStateEvent re =
     case re of

src/Scylla/Sync/Push.elm

@@ -0,0 +1,167 @@
+module Scylla.Sync.Push exposing (..)
+import Scylla.Sync.DecodeTools exposing (maybeDecode)
+import Scylla.Sync.Events exposing (RoomEvent, getSender, getContent, getType)
+import Scylla.Route exposing (RoomId)
+import Json.Decode as Decode exposing (Decoder, string, int, field, value, bool, list)
+import Json.Decode.Pipeline exposing (required, optional)
+
+type Condition
+    = EventMatch String String
+    | ContainsDisplayName
+    | RoomMemberCount Int
+    | SenderNotificationPermission String
+
+conditionDecoder : Decoder Condition
+conditionDecoder =
+    let
+        eventMatchDecoder =
+            Decode.succeed EventMatch
+            |> required "key" string
+            |> required "pattern" string
+        containsDisplayNameDecoder =
+            Decode.succeed ContainsDisplayName
+        roomMemberCountDecoder =
+            Decode.succeed RoomMemberCount
+            |> required "is" 
+                (Decode.map (Maybe.withDefault 0 << String.toInt) string)
+        senderNotifPermissionDecoder =
+            Decode.succeed SenderNotificationPermission
+            |> required "key" string
+        dispatchDecoder k =
+            case k of
+                "event_match" -> eventMatchDecoder
+                "contains_display_name" -> containsDisplayNameDecoder
+                "room_member_count" -> roomMemberCountDecoder
+                "sender_notification_permission" -> senderNotifPermissionDecoder
+                _ -> Decode.fail "Unknown condition code"
+    in
+        field "kind" string
+        |> Decode.andThen dispatchDecoder
+
+type Action
+    = Notify
+    | DontNotify
+    | Coalesce
+    | SetTweak String (Maybe Decode.Value)
+
+actionDecoder : Decoder Action
+actionDecoder =
+    let
+        dispatchStringDecoder s =
+            case s of
+                "notify" -> Decode.succeed Notify
+                "dont_notify" -> Decode.succeed DontNotify
+                "coalesce" -> Decode.succeed Coalesce
+                _ -> Decode.fail "Unknown action string"
+        objectDecoder =
+            Decode.succeed SetTweak
+            |> required "set_tweak" string
+            |> maybeDecode "value" value
+    in
+        Decode.oneOf
+            [ string |> Decode.andThen dispatchStringDecoder
+            , objectDecoder
+            ]
+
+type alias Rule =
+    { ruleId : String
+    , default : Bool
+    , enabled : Bool
+    , conditions : List Condition
+    , actions : List Action
+    }
+
+ruleDecoder : Decoder Rule
+ruleDecoder =
+    let
+        patternDecoder = Decode.oneOf
+            [ field "pattern" string
+                |> Decode.andThen
+                    (\p -> Decode.succeed <| \r ->
+                        { r | conditions = (EventMatch "content.body" p)::r.conditions })
+            , Decode.succeed identity
+            ]
+        basicRuleDecoder = Decode.succeed Rule
+            |> required "rule_id" string
+            |> optional "default" bool True
+            |> optional "enabled" bool False
+            |> optional "conditions" (list conditionDecoder) []
+            |> required "actions" (list actionDecoder)
+    in
+        patternDecoder
+        |> Decode.andThen (\f -> Decode.map f basicRuleDecoder)
+
+type alias Ruleset =
+    { content : List Rule
+    , override : List Rule
+    , room : List Rule
+    , sender : List Rule
+    , underride : List Rule
+    }
+
+rulesetDecoder : Decoder Ruleset
+rulesetDecoder = Decode.succeed Ruleset
+    |> optional "content" (list ruleDecoder) []
+    |> optional "override" (list ruleDecoder) []
+    |> optional "room" (list ruleDecoder) []
+    |> optional "sender" (list ruleDecoder) []
+    |> optional "underride" (list ruleDecoder) []
+
+checkCondition : RoomEvent -> Condition -> Bool
+checkCondition re c =
+    let
+        pathDecoder xs p = 
+            Decode.at xs string 
+            |> Decode.map (String.contains p << String.toLower) 
+        matchesPattern xs p =
+            case Decode.decodeValue (pathDecoder xs p) (getContent re) of
+                Ok True -> True
+                _ -> False
+    in
+        case c of
+            EventMatch k p ->
+                case String.split "." k of
+                    "content"::xs -> matchesPattern xs p
+                    "type"::[] -> String.contains p <| getType re
+                    _ -> False
+            ContainsDisplayName -> False
+            RoomMemberCount _ -> False
+            SenderNotificationPermission _ -> False
+
+applyAction : Action -> List Action -> List Action
+applyAction a as_ =
+    case a of
+        Notify -> Notify :: List.filter (\a_ -> a_ /= DontNotify) as_
+        DontNotify -> DontNotify :: List.filter (\a_ -> a_ /= Notify) as_
+        Coalesce -> Coalesce :: List.filter (\a_ -> a_ /= DontNotify) as_
+        a_ -> a_ :: as_
+
+applyActions : List Action -> List Action -> List Action
+applyActions l r = List.foldl applyAction r l
+
+updatePushRuleActions : Rule -> RoomEvent -> List Action -> List Action
+updatePushRuleActions r re as_ =
+    if List.all (checkCondition re) r.conditions
+    then applyActions r.actions as_
+    else as_
+
+updatePushActions : List Rule -> RoomEvent -> List Action -> List Action
+updatePushActions rs re as_ =
+    List.filter .enabled rs
+    |> List.foldl (\r -> updatePushRuleActions r re) as_
+
+getPushActions : Ruleset -> RoomId -> RoomEvent -> List Action
+getPushActions rs rid re =
+    let
+        roomRules = List.filter (((==) rid) << .ruleId) rs.room
+        senderRules = List.filter (((==) <| getSender re) << .ruleId) rs.sender
+    in
+        updatePushActions rs.underride re []
+        |> updatePushActions senderRules re
+        |> updatePushActions roomRules re
+        |> updatePushActions rs.override re
+
+getEventNotification : Ruleset -> RoomId -> RoomEvent -> Bool
+getEventNotification rs rid re =
+    getPushActions rs rid re
+    |> List.member Notify