diff options
Diffstat (limited to 'tea-cleaner')
| -rw-r--r-- | tea-cleaner/Main.hs | 54 | ||||
| -rw-r--r-- | tea-cleaner/TeaCleaner/Client.hs | 45 | ||||
| -rw-r--r-- | tea-cleaner/TeaCleaner/CommandLine.hs | 45 | ||||
| -rw-r--r-- | tea-cleaner/TeaCleaner/Configuration.hs | 72 | ||||
| -rw-r--r-- | tea-cleaner/TeaCleaner/Filter.hs | 41 |
5 files changed, 161 insertions, 96 deletions
diff --git a/tea-cleaner/Main.hs b/tea-cleaner/Main.hs index 08c3b89..949d62a 100644 --- a/tea-cleaner/Main.hs +++ b/tea-cleaner/Main.hs @@ -2,30 +2,45 @@ module Main ( main ) where -import Data.Text (StrictText) import Data.Vector (Vector) import qualified Data.Text as Text -import Text.URI (URI, mkURI) 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 (filterByActivities, filterByUserProperties) +import TeaCleaner.Filter + ( UserFilter(..) + , FilterResult(..) + , filterByActivities + , filterByUserProperties + ) import TeaCleaner.Client (User(..), getUsers, purgeUser) -import TeaCleaner.CommandLine (ProgramOptions(..), commandLineInfo, execParser) +import TeaCleaner.Configuration + ( ProgramOptions(..) + , Settings(..) + , decodeSettingsFile + , commandLineInfo + , execParser + ) +import Control.Monad (when) -printUsers :: URI -> StrictText -> Bool -> Vector User -> IO () -printUsers server token liveRun users = printCount - >> Vector.forM_ users (printUser liveRun) +handleResults :: Settings -> Bool -> Vector User -> IO () +handleResults settings liveRun users = printCount + >> Vector.forM_ users (handleResult settings liveRun) where printCount = let count = Text.Builder.decimal $ Vector.length users in Text.Lazy.IO.putStrLn $ Text.Builder.toLazyText $ "Count: " <> count - buildValue user = getField @"username" user <> "\n" + +handleResult :: Settings -> Bool -> User -> IO () +handleResult settings liveRun user = Text.IO.putStrLn buildValue + >> when liveRun (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" @@ -34,14 +49,23 @@ printUsers server token liveRun users = printCount <> " Description: " <> getField @"description" user <> "\n" <> " Avatar: " <> getField @"avatarUrl" user <> "\n" <> "\n" - printUser True user = Text.IO.putStrLn (buildValue user) - >> purgeUser server token user - printUser False user = Text.IO.putStrLn (buildValue user) main :: IO () main = execParser commandLineInfo >>= withArguments where - withArguments ProgramOptions{..} = mkURI server >>= withServer liveRun token - withServer liveRun token server = getUsers server token - >>= Vector.filterM (filterByActivities server token) . Vector.filter filterByUserProperties - >>= printUsers server token liveRun + withArguments ProgramOptions{ liveRun } = decodeSettingsFile "config/tea-cleaner.toml" + >>= withSettings liveRun + +withSettings :: Bool -> Settings -> IO () +withSettings liveRun settings = getUsers settings + >>= Vector.foldM' foldFilterResult Vector.empty . fmap filterByUserProperties + >>= traverse (filterByActivities settings) + >>= Vector.foldM' foldFilterResult Vector.empty + >>= handleResults settings liveRun + where + foldFilterResult accumulator (FilterResult user SuspiciousFilter) + = pure $ Vector.snoc accumulator user + foldFilterResult accumulator (FilterResult _ PassFilter) = pure accumulator + foldFilterResult accumulator (FilterResult user FailedFilter) + = handleResult settings liveRun user + >> pure accumulator diff --git a/tea-cleaner/TeaCleaner/Client.hs b/tea-cleaner/TeaCleaner/Client.hs index af84514..5afd6a5 100644 --- a/tea-cleaner/TeaCleaner/Client.hs +++ b/tea-cleaner/TeaCleaner/Client.hs @@ -10,13 +10,17 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Text (StrictText) import qualified Data.Text.Encoding as Text.Encoding import Data.Vector (Vector) -import Text.URI (URI(..)) import qualified Text.URI as URI import qualified Text.URI.QQ as URI import Network.HTTP.Req ( DELETE(..) , GET(..) , NoReqBody(..) + , HttpMethod(..) + , HttpBody + , HttpResponse(..) + , HttpBodyAllowed + , ProvidesBody , defaultHttpConfig , ignoreResponse , jsonResponse @@ -31,6 +35,9 @@ import TeaCleaner.Options (jsonOptions) import Data.Int (Int64) import qualified Data.Aeson.TH as Aeson import Data.Time (ZonedTime(..)) +import TeaCleaner.Configuration (Settings(..)) +import Data.Data (Proxy) +import Text.URI (URI) data User = User { id :: Int64 @@ -75,8 +82,8 @@ data Activity = Activity $(Aeson.deriveJSON jsonOptions ''Activity) -purgeUser :: URI -> StrictText -> User -> IO () -purgeUser server token user = +purgeUser :: Settings -> User -> IO () +purgeUser Settings{..} user = let pathConstructor lastPiece = [URI.pathPiece|api|] :| [ [URI.pathPiece|v1|] , [URI.pathPiece|admin|] @@ -88,15 +95,10 @@ purgeUser server token user = <$> URI.mkPathPiece (getField @"username" user) , URI.uriQuery = [URI.QueryParam [URI.queryKey|purge|] [URI.queryValue|true|]] } - in case useHttpsURI uri of - Just (httpsURI, httpsOptions) -> fmap responseBody - $ runReq defaultHttpConfig - $ req DELETE httpsURI NoReqBody ignoreResponse - $ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token) - Nothing -> error "Invalid https URI" + in doRequest uri token DELETE NoReqBody ignoreResponse -getActivities :: URI -> StrictText -> User -> IO (Vector Activity) -getActivities server token user = +getActivities :: Settings -> User -> IO (Vector Activity) +getActivities Settings{..} user = let pathConstructor lastPiece = [URI.pathPiece|api|] :| [ [URI.pathPiece|v1|] , [URI.pathPiece|users|] @@ -109,15 +111,10 @@ getActivities server token user = <$> URI.mkPathPiece (getField @"username" user) , URI.uriQuery = [URI.QueryParam [URI.queryKey|purge|] [URI.queryValue|true|]] } - in case useHttpsURI uri of - Just (httpsURI, httpsOptions) -> fmap responseBody - $ runReq defaultHttpConfig - $ req GET httpsURI NoReqBody jsonResponse - $ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token) - Nothing -> error "Invalid https URI" + in doRequest uri token GET NoReqBody jsonResponse -getUsers :: URI -> StrictText -> IO (Vector User) -getUsers server token = +getUsers :: Settings -> IO (Vector User) +getUsers Settings{..} = let pathPieces = [URI.pathPiece|api|] :| [ [URI.pathPiece|v1|] , [URI.pathPiece|admin|] @@ -126,9 +123,15 @@ getUsers server token = uri = server { URI.uriPath = Just (False, pathPieces) } - in case useHttpsURI uri of + in doRequest uri token GET NoReqBody jsonResponse + +doRequest + :: (HttpMethod method, HttpBody body, HttpResponse response, HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) + => URI -> StrictText -> method -> body -> Proxy response -> IO (HttpResponseBody response) +doRequest uri token method body response = + case useHttpsURI uri of Just (httpsURI, httpsOptions) -> fmap responseBody $ runReq defaultHttpConfig - $ req GET httpsURI NoReqBody jsonResponse + $ req method httpsURI body response $ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token) Nothing -> error "Invalid https URI" diff --git a/tea-cleaner/TeaCleaner/CommandLine.hs b/tea-cleaner/TeaCleaner/CommandLine.hs deleted file mode 100644 index b74263d..0000000 --- a/tea-cleaner/TeaCleaner/CommandLine.hs +++ /dev/null @@ -1,45 +0,0 @@ -module TeaCleaner.CommandLine - ( ProgramOptions(..) - , commandLineInfo - , execParser - ) where - -import Data.Text (Text) -import Options.Applicative - ( Parser - , ParserInfo - , (<**>) - , argument - , execParser - , fullDesc - , help - , helper - , info - , long - , metavar - , progDesc - , str - , switch - ) - -data ProgramOptions = ProgramOptions - { server :: Text - , token :: Text - , liveRun :: Bool - } deriving (Eq, Show) - -commandLineInfo :: ParserInfo ProgramOptions -commandLineInfo = info (commandLine <**> helper) - $ fullDesc <> progDesc "Helps to detect some spam gitea accounts" - -commandLine :: Parser ProgramOptions -commandLine = ProgramOptions - <$> serverOption - <*> tokenOption - <*> liveRunOption - where - serverOption = argument str - $ metavar "SERVER" <> help "Gitea server URL" - tokenOption = argument str - $ metavar "TOKEN" <> help "Access token" - liveRunOption = switch $ long "live-run" <> help "Purge suspicious users" diff --git a/tea-cleaner/TeaCleaner/Configuration.hs b/tea-cleaner/TeaCleaner/Configuration.hs new file mode 100644 index 0000000..a7342d3 --- /dev/null +++ b/tea-cleaner/TeaCleaner/Configuration.hs @@ -0,0 +1,72 @@ +module TeaCleaner.Configuration + ( ProgramOptions(..) + , Settings(..) + , decodeSettingsFile + , commandLineInfo + , execParser + ) where + +import GHC.Records (HasField(..)) +import Data.Text (StrictText) +import qualified Toml +import Toml ((.=)) +import Options.Applicative + ( Parser + , ParserInfo + , (<**>) + , execParser + , fullDesc + , help + , helper + , info + , long + , progDesc + , switch + ) +import Text.URI (URI) +import qualified Text.URI as URI +import Data.Time (UTCTime(..), getCurrentTime) + +data ConfigFile = ConfigFile + { token :: StrictText + , server :: StrictText + } deriving (Eq, Show) + +configFileCodec :: Toml.TomlCodec ConfigFile +configFileCodec = ConfigFile + <$> Toml.text "token" .= getField @"token" + <*> Toml.text "server" .= getField @"server" + +data Settings = Settings + { token :: StrictText + , server :: URI + , now :: UTCTime + } deriving (Eq, Show) + +decodeSettingsFile :: FilePath -> IO Settings +decodeSettingsFile configPath = Toml.decodeFile configFileCodec configPath + >>= withConfiguration + where + withConfiguration configFile@ConfigFile{ server } = URI.mkURI server + >>= withServer configFile + withServer configFile parsedServer = getCurrentTime + >>= withTime configFile parsedServer + withTime ConfigFile{..} parsedServer now = pure $ Settings + { token = token + , server = parsedServer + , now = now + } + +newtype ProgramOptions = ProgramOptions + { liveRun :: Bool + } deriving (Eq, Show) + +commandLineInfo :: ParserInfo ProgramOptions +commandLineInfo = info (commandLine <**> helper) + $ fullDesc <> progDesc "Helps to detect some spam gitea accounts" + +commandLine :: Parser ProgramOptions +commandLine = ProgramOptions + <$> liveRunOption + where + liveRunOption = switch $ long "live-run" <> help "Purge suspicious users" diff --git a/tea-cleaner/TeaCleaner/Filter.hs b/tea-cleaner/TeaCleaner/Filter.hs index c4f243e..8448ff5 100644 --- a/tea-cleaner/TeaCleaner/Filter.hs +++ b/tea-cleaner/TeaCleaner/Filter.hs @@ -1,32 +1,43 @@ module TeaCleaner.Filter - ( filterByActivities + ( FilterResult(..) + , UserFilter(..) + , filterByActivities , filterByUserProperties ) where -import Data.Text (StrictText) import qualified Data.Text as Text import Data.Time (LocalTime(..), ZonedTime(..)) import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) import qualified Data.Vector as Vector -import Text.URI (URI) import TeaCleaner.Client (Activity(..), User(..), getActivities) +import TeaCleaner.Configuration (Settings(..)) -filterByUserProperties :: User -> Bool -filterByUserProperties User{ created, lastLogin, description, website } - = zonedDay created == zonedDay lastLogin - && zonedDay created > fromOrdinalDate 2024 1 - && zonedDay created < fromOrdinalDate 2025 17 - && not (Text.null description) - && not (Text.null website) +data UserFilter + = PassFilter + | SuspiciousFilter + | FailedFilter + deriving (Eq, Show) + +data FilterResult = FilterResult User UserFilter + deriving (Show) + +filterByUserProperties :: User -> FilterResult +filterByUserProperties user@User{ created, lastLogin, description, website } + | zonedDay created == zonedDay lastLogin + , zonedDay created > fromOrdinalDate 2024 1 + , zonedDay created < fromOrdinalDate 2025 17 + , not (Text.null description) + , not (Text.null website) = FilterResult user SuspiciousFilter + | otherwise = FilterResult user PassFilter where zonedDay = localDay . zonedTimeToLocalTime -filterByActivities :: URI -> StrictText -> User -> IO Bool -filterByActivities server token user - = getActivities server token user +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 = pure $ opType == "create_repo" - evalActivities _ = pure False + , Vector.null rest + , opType == "create_repo" = pure $ FilterResult user SuspiciousFilter + evalActivities _ = pure $ FilterResult user PassFilter |