diff options
Diffstat (limited to 'tea-cleaner/TeaCleaner/Client.hs')
| -rw-r--r-- | tea-cleaner/TeaCleaner/Client.hs | 141 |
1 files changed, 0 insertions, 141 deletions
diff --git a/tea-cleaner/TeaCleaner/Client.hs b/tea-cleaner/TeaCleaner/Client.hs deleted file mode 100644 index fae3e6a..0000000 --- a/tea-cleaner/TeaCleaner/Client.hs +++ /dev/null @@ -1,141 +0,0 @@ -{- This Source Code Form is subject to the terms of the Mozilla Public License, - v. 2.0. If a copy of the MPL was not distributed with this file, You can - obtain one at https://mozilla.org/MPL/2.0/. -} - -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" |
