86 lines
2.9 KiB
Haskell
86 lines
2.9 KiB
Haskell
|
module TeaCleaner.Client
|
||
|
|
( getActivities
|
||
|
|
, getUsers
|
||
|
|
, purgeUser
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Data.List.NonEmpty (NonEmpty(..))
|
||
|
|
import Data.Vector (Vector)
|
||
|
|
import Text.URI (URI(..))
|
||
|
|
import qualified Text.URI as URI
|
||
|
|
import qualified Text.URI.QQ as URI
|
||
|
|
import TeaCleaner.Types (Activity(..), User(..))
|
||
|
|
import qualified Data.ByteString.Char8 as Char8
|
||
|
|
import Network.HTTP.Req
|
||
|
|
( DELETE(..)
|
||
|
|
, GET(..)
|
||
|
|
, NoReqBody(..)
|
||
|
|
, defaultHttpConfig
|
||
|
|
, ignoreResponse
|
||
|
|
, jsonResponse
|
||
|
|
, oAuth2Bearer
|
||
|
|
, responseBody
|
||
|
|
, req
|
||
|
|
, runReq
|
||
|
|
, useHttpsURI
|
||
|
|
)
|
||
|
|
import GHC.Records (HasField(..))
|
||
|
|
|
||
|
|
purgeUser :: String -> URI -> User -> IO ()
|
||
|
|
purgeUser token server 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 (Char8.pack token)
|
||
|
|
Nothing -> error "Invalid https URI"
|
||
|
|
|
||
|
|
getActivities :: String -> URI -> User -> IO (Vector Activity)
|
||
|
|
getActivities token server 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 (Char8.pack token)
|
||
|
|
Nothing -> error "Invalid https URI"
|
||
|
|
|
||
|
|
getUsers :: String -> URI -> IO (Vector User)
|
||
|
|
getUsers token server =
|
||
|
|
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 (Char8.pack token)
|
||
|
|
Nothing -> error "Invalid https URI"
|