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"