Add gitea spam user cleaning script

2025-01-24 22:38:58 +01:00
parent c8b05eedfc
commit 3c430bca64
7 changed files with 274 additions and 1 deletions
--- a/tea-cleaner/TeaCleaner/Client.hs
+++ 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"