{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}

-- | Events filtering implementation
module MatrixBot.Bot.EventsListener.Filters
  ( UsersFilter
  , filterByUser

  , RoomsFilter
  , filterByRoom

  , MediaMsgtypeFilter
  , MediaMsgtype (..)
  , filterByMediaMsgtype
  ) where

import qualified Control.Monad.Trans.Except as Except
import Data.Text (Text, pack)
import qualified MatrixBot.SharedTypes as T
import qualified Data.List.NonEmpty as NE
import qualified MatrixBot.Log as L
import qualified Control.Monad.Logger as ML
import qualified MatrixBot.MatrixApi as Api
import GHC.Generics (Generic)
import qualified Data.Aeson as J
import Data.List (find)


type UsersFilter = NE.NonEmpty T.Mxid

filterByUser
  ∷ ML.MonadLogger m
  ⇒ Maybe UsersFilter
  -- ^ Whitelisted user IDs
  → T.Mxid
  -- ^ Current user ID
  → Except.ExceptT Text m ()
filterByUser :: forall (m :: * -> *).
MonadLogger m =>
Maybe UsersFilter -> Mxid -> ExceptT Text m ()
filterByUser Maybe UsersFilter
usersFilter Mxid
userId =
  case Maybe UsersFilter
usersFilter of
    Maybe UsersFilter
Nothing →
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"There is no user filter"
        , Text
" (filter passed)"
        ]
    Just UsersFilter
x | Mxid
userId Mxid -> UsersFilter -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` UsersFilter
x →
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"User ", Mxid -> Text
T.printMxid Mxid
userId
        , Text
" is one of these: ", (String -> Text
pack (String -> Text) -> (UsersFilter -> String) -> UsersFilter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsersFilter -> String
forall a. Show a => a -> String
show) UsersFilter
x
        , Text
" (filter passed)"
        ]
    Just UsersFilter
x →
      Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"User ", Mxid -> Text
T.printMxid Mxid
userId
        , Text
" is not one of these: ", (String -> Text
pack (String -> Text) -> (UsersFilter -> String) -> UsersFilter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsersFilter -> String
forall a. Show a => a -> String
show) UsersFilter
x
        , Text
" (filter not passed)"
        ]


type RoomsFilter = NE.NonEmpty T.RoomId

filterByRoom
  ∷ ML.MonadLogger m
  ⇒ Maybe RoomsFilter
  -- ^ Whitelisted room IDs
  → T.RoomId
  -- ^ Current room ID
  → Except.ExceptT Text m ()
filterByRoom :: forall (m :: * -> *).
MonadLogger m =>
Maybe RoomsFilter -> RoomId -> ExceptT Text m ()
filterByRoom Maybe RoomsFilter
roomsFilter RoomId
roomId =
  case Maybe RoomsFilter
roomsFilter of
    Maybe RoomsFilter
Nothing →
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"There is no room filter"
        , Text
" (filter passed)"
        ]
    Just RoomsFilter
x | RoomId
roomId RoomId -> RoomsFilter -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RoomsFilter
x →
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Room ", RoomId -> Text
T.printRoomId RoomId
roomId
        , Text
" is one of these: ", (String -> Text
pack (String -> Text) -> (RoomsFilter -> String) -> RoomsFilter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomsFilter -> String
forall a. Show a => a -> String
show) RoomsFilter
x
        , Text
" (filter passed)"
        ]
    Just RoomsFilter
x →
      Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Room ", RoomId -> Text
T.printRoomId RoomId
roomId
        , Text
" is not one of these: ", (String -> Text
pack (String -> Text) -> (RoomsFilter -> String) -> RoomsFilter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomsFilter -> String
forall a. Show a => a -> String
show) RoomsFilter
x
        , Text
" (filter not passed)"
        ]


type MediaMsgtypeFilter = NE.NonEmpty MediaMsgtype

data MediaMsgtype
  = MediaMsgtype_File
  | MediaMsgtype_Image
  | MediaMsgtype_Video
  | MediaMsgtype_Audio
  deriving stock ((forall x. MediaMsgtype -> Rep MediaMsgtype x)
-> (forall x. Rep MediaMsgtype x -> MediaMsgtype)
-> Generic MediaMsgtype
forall x. Rep MediaMsgtype x -> MediaMsgtype
forall x. MediaMsgtype -> Rep MediaMsgtype x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MediaMsgtype -> Rep MediaMsgtype x
from :: forall x. MediaMsgtype -> Rep MediaMsgtype x
$cto :: forall x. Rep MediaMsgtype x -> MediaMsgtype
to :: forall x. Rep MediaMsgtype x -> MediaMsgtype
Generic, MediaMsgtype -> MediaMsgtype -> Bool
(MediaMsgtype -> MediaMsgtype -> Bool)
-> (MediaMsgtype -> MediaMsgtype -> Bool) -> Eq MediaMsgtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MediaMsgtype -> MediaMsgtype -> Bool
== :: MediaMsgtype -> MediaMsgtype -> Bool
$c/= :: MediaMsgtype -> MediaMsgtype -> Bool
/= :: MediaMsgtype -> MediaMsgtype -> Bool
Eq, Int -> MediaMsgtype -> ShowS
[MediaMsgtype] -> ShowS
MediaMsgtype -> String
(Int -> MediaMsgtype -> ShowS)
-> (MediaMsgtype -> String)
-> ([MediaMsgtype] -> ShowS)
-> Show MediaMsgtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MediaMsgtype -> ShowS
showsPrec :: Int -> MediaMsgtype -> ShowS
$cshow :: MediaMsgtype -> String
show :: MediaMsgtype -> String
$cshowList :: [MediaMsgtype] -> ShowS
showList :: [MediaMsgtype] -> ShowS
Show, MediaMsgtype
MediaMsgtype -> MediaMsgtype -> Bounded MediaMsgtype
forall a. a -> a -> Bounded a
$cminBound :: MediaMsgtype
minBound :: MediaMsgtype
$cmaxBound :: MediaMsgtype
maxBound :: MediaMsgtype
Bounded, Int -> MediaMsgtype
MediaMsgtype -> Int
MediaMsgtype -> [MediaMsgtype]
MediaMsgtype -> MediaMsgtype
MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
MediaMsgtype -> MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
(MediaMsgtype -> MediaMsgtype)
-> (MediaMsgtype -> MediaMsgtype)
-> (Int -> MediaMsgtype)
-> (MediaMsgtype -> Int)
-> (MediaMsgtype -> [MediaMsgtype])
-> (MediaMsgtype -> MediaMsgtype -> [MediaMsgtype])
-> (MediaMsgtype -> MediaMsgtype -> [MediaMsgtype])
-> (MediaMsgtype -> MediaMsgtype -> MediaMsgtype -> [MediaMsgtype])
-> Enum MediaMsgtype
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MediaMsgtype -> MediaMsgtype
succ :: MediaMsgtype -> MediaMsgtype
$cpred :: MediaMsgtype -> MediaMsgtype
pred :: MediaMsgtype -> MediaMsgtype
$ctoEnum :: Int -> MediaMsgtype
toEnum :: Int -> MediaMsgtype
$cfromEnum :: MediaMsgtype -> Int
fromEnum :: MediaMsgtype -> Int
$cenumFrom :: MediaMsgtype -> [MediaMsgtype]
enumFrom :: MediaMsgtype -> [MediaMsgtype]
$cenumFromThen :: MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
enumFromThen :: MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
$cenumFromTo :: MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
enumFromTo :: MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
$cenumFromThenTo :: MediaMsgtype -> MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
enumFromThenTo :: MediaMsgtype -> MediaMsgtype -> MediaMsgtype -> [MediaMsgtype]
Enum)

instance J.ToJSON MediaMsgtype where
  toJSON :: MediaMsgtype -> Value
toJSON MediaMsgtype
x = Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case MediaMsgtype
x of
    MediaMsgtype
MediaMsgtype_File → MFileType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString MFileType
Api.MFileType
    MediaMsgtype
MediaMsgtype_Image → MImageType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString MImageType
Api.MImageType
    MediaMsgtype
MediaMsgtype_Video → MVideoType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString MVideoType
Api.MVideoType
    MediaMsgtype
MediaMsgtype_Audio → MAudioType -> Text
forall a. MsgtypeString a => a -> Text
Api.msgtypeString MAudioType
Api.MAudioType

instance J.FromJSON MediaMsgtype where
  parseJSON :: Value -> Parser MediaMsgtype
parseJSON Value
jsonValue =
    Parser MediaMsgtype
-> (MediaMsgtype -> Parser MediaMsgtype)
-> Maybe MediaMsgtype
-> Parser MediaMsgtype
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (String -> Parser MediaMsgtype
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MediaMsgtype) -> String -> Parser MediaMsgtype
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse MediaMsgtype from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
jsonValue)
      MediaMsgtype -> Parser MediaMsgtype
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ((MediaMsgtype -> Bool) -> [MediaMsgtype] -> Maybe MediaMsgtype
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Value
jsonValue Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
==) (Value -> Bool) -> (MediaMsgtype -> Value) -> MediaMsgtype -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaMsgtype -> Value
forall a. ToJSON a => a -> Value
J.toJSON) [MediaMsgtype
forall a. Bounded a => a
minBound .. MediaMsgtype
forall a. Bounded a => a
maxBound ∷ MediaMsgtype])

clientEventContentToMediaMsgtype
  ∷ Api.MRoomMessageClientEventContent
  → Maybe MediaMsgtype
clientEventContentToMediaMsgtype :: MRoomMessageClientEventContent -> Maybe MediaMsgtype
clientEventContentToMediaMsgtype = \case
  Api.MRoomMessageClientEventContentMImage MRoomMessageMImageMsgtypeClientEventContent
_ → MediaMsgtype -> Maybe MediaMsgtype
forall a. a -> Maybe a
Just MediaMsgtype
MediaMsgtype_Image
  Api.MRoomMessageClientEventContentMVideo MRoomMessageMVideoMsgtypeClientEventContent
_ → MediaMsgtype -> Maybe MediaMsgtype
forall a. a -> Maybe a
Just MediaMsgtype
MediaMsgtype_Video
  Api.MRoomMessageClientEventContentMAudio MRoomMessageMAudioMsgtypeClientEventContent
_ → MediaMsgtype -> Maybe MediaMsgtype
forall a. a -> Maybe a
Just MediaMsgtype
MediaMsgtype_Audio
  Api.MRoomMessageClientEventContentMFile MRoomMessageMFileMsgtypeClientEventContent
_ → MediaMsgtype -> Maybe MediaMsgtype
forall a. a -> Maybe a
Just MediaMsgtype
MediaMsgtype_File
  Api.MRoomMessageClientEventContentMText MRoomMessageMTextMsgtypeClientEventContent
_ → Maybe MediaMsgtype
forall a. Maybe a
Nothing
  Api.MRoomMessageClientEventContentOther Object
_ → Maybe MediaMsgtype
forall a. Maybe a
Nothing


filterByMediaMsgtype
  ∷ ML.MonadLogger m
  ⇒ Maybe MediaMsgtypeFilter
  -- ^ Whitelisted @msgtype@s
  → Api.MRoomMessageClientEventContent
  → Except.ExceptT Text m ()
filterByMediaMsgtype :: forall (m :: * -> *).
MonadLogger m =>
Maybe MediaMsgtypeFilter
-> MRoomMessageClientEventContent -> ExceptT Text m ()
filterByMediaMsgtype Maybe MediaMsgtypeFilter
filterList (MRoomMessageClientEventContent -> Maybe MediaMsgtype
clientEventContentToMediaMsgtype → Maybe MediaMsgtype
mediaMsgType) =
  case (Maybe MediaMsgtypeFilter
filterList, Maybe MediaMsgtype
mediaMsgType) of
    (Maybe MediaMsgtypeFilter
Nothing, Maybe MediaMsgtype
_) →
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"There is no “msgtype” media filter"
        , Text
" (filter passed)"
        ]
    (Just MediaMsgtypeFilter
x, Just MediaMsgtype
y) | MediaMsgtype
y MediaMsgtype -> MediaMsgtypeFilter -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` MediaMsgtypeFilter
x →
      Text -> ExceptT Text m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Media “msgtype” ", (String -> Text
pack (String -> Text)
-> (MediaMsgtype -> String) -> MediaMsgtype -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaMsgtype -> String
forall a. Show a => a -> String
show) MediaMsgtype
y
        , Text
" is one of these: ", (String -> Text
pack (String -> Text)
-> (MediaMsgtypeFilter -> String) -> MediaMsgtypeFilter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaMsgtypeFilter -> String
forall a. Show a => a -> String
show) MediaMsgtypeFilter
x
        , Text
" (filter passed)"
        ]
    (Just MediaMsgtypeFilter
_, Maybe MediaMsgtype
Nothing) →
      Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"“msgtype” is not one of the media types"
        , Text
" (filter not passed)"
        ]
    (Just MediaMsgtypeFilter
x, Just MediaMsgtype
y) →
      Text -> ExceptT Text m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (Text -> ExceptT Text m ()) -> Text -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Media “msgtype” ", (String -> Text
pack (String -> Text)
-> (MediaMsgtype -> String) -> MediaMsgtype -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaMsgtype -> String
forall a. Show a => a -> String
show) MediaMsgtype
y
        , Text
" is not one of these: ", (String -> Text
pack (String -> Text)
-> (MediaMsgtypeFilter -> String) -> MediaMsgtypeFilter -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaMsgtypeFilter -> String
forall a. Show a => a -> String
show) MediaMsgtypeFilter
x
        , Text
" (filter not passed)"
        ]