1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
module TeaCleaner.Client
( 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 Network.HTTP.Req
( DELETE(..)
, GET(..)
, NoReqBody(..)
, defaultHttpConfig
, ignoreResponse
, jsonResponse
, oAuth2Bearer
, responseBody
, req
, runReq
, useHttpsURI
)
import GHC.Records (HasField(..))
import TeaCleaner.Options (jsonOptions)
import Data.Int (Int64)
import qualified Data.Aeson.TH as Aeson
import Data.Time (ZonedTime(..))
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|]
, [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 (Text.Encoding.encodeUtf8 token)
Nothing -> error "Invalid https URI"
getActivities :: URI -> StrictText -> User -> IO (Vector Activity)
getActivities server token 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 (Text.Encoding.encodeUtf8 token)
Nothing -> error "Invalid https URI"
getUsers :: URI -> StrictText -> IO (Vector User)
getUsers server token =
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 (Text.Encoding.encodeUtf8 token)
Nothing -> error "Invalid https URI"
|
