From 3c430bca64c813a0a04cb98d5cd9a3d3fb70e1b0 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 24 Jan 2025 22:38:58 +0100 Subject: Add gitea spam user cleaning script --- tea-cleaner/Main.hs | 71 ++++++++++++++++++++++++++++++++ tea-cleaner/TeaCleaner/Client.hs | 85 +++++++++++++++++++++++++++++++++++++++ tea-cleaner/TeaCleaner/Options.hs | 24 +++++++++++ tea-cleaner/TeaCleaner/Types.hs | 53 ++++++++++++++++++++++++ 4 files changed, 233 insertions(+) create mode 100644 tea-cleaner/Main.hs create mode 100644 tea-cleaner/TeaCleaner/Client.hs create mode 100644 tea-cleaner/TeaCleaner/Options.hs create mode 100644 tea-cleaner/TeaCleaner/Types.hs (limited to 'tea-cleaner') diff --git a/tea-cleaner/Main.hs b/tea-cleaner/Main.hs new file mode 100644 index 0000000..bfad0f7 --- /dev/null +++ b/tea-cleaner/Main.hs @@ -0,0 +1,71 @@ +module Main + ( main + ) where + +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 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) + +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 + 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 + +main :: IO () +main = getArgs >>= 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 diff --git a/tea-cleaner/TeaCleaner/Client.hs b/tea-cleaner/TeaCleaner/Client.hs new file mode 100644 index 0000000..1556be6 --- /dev/null +++ b/tea-cleaner/TeaCleaner/Client.hs @@ -0,0 +1,85 @@ +module TeaCleaner.Client + ( getActivities + , getUsers + , purgeUser + ) where + +import Data.List.NonEmpty (NonEmpty(..)) +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(..) + , NoReqBody(..) + , defaultHttpConfig + , ignoreResponse + , jsonResponse + , oAuth2Bearer + , responseBody + , req + , runReq + , useHttpsURI + ) +import GHC.Records (HasField(..)) + +purgeUser :: String -> URI -> User -> IO () +purgeUser token server user = + let pathConstructor lastPiece = [URI.pathPiece|api|] :| + [ [URI.pathPiece|v1|] + , [URI.pathPiece|admin|] + , [URI.pathPiece|users|] + , lastPiece + ] + uri = server + { URI.uriPath = (False,) . pathConstructor + <$> 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 (Char8.pack token) + Nothing -> error "Invalid https URI" + +getActivities :: String -> URI -> User -> IO (Vector Activity) +getActivities token server user = + let pathConstructor lastPiece = [URI.pathPiece|api|] :| + [ [URI.pathPiece|v1|] + , [URI.pathPiece|users|] + , lastPiece + , [URI.pathPiece|activities|] + , [URI.pathPiece|feeds|] + ] + uri = server + { URI.uriPath = (False,) . pathConstructor + <$> 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 (Char8.pack token) + Nothing -> error "Invalid https URI" + +getUsers :: String -> URI -> IO (Vector User) +getUsers token server = + let pathPieces = [URI.pathPiece|api|] :| + [ [URI.pathPiece|v1|] + , [URI.pathPiece|admin|] + , [URI.pathPiece|users|] + ] + uri = server + { URI.uriPath = Just (False, pathPieces) + } + in case useHttpsURI uri of + Just (httpsURI, httpsOptions) -> fmap responseBody + $ runReq defaultHttpConfig + $ req GET httpsURI NoReqBody jsonResponse + $ httpsOptions <> oAuth2Bearer (Char8.pack token) + Nothing -> error "Invalid https URI" diff --git a/tea-cleaner/TeaCleaner/Options.hs b/tea-cleaner/TeaCleaner/Options.hs new file mode 100644 index 0000000..7353f8f --- /dev/null +++ b/tea-cleaner/TeaCleaner/Options.hs @@ -0,0 +1,24 @@ +module TeaCleaner.Options + ( jsonOptions + ) where + +import qualified Data.Aeson.TH as Aeson +import Prelude hiding (id) +import Data.Char + +applyFirst :: (Char -> Char) -> String -> String +applyFirst _ [] = [] +applyFirst f [x] = [f x] +applyFirst f (x:xs) = f x: xs + +-- | Generic casing for symbol separated names +symbCase :: String -> String +symbCase = u . applyFirst toLower + where u [] = [] + u (x:xs) | isUpper x = '_' : toLower x : u xs + | otherwise = x : u xs + +jsonOptions :: Aeson.Options +jsonOptions = Aeson.defaultOptions + { Aeson.fieldLabelModifier = symbCase + } diff --git a/tea-cleaner/TeaCleaner/Types.hs b/tea-cleaner/TeaCleaner/Types.hs new file mode 100644 index 0000000..786dedb --- /dev/null +++ b/tea-cleaner/TeaCleaner/Types.hs @@ -0,0 +1,53 @@ +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) -- cgit v1.2.3