kazbek/tea-cleaner/TeaCleaner/Client.hs

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"