belka/kazbek
1
0
Fork 0
Code Issues Pull Requests Releases Activity

tea-cleaner: Add command line parser

Browse Source
This commit is contained in:
Eugen Wissner
2025-01-26 10:17:33 +01:00
parent 3c430bca64
commit 6c170513a6
6 changed files with 168 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
tea-cleaner/TeaCleaner/Client.hs
View File

@ -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"