82 lines
3.0 KiB
Haskell
82 lines
3.0 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 Main
|
|
( main
|
|
) where
|
|
|
|
import Data.Vector (Vector)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Vector as Vector
|
|
import qualified Data.Text.IO as Text.IO
|
|
import qualified Data.Text.Lazy.IO as Text.Lazy.IO
|
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
|
import GHC.Records (HasField(..))
|
|
import TeaCleaner.Filter
|
|
( UserFilter(..)
|
|
, FilterResult(..)
|
|
, filterByActivities
|
|
, filterByUserProperties
|
|
)
|
|
import TeaCleaner.Client (User(..), getUsers, purgeUser)
|
|
import TeaCleaner.Configuration
|
|
( ProgramOptions(..)
|
|
, Settings(..)
|
|
, decodeSettingsFile
|
|
, commandLineInfo
|
|
, execParser
|
|
)
|
|
import Control.Monad (when)
|
|
import Data.IORef (modifyIORef, readIORef)
|
|
|
|
printStatistics :: Settings -> IO ()
|
|
printStatistics Settings{ statistics } =
|
|
readIORef statistics >>= printCount
|
|
where
|
|
printCount count =
|
|
let count' = Text.Builder.decimal count
|
|
in Text.Lazy.IO.putStrLn
|
|
$ Text.Builder.toLazyText
|
|
$ "Count: " <> count'
|
|
|
|
handleResults :: Settings -> Bool -> Vector FilterResult -> IO (Vector User)
|
|
handleResults settings live =
|
|
Vector.foldM' handleResult Vector.empty
|
|
where
|
|
handleResult accumulator (FilterResult user FailedFilter)
|
|
= 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 live user = Text.IO.putStrLn buildValue
|
|
>> modifyIORef (getField @"statistics" settings) (+ 1)
|
|
>> when live (purgeUser settings user)
|
|
where
|
|
buildValue = getField @"username" user <> "\n"
|
|
<> " Website: " <> getField @"website" user <> "\n"
|
|
<> " Created: " <> Text.pack (show $ getField @"created" user) <> "\n"
|
|
<> " Last login: " <> Text.pack (show $ getField @"lastLogin" user) <> "\n"
|
|
<> " Email: " <> getField @"email" user <> "\n"
|
|
<> " Website: " <> getField @"website" user <> "\n"
|
|
<> " Description: " <> getField @"description" user <> "\n"
|
|
<> " Avatar: " <> getField @"avatarUrl" user <> "\n"
|
|
<> "\n"
|
|
|
|
main :: IO ()
|
|
main = execParser commandLineInfo >>= withArguments
|
|
where
|
|
withArguments ProgramOptions{ live } = decodeSettingsFile "config/tea-cleaner.toml"
|
|
>>= withSettings live
|
|
|
|
withSettings :: Bool -> Settings -> IO ()
|
|
withSettings live settings = getUsers settings
|
|
>>= handleResults settings live . fmap (filterByUserProperties settings)
|
|
>>= traverse (filterByActivities settings)
|
|
>>= handleResults settings live
|
|
>> printStatistics settings
|