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