64 lines
2.6 KiB
Haskell
64 lines
2.6 KiB
Haskell
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
|
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
|
obtain one at https://mozilla.org/MPL/2.0/. -}
|
|
|
|
module TeaCleaner.Filter
|
|
( FilterResult(..)
|
|
, UserFilter(..)
|
|
, filterByActivities
|
|
, filterByUserProperties
|
|
) where
|
|
|
|
import qualified Data.Text as Text
|
|
import Data.Time (LocalTime(..), ZonedTime(..), UTCTime(..), addUTCTime)
|
|
import qualified Data.Vector as Vector
|
|
import TeaCleaner.Client (Activity(..), User(..), getActivities)
|
|
import TeaCleaner.Configuration (Settings(..))
|
|
import GHC.Records (HasField(..))
|
|
|
|
data UserFilter
|
|
= PassFilter
|
|
| SuspiciousFilter
|
|
| FailedFilter
|
|
deriving (Eq, Show)
|
|
|
|
data FilterResult = FilterResult User UserFilter
|
|
deriving (Show)
|
|
|
|
filterByUserProperties :: Settings -> User -> FilterResult
|
|
filterByUserProperties settings user@User{ created, lastLogin }
|
|
| noLoginSinceRegistration = FilterResult user FailedFilter
|
|
| containsSpamWords = FilterResult user FailedFilter
|
|
| percentEncodedWebsite = FilterResult user FailedFilter
|
|
| hasFullDescription = FilterResult user SuspiciousFilter
|
|
| unusualMailDomains = FilterResult user SuspiciousFilter
|
|
| otherwise = FilterResult user PassFilter
|
|
where
|
|
percentEncodedWebsite = Text.elem '%' $ getField @"website" user
|
|
unusualMailDomains =
|
|
let predicate = (`Text.isSuffixOf` getField @"email" user)
|
|
in any predicate (getField @"mailDomains" settings)
|
|
containsSpamWords =
|
|
let lowerCaseDescription = Text.toLower $ getField @"description" user
|
|
lowerCaseWebsite = Text.toLower $ getField @"website" user
|
|
predicate word = Text.isInfixOf word lowerCaseWebsite
|
|
|| Text.isInfixOf word lowerCaseDescription
|
|
in any predicate (getField @"spamWords" settings)
|
|
hasFullDescription
|
|
= not (Text.null $ getField @"description" user)
|
|
&& not (Text.null $ getField @"website" user)
|
|
noLoginSinceRegistration =
|
|
let monthAgo = utctDay $ addUTCTime (-2592000) $ getField @"now" settings
|
|
in zonedDay created < monthAgo && zonedDay created == zonedDay lastLogin
|
|
zonedDay = localDay . zonedTimeToLocalTime
|
|
|
|
filterByActivities :: Settings -> User -> IO FilterResult
|
|
filterByActivities settings user = getActivities settings user
|
|
>>= evalActivities
|
|
where
|
|
evalActivities activities
|
|
| Just (Activity{ opType }, rest) <- Vector.uncons activities
|
|
, Vector.null rest
|
|
, opType == "create_repo" = pure $ FilterResult user FailedFilter
|
|
evalActivities _ = pure $ FilterResult user PassFilter
|