tea-cleaner: Add command line parser

4 files changed, 138 insertions, 65 deletions

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)