tea-cleaner: Make no login period configurable

5 files changed, 22 insertions, 17 deletions

diff --git a/README.md b/README.md
index dad374e..5a2a4a2 100644
--- a/README.md
+++ b/README.md
@@ -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. 
 
diff --git a/config/tea-cleaner.toml.dist b/config/tea-cleaner.toml.dist
index 5a77089..73eab52 100644
--- a/config/tea-cleaner.toml.dist
+++ b/config/tea-cleaner.toml.dist
@@ -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
diff --git a/tea-cleaner/Main.hs b/tea-cleaner/Main.hs
index 5433394..e8eea68 100644
--- a/tea-cleaner/Main.hs
+++ b/tea-cleaner/Main.hs
@@ -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
diff --git a/tea-cleaner/TeaCleaner/Configuration.hs b/tea-cleaner/TeaCleaner/Configuration.hs
index dad1450..b958264 100644
--- a/tea-cleaner/TeaCleaner/Configuration.hs
+++ b/tea-cleaner/TeaCleaner/Configuration.hs
@@ -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")
diff --git a/tea-cleaner/TeaCleaner/Filter.hs b/tea-cleaner/TeaCleaner/Filter.hs
index 434825a..f7d3315 100644
--- a/tea-cleaner/TeaCleaner/Filter.hs
+++ b/tea-cleaner/TeaCleaner/Filter.hs
@@ -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