138 lines
4.0 KiB
Haskell
138 lines
4.0 KiB
Haskell
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 qualified Text.URI as URI
|
|
import qualified Text.URI.QQ as URI
|
|
import Network.HTTP.Req
|
|
( DELETE(..)
|
|
, GET(..)
|
|
, NoReqBody(..)
|
|
, HttpMethod(..)
|
|
, HttpBody
|
|
, HttpResponse(..)
|
|
, HttpBodyAllowed
|
|
, ProvidesBody
|
|
, 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(..))
|
|
import TeaCleaner.Configuration (Settings(..))
|
|
import Data.Data (Proxy)
|
|
import Text.URI (URI)
|
|
|
|
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 :: Settings -> User -> IO ()
|
|
purgeUser Settings{..} 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 doRequest uri token DELETE NoReqBody ignoreResponse
|
|
|
|
getActivities :: Settings -> User -> IO (Vector Activity)
|
|
getActivities Settings{..} 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 doRequest uri token GET NoReqBody jsonResponse
|
|
|
|
getUsers :: Settings -> IO (Vector User)
|
|
getUsers Settings{..} =
|
|
let pathPieces = [URI.pathPiece|api|] :|
|
|
[ [URI.pathPiece|v1|]
|
|
, [URI.pathPiece|admin|]
|
|
, [URI.pathPiece|users|]
|
|
]
|
|
uri = server
|
|
{ URI.uriPath = Just (False, pathPieces)
|
|
}
|
|
in doRequest uri token GET NoReqBody jsonResponse
|
|
|
|
doRequest
|
|
:: (HttpMethod method, HttpBody body, HttpResponse response, HttpBodyAllowed (AllowsBody method) (ProvidesBody body))
|
|
=> URI -> StrictText -> method -> body -> Proxy response -> IO (HttpResponseBody response)
|
|
doRequest uri token method body response =
|
|
case useHttpsURI uri of
|
|
Just (httpsURI, httpsOptions) -> fmap responseBody
|
|
$ runReq defaultHttpConfig
|
|
$ req method httpsURI body response
|
|
$ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token)
|
|
Nothing -> error "Invalid https URI"
|