aboutsummaryrefslogtreecommitdiff
path: root/tea-cleaner/TeaCleaner/Client.hs
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2025-02-18 11:57:18 +0100
committerEugen Wissner <belka@caraus.de>2025-02-18 11:57:18 +0100
commit06fa97bfcf255fd033d3b5bd77d77d68ec8beef6 (patch)
tree4714437eb7b10325be5aaeb5744935167156c11c /tea-cleaner/TeaCleaner/Client.hs
parent346b9dcfdf2a1c5d3339b4f3821080210316e6a9 (diff)
downloadkazbek-06fa97bfcf255fd033d3b5bd77d77d68ec8beef6.tar.gz
tea-cleaner: Read configuration file
Diffstat (limited to 'tea-cleaner/TeaCleaner/Client.hs')
-rw-r--r--tea-cleaner/TeaCleaner/Client.hs45
1 files changed, 24 insertions, 21 deletions
diff --git a/tea-cleaner/TeaCleaner/Client.hs b/tea-cleaner/TeaCleaner/Client.hs
index af84514..5afd6a5 100644
--- a/tea-cleaner/TeaCleaner/Client.hs
+++ b/tea-cleaner/TeaCleaner/Client.hs
@@ -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"