tea-cleaner: Make no login period configurable
This commit is contained in:
		| @@ -91,8 +91,8 @@ See `tea-cleaner.toml.dist` for a description of the available configuration. | ||||
| Copy this file to `config/tea-cleaner.toml` and change at least `token` and | ||||
| `server` values. After that if you just run `tea-cleaner` it will give a list | ||||
| of user accounts which look suspicious to it. Rerunning the command with the | ||||
| `--live-run` flag will purge the listed accounts and all their activities, | ||||
| assuming the given token has amdinistrative access to the Gitea instance. | ||||
| `--live` flag will purge the listed accounts and all their activities, assuming | ||||
| the given token has amdinistrative access to the Gitea instance. | ||||
|  | ||||
| Run `tea-cleanr --help` to see all available command line options.  | ||||
|  | ||||
|   | ||||
| @@ -13,3 +13,5 @@ mail_domains = [ | ||||
|   ".shop", | ||||
|   ".website" | ||||
| ] | ||||
| # If the user hasn't logged in since the registration for this amount of days, remove his account. | ||||
| no_login = 30 | ||||
|   | ||||
| @@ -42,20 +42,20 @@ printStatistics Settings{ statistics } = | ||||
|             $ "Count: " <> count' | ||||
|  | ||||
| handleResults :: Settings -> Bool -> Vector FilterResult -> IO (Vector User) | ||||
| handleResults settings liveRun = | ||||
| handleResults settings live = | ||||
|     Vector.foldM' handleResult Vector.empty | ||||
|   where | ||||
|     handleResult accumulator (FilterResult user FailedFilter) | ||||
|         = handleFailedFilter settings liveRun user | ||||
|         = handleFailedFilter settings live user | ||||
|         >> pure accumulator | ||||
|     handleResult accumulator (FilterResult _ PassFilter) = pure accumulator | ||||
|     handleResult accumulator (FilterResult user SuspiciousFilter) = pure | ||||
|         $ Vector.snoc accumulator user | ||||
|  | ||||
| handleFailedFilter :: Settings -> Bool -> User -> IO () | ||||
| handleFailedFilter settings liveRun user = Text.IO.putStrLn buildValue | ||||
| handleFailedFilter settings live user = Text.IO.putStrLn buildValue | ||||
|     >> modifyIORef (getField @"statistics" settings) (+ 1) | ||||
|     >> when liveRun (purgeUser settings user) | ||||
|     >> when live (purgeUser settings user) | ||||
|   where | ||||
|     buildValue = getField @"username" user <> "\n" | ||||
|         <> "  Website: " <> getField @"website" user <> "\n" | ||||
| @@ -70,12 +70,12 @@ handleFailedFilter settings liveRun user = Text.IO.putStrLn buildValue | ||||
| main :: IO () | ||||
| main = execParser commandLineInfo >>= withArguments | ||||
|   where | ||||
|     withArguments ProgramOptions{ liveRun } = decodeSettingsFile "config/tea-cleaner.toml" | ||||
|         >>= withSettings liveRun | ||||
|     withArguments ProgramOptions{ live } = decodeSettingsFile "config/tea-cleaner.toml" | ||||
|         >>= withSettings live | ||||
|  | ||||
| withSettings :: Bool -> Settings -> IO () | ||||
| withSettings liveRun settings = getUsers settings | ||||
|     >>= handleResults settings liveRun . fmap (filterByUserProperties settings) | ||||
| withSettings live settings = getUsers settings | ||||
|     >>= handleResults settings live . fmap (filterByUserProperties settings) | ||||
|     >>= traverse (filterByActivities settings) | ||||
|     >>= handleResults settings liveRun | ||||
|     >>= handleResults settings live | ||||
|     >> printStatistics settings | ||||
|   | ||||
| @@ -37,6 +37,7 @@ data ConfigFile = ConfigFile | ||||
|     , server :: StrictText | ||||
|     , spamWords :: [StrictText] | ||||
|     , mailDomains :: [StrictText] | ||||
|     , noLogin :: Word | ||||
|     } deriving (Eq, Show) | ||||
|  | ||||
| configFileCodec :: Toml.TomlCodec ConfigFile | ||||
| @@ -45,6 +46,7 @@ configFileCodec = ConfigFile | ||||
|     <*> Toml.text "server" .= getField @"server" | ||||
|     <*> Toml.arrayOf Toml._Text "spam_words" .= getField @"spamWords" | ||||
|     <*> Toml.arrayOf Toml._Text "mail_domains" .= getField @"mailDomains" | ||||
|     <*> Toml.word "no_login" .= getField @"noLogin" | ||||
|  | ||||
| data Settings = Settings | ||||
|     { token :: StrictText | ||||
| @@ -53,6 +55,7 @@ data Settings = Settings | ||||
|     , spamWords :: [StrictText] | ||||
|     , mailDomains :: [StrictText] | ||||
|     , statistics :: IORef Int | ||||
|     , noLogin :: Word | ||||
|     } deriving Eq | ||||
|  | ||||
| decodeSettingsFile :: FilePath -> IO Settings | ||||
| @@ -67,11 +70,12 @@ decodeSettingsFile configPath = do | ||||
|         , now = now | ||||
|         , spamWords = spamWords | ||||
|         , mailDomains = mailDomains | ||||
|         , noLogin = noLogin | ||||
|         , statistics = ioRef | ||||
|         } | ||||
|  | ||||
| newtype ProgramOptions = ProgramOptions | ||||
|     { liveRun :: Bool | ||||
|     { live :: Bool | ||||
|     } deriving (Eq, Show) | ||||
|  | ||||
| commandLineInfo :: ParserInfo ProgramOptions | ||||
| @@ -80,6 +84,4 @@ commandLineInfo = info (commandLine <**> helper) | ||||
|  | ||||
| commandLine :: Parser ProgramOptions | ||||
| commandLine = ProgramOptions | ||||
|     <$> liveRunOption | ||||
|   where | ||||
|     liveRunOption = switch $ long "live-run" <> help "Purge suspicious users" | ||||
|     <$> switch (long "live" <> help "Purge suspicious users") | ||||
|   | ||||
| @@ -48,8 +48,9 @@ filterByUserProperties settings user@User{ created, lastLogin } | ||||
|         = 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 | ||||
|         let period = fromIntegral (getField @"noLogin" settings) * (-3600) * 24 | ||||
|             periodAgo = utctDay $ addUTCTime period $ getField @"now" settings | ||||
|          in zonedDay created < periodAgo && zonedDay created == zonedDay lastLogin | ||||
|     zonedDay = localDay . zonedTimeToLocalTime | ||||
|  | ||||
| filterByActivities :: Settings -> User -> IO FilterResult | ||||
|   | ||||
		Reference in New Issue
	
	Block a user