From 6c170513a69bd4c49b006d0672637a48eb449884 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 26 Jan 2025 10:17:33 +0100 Subject: [PATCH] tea-cleaner: Add command line parser --- kazbek.cabal | 7 ++- tea-cleaner/Main.hs | 74 +++++++++------------------ tea-cleaner/TeaCleaner/Client.hs | 73 +++++++++++++++++++++----- tea-cleaner/TeaCleaner/CommandLine.hs | 45 ++++++++++++++++ tea-cleaner/TeaCleaner/Filter.hs | 32 ++++++++++++ tea-cleaner/TeaCleaner/Types.hs | 53 ------------------- 6 files changed, 168 insertions(+), 116 deletions(-) create mode 100644 tea-cleaner/TeaCleaner/CommandLine.hs create mode 100644 tea-cleaner/TeaCleaner/Filter.hs delete mode 100644 tea-cleaner/TeaCleaner/Types.hs diff --git a/kazbek.cabal b/kazbek.cabal index 071ff75..e1ae496 100644 --- a/kazbek.cabal +++ b/kazbek.cabal @@ -19,16 +19,19 @@ executable tea-cleaner TemplateHaskell, OverloadedStrings, QuasiQuotes, - DuplicateRecordFields + DuplicateRecordFields, + RecordWildCards other-modules: TeaCleaner.Client + TeaCleaner.CommandLine + TeaCleaner.Filter TeaCleaner.Options - TeaCleaner.Types build-depends: aeson ^>= 2.2.3, base ^>=4.20.0.0, bytestring ^>= 0.12.2, modern-uri ^>= 0.3.6, + optparse-applicative ^>= 0.18.1, req ^>= 3.13, time >= 1.9 && < 2, text ^>= 2.1, diff --git a/tea-cleaner/Main.hs b/tea-cleaner/Main.hs index bfad0f7..08c3b89 100644 --- a/tea-cleaner/Main.hs +++ b/tea-cleaner/Main.hs @@ -2,70 +2,46 @@ module Main ( main ) where +import Data.Text (StrictText) import Data.Vector (Vector) import qualified Data.Text as Text -import System.Environment (getArgs) -import qualified Text.URI as URI -import Data.Time (LocalTime(..), ZonedTime(..)) +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 Data.Time.Calendar.OrdinalDate (fromOrdinalDate) -import TeaCleaner.Types (Activity(..), User(..)) -import TeaCleaner.Client (getActivities, getUsers, purgeUser) +import TeaCleaner.Filter (filterByActivities, filterByUserProperties) +import TeaCleaner.Client (User(..), getUsers, purgeUser) +import TeaCleaner.CommandLine (ProgramOptions(..), commandLineInfo, execParser) -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) - where - zonedDay = localDay . zonedTimeToLocalTime - -filterByActivities :: String -> URI.URI -> User -> IO Bool -filterByActivities server token user - = getActivities server token user - >>= evalActivities - where - evalActivities activities - | Just (Activity{ opType }, rest) <- Vector.uncons activities - , Vector.null rest = pure $ opType == "create_repo" - evalActivities _ = pure False - -printUsers :: String -> URI.URI -> Vector User -> IO () -printUsers server token users = printCount - >> Vector.forM_ users printUser +printUsers :: URI -> StrictText -> Bool -> Vector User -> IO () +printUsers server token liveRun users = printCount + >> Vector.forM_ users (printUser liveRun) where printCount = let count = Text.Builder.decimal $ Vector.length users in Text.Lazy.IO.putStrLn $ Text.Builder.toLazyText $ "Count: " <> count - printUser user = - let value - = " 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" - in Text.IO.putStrLn (getField @"username" user <> "\n" <> value) - >> purgeUser server token user + buildValue user = 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" + printUser True user = Text.IO.putStrLn (buildValue user) + >> purgeUser server token user + printUser False user = Text.IO.putStrLn (buildValue user) main :: IO () -main = getArgs >>= withArguments +main = execParser commandLineInfo >>= withArguments where - withArguments [server, token] - = URI.mkURI (Text.pack server) - >>= withServer token - withArguments _ = putStrLn "Expected exactly two arguments: server URL and the access token." - withServer token server = getUsers token server - >>= Vector.filterM (filterByActivities token server) . Vector.filter filterByUserProperties - >>= printUsers token server + 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 diff --git a/tea-cleaner/TeaCleaner/Client.hs b/tea-cleaner/TeaCleaner/Client.hs index 1556be6..af84514 100644 --- a/tea-cleaner/TeaCleaner/Client.hs +++ b/tea-cleaner/TeaCleaner/Client.hs @@ -1,16 +1,18 @@ module TeaCleaner.Client - ( getActivities + ( Activity(..) + , User(..) + , getActivities , getUsers , purgeUser ) where 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 TeaCleaner.Types (Activity(..), User(..)) -import qualified Data.ByteString.Char8 as Char8 import Network.HTTP.Req ( DELETE(..) , GET(..) @@ -25,9 +27,56 @@ import Network.HTTP.Req , useHttpsURI ) import GHC.Records (HasField(..)) +import TeaCleaner.Options (jsonOptions) +import Data.Int (Int64) +import qualified Data.Aeson.TH as Aeson +import Data.Time (ZonedTime(..)) -purgeUser :: String -> URI -> User -> IO () -purgeUser token server user = +data User = User + { id :: Int64 + , login :: StrictText + , loginName :: StrictText + , fullName :: StrictText + , email :: StrictText + , avatarUrl :: StrictText + , language :: StrictText + , isAdmin :: Bool + , lastLogin :: ZonedTime + , created :: ZonedTime + , restricted :: Bool + , active :: Bool + , prohibitLogin :: Bool + , location :: StrictText + , website :: StrictText + , description :: StrictText + , visibility :: StrictText + , followersCount :: Int + , followingCount :: Int + , starredReposCount :: Int + , username :: StrictText + } deriving (Show) + +$(Aeson.deriveJSON jsonOptions ''User) + +data Activity = Activity + { actUserId :: Int64 + -- , comment Comment + , commentId :: Int64 + , content :: StrictText + , created :: ZonedTime + , id :: Int64 + , isPrivate :: Bool + , opType :: StrictText + , refName :: StrictText + -- repo Repository{...} + , repoId :: Int64 + , userId :: Int64 + } deriving (Show) + +$(Aeson.deriveJSON jsonOptions ''Activity) + +purgeUser :: URI -> StrictText -> User -> IO () +purgeUser server token user = let pathConstructor lastPiece = [URI.pathPiece|api|] :| [ [URI.pathPiece|v1|] , [URI.pathPiece|admin|] @@ -43,11 +92,11 @@ purgeUser token server user = Just (httpsURI, httpsOptions) -> fmap responseBody $ runReq defaultHttpConfig $ req DELETE httpsURI NoReqBody ignoreResponse - $ httpsOptions <> oAuth2Bearer (Char8.pack token) + $ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token) Nothing -> error "Invalid https URI" -getActivities :: String -> URI -> User -> IO (Vector Activity) -getActivities token server user = +getActivities :: URI -> StrictText -> User -> IO (Vector Activity) +getActivities server token user = let pathConstructor lastPiece = [URI.pathPiece|api|] :| [ [URI.pathPiece|v1|] , [URI.pathPiece|users|] @@ -64,11 +113,11 @@ getActivities token server user = Just (httpsURI, httpsOptions) -> fmap responseBody $ runReq defaultHttpConfig $ req GET httpsURI NoReqBody jsonResponse - $ httpsOptions <> oAuth2Bearer (Char8.pack token) + $ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token) Nothing -> error "Invalid https URI" -getUsers :: String -> URI -> IO (Vector User) -getUsers token server = +getUsers :: URI -> StrictText -> IO (Vector User) +getUsers server token = let pathPieces = [URI.pathPiece|api|] :| [ [URI.pathPiece|v1|] , [URI.pathPiece|admin|] @@ -81,5 +130,5 @@ getUsers token server = Just (httpsURI, httpsOptions) -> fmap responseBody $ runReq defaultHttpConfig $ req GET httpsURI NoReqBody jsonResponse - $ httpsOptions <> oAuth2Bearer (Char8.pack token) + $ 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 new file mode 100644 index 0000000..b74263d --- /dev/null +++ b/tea-cleaner/TeaCleaner/CommandLine.hs @@ -0,0 +1,45 @@ +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/Filter.hs b/tea-cleaner/TeaCleaner/Filter.hs new file mode 100644 index 0000000..c4f243e --- /dev/null +++ b/tea-cleaner/TeaCleaner/Filter.hs @@ -0,0 +1,32 @@ +module TeaCleaner.Filter + ( 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) + +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) + where + zonedDay = localDay . zonedTimeToLocalTime + +filterByActivities :: URI -> StrictText -> User -> IO Bool +filterByActivities server token user + = getActivities server token user + >>= evalActivities + where + evalActivities activities + | Just (Activity{ opType }, rest) <- Vector.uncons activities + , Vector.null rest = pure $ opType == "create_repo" + evalActivities _ = pure False diff --git a/tea-cleaner/TeaCleaner/Types.hs b/tea-cleaner/TeaCleaner/Types.hs deleted file mode 100644 index 786dedb..0000000 --- a/tea-cleaner/TeaCleaner/Types.hs +++ /dev/null @@ -1,53 +0,0 @@ -module TeaCleaner.Types - ( Activity(..) - , User(..) - ) where - -import TeaCleaner.Options (jsonOptions) -import Data.Int (Int64) -import Data.Text (Text) -import qualified Data.Aeson.TH as Aeson -import Data.Time (ZonedTime(..)) - -data User = User - { id :: Int64 - , login :: Text - , loginName :: Text - , fullName :: Text - , email :: Text - , avatarUrl :: Text - , language :: Text - , isAdmin :: Bool - , lastLogin :: ZonedTime - , created :: ZonedTime - , restricted :: Bool - , active :: Bool - , prohibitLogin :: Bool - , location :: Text - , website :: Text - , description :: Text - , visibility :: Text - , followersCount :: Int - , followingCount :: Int - , starredReposCount :: Int - , username :: Text - } deriving (Show) - -$(Aeson.deriveJSON jsonOptions ''User) - -data Activity = Activity - { actUserId :: Int64 - -- , comment Comment - , commentId :: Int64 - , content :: Text - , created :: ZonedTime - , id :: Int64 - , isPrivate :: Bool - , opType :: Text - , refName :: Text - -- repo Repository{...} - , repoId :: Int64 - , userId :: Int64 - } deriving (Show) - -$(Aeson.deriveJSON jsonOptions ''Activity)