Minor performance improvements

src/Wallabag.hs

@@ -33,6 +33,7 @@ import Katip qualified as K
 import M (HasKatipTracer, HasWallabagMetrics, KatipTracer, katipTracer, wallabagMetrics)
 import Network.HTTP.Client (HttpException)
 import Network.Wreq (FormParam (..), defaults, header, responseBody)
+import Network.Wreq.Session (Session)
 import Pipes ((>->))
 import Pipes qualified
 import Pipes.Prelude qualified as P
@@ -56,6 +57,7 @@ authenticate ::
     MonadIO m,
     K.KatipContext m,
     HasWallabagMetrics r HTTPMetric,
+    HasType Session r,
     HasKatipTracer r KatipTracer
   ) =>
   Creds ->
@@ -70,7 +72,8 @@ authenticate c = do
           "password" := c ^. password
         ]
   metrics <- mkTracerMetrics
-  r <- liftIO $ post metrics SafeTransient "https://app.wallabag.it/oauth/v2/token" form
+  session <- view $ typed @Session
+  r <- liftIO $ post metrics session SafeTransient "https://app.wallabag.it/oauth/v2/token" form
   now <- liftIO getCurrentTime
   let expiresIn = r ^? responseBody . key "expires_in" . _Integer . to fromIntegral . to secondsToNominalDiffTime
       expireTime = fmap (\x -> (x - 5) `addUTCTime` now) expiresIn
@@ -90,6 +93,7 @@ getToken ::
     HasWallabagMetrics r HTTPMetric,
     HasKatipTracer r KatipTracer,
     MonadUnliftIO m,
+    HasType Session r,
     MonadThrow m
   ) =>
   m (Maybe Text)
@@ -125,6 +129,7 @@ sourceEntries ::
   forall r m.
   ( HasType Auth r,
     HasType Creds r,
+    HasType Session r,
     MonadIO m,
     MonadReader r m,
     K.KatipContext m,
@@ -151,7 +156,8 @@ sourceEntries s = P.unfoldr (toEither <=< go) (Just startUrl) >-> P.mapFoldable
       t <- maybe (throw MissingTokenException) pure =<< getToken
       let opts = defaults & header "Authorization" .~ ["Bearer " <> t ^. re utf8]
       K.logFM K.DebugS $ K.ls ("Fetching entries '" <> url <> "'")
-      r <- liftIO $ getWith metrics SafeTransient opts url
+      session <- view $ typed @Session
+      r <- liftIO $ getWith metrics session SafeTransient opts url
       let items = r ^.. responseBody . key "_embedded" . key "items" . _Array . traversed
       let next = r ^? responseBody . key "_links" . key "next" . key "href" . _String . unpacked
       pure $ Just (items, next)
@@ -177,6 +183,7 @@ mkTracerMetrics = do
 applyTags ::
   ( HasType Auth r,
     HasType Creds r,
+    HasType Session r,
     MonadIO m,
     MonadReader r m,
     HasCallStack,
@@ -195,5 +202,6 @@ applyTags e = checkpoint (Annotation $ e ^. identifier) $ do
   K.logFM K.InfoS (K.ls ("Applying tags for '" <> e ^. title <> "': " <> T.pack (show (e ^. tags))))
   let url = "https://app.wallabag.it/api/entries/" <> show (e ^. identifier) <> "/tags"
   metrics <- mkTracerMetrics
-  _ <- liftIO $ postWith metrics SafeTransient opts url ["tags" := T.intercalate "," (e ^. tags)]
+  session <- view $ typed @Session
+  _ <- liftIO $ postWith metrics session SafeTransient opts url ["tags" := T.intercalate "," (e ^. tags)]
   pure ()