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"