belka/kazbek
1
0
Fork 0
Code Issues Pull Requests Releases Activity

tea-cleaner: Read configuration file

Browse Source
This commit is contained in:
Eugen Wissner
2025-02-18 11:57:18 +01:00
parent 346b9dcfdf
commit 06fa97bfcf
6 changed files with 163 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
tea-cleaner/TeaCleaner/Client.hs
View File

@ -10,13 +10,17 @@ 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(..)
, HttpMethod(..)
, HttpBody
, HttpResponse(..)
, HttpBodyAllowed
, ProvidesBody
, defaultHttpConfig
, ignoreResponse
, jsonResponse
@ -31,6 +35,9 @@ 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
@ -75,8 +82,8 @@ data Activity = Activity
$(Aeson.deriveJSON jsonOptions ''Activity)
purgeUser :: URI -> StrictText -> User -> IO ()
purgeUser server token user =
purgeUser :: Settings -> User -> IO ()
purgeUser Settings{..} user =
let pathConstructor lastPiece = [URI.pathPiece|api|] :|
[ [URI.pathPiece|v1|]
, [URI.pathPiece|admin|]
@ -88,15 +95,10 @@ purgeUser server token user =
<$> 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"
in doRequest uri token DELETE NoReqBody ignoreResponse
getActivities :: URI -> StrictText -> User -> IO (Vector Activity)
getActivities server token user =
getActivities :: Settings -> User -> IO (Vector Activity)
getActivities Settings{..} user =
let pathConstructor lastPiece = [URI.pathPiece|api|] :|
[ [URI.pathPiece|v1|]
, [URI.pathPiece|users|]
@ -109,15 +111,10 @@ getActivities server token user =
<$> 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"
in doRequest uri token GET NoReqBody jsonResponse
getUsers :: URI -> StrictText -> IO (Vector User)
getUsers server token =
getUsers :: Settings -> IO (Vector User)
getUsers Settings{..} =
let pathPieces = [URI.pathPiece|api|] :|
[ [URI.pathPiece|v1|]
, [URI.pathPiece|admin|]
@ -126,9 +123,15 @@ getUsers server token =
uri = server
{ URI.uriPath = Just (False, pathPieces)
}
in case useHttpsURI uri of
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 GET httpsURI NoReqBody jsonResponse
$ req method httpsURI body response
$ httpsOptions <> oAuth2Bearer (Text.Encoding.encodeUtf8 token)
Nothing -> error "Invalid https URI"