[refactor] upgrade servant-client to 0.20

crawlerHAL.cabal

@@ -32,6 +32,7 @@ library
       HAL.Doc.Document
       HAL.Doc.EntityTree
       HAL.Doc.Struct
+      HAL.ServantClientLogging
       HAL.Types
       HAL.Utils
       Tree
@@ -51,6 +52,7 @@ library
   build-depends:
       aeson >= 1.5.6 && < 2.3
     , base >=4.7 && <5
+    , binary >= 0.8.8 && < 0.9
     , bytestring >= 0.11.0 && < 0.13
     , conduit >= 1.3.5 && < 1.4
     , containers >= 0.6.7 && < 0.7
@@ -63,8 +65,9 @@ library
     , optparse-applicative >= 0.17 && < 0.19
     , protolude >= 0.3.3 && < 0.4
     , scientific >= 0.3.7.0 && < 0.4
-    , servant >= 0.19 && < 0.20
-    , servant-client >= 0.19 && < 0.20
+    , servant >= 0.20 && < 0.21
+    , servant-client >= 0.20 && < 0.21
+    , servant-client-core >= 0.20 && < 0.21
     , split >= 0.2.3.5 && < 0.3
     , text >= 1.2.3.0 && < 2.1
     , text-format >= 0.3.2.1 && < 0.4
@@ -100,7 +103,7 @@ executable crawlerHAL-exe
     , iso639 >= 0.1.0.3 && < 0.2
     , optparse-applicative >= 0.17 && < 0.19
     , protolude >= 0.3.3 && < 0.4
-    , servant-client >= 0.19 && < 0.21
+    , servant-client >= 0.20 && < 0.21
     , split >= 0.2.3.5 && < 0.3
     , text >= 1.2.3.0 && < 2.1
   default-language: Haskell2010

src/HAL.hs

@@ -8,14 +8,14 @@ import Data.Text qualified as T
 import HAL.Client ( SortField(Asc), search, structure, searchCursor )
 import HAL.Doc.Document ( Document(..) )
 import HAL.Doc.Struct ( Struct )
+import HAL.ServantClientLogging (addLoggingToClientEnv)
 import HAL.Types (Response(..))
 import HAL.Utils (langAbstractS, toText)
-import Network.HTTP.Client (newManager, Request)
+import Network.HTTP.Client (newManager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Protolude
 import Servant.API ( ToHttpApiData )
-import Servant.Client (BaseUrl(..), Scheme(..), ClientM, ClientError, runClientM, mkClientEnv, ClientEnv (makeClientRequest))
-import System.IO.Unsafe (unsafePerformIO)
+import Servant.Client (BaseUrl(..), Scheme(..), ClientM, ClientError, runClientM, mkClientEnv)
 
 
 data HalCrawlerOptions
@@ -237,23 +237,14 @@ baseFields = [ "docid"
 structFields :: Text
 structFields = "docid,label_s,parentDocid_i"
 
-requestLog :: HalCrawlerOptions -> Request -> Request
-requestLog opts rq = unsafePerformIO $ do
-  debugLog opts $ "[HAL.makeClientRequestLog] " <> show rq
-  pure rq
-{-# NOINLINE requestLog #-}
-
 runHalAPIClient :: (FromJSON doc, ToHttpApiData doc)
                 => HalCrawlerOptions
                 -> ClientM (Response doc)
                 -> IO (Either ClientError (Response doc))
-runHalAPIClient opts cmd = do
+runHalAPIClient _opts cmd = do
   manager' <- newManager tlsManagerSettings
-  runClientM cmd' (mkClientEnv manager' $ BaseUrl Https "api.archives-ouvertes.fr" 443 "")
-  where
-    cmd' = local (\r -> r {
-      makeClientRequest = \bUrl servantRq -> requestLog opts (makeClientRequest r bUrl servantRq)
-      }) cmd
+  let env = mkClientEnv manager' $ BaseUrl Https "api.archives-ouvertes.fr" 443 ""
+  runClientM cmd $ addLoggingToClientEnv env
 
 runStructureRequest :: Maybe Text -> IO (Either ClientError (Response Struct))
 runStructureRequest rq =

src/HAL/ServantClientLogging.hs

+{-|
+Module      : HAL.ServantClientLogging
+Description : Textmining Collaborative Platform
+Copyright   : (c) CNRS, 2023-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+@Gargantext@: search, map, share
+-}
+
+{-# LANGUAGE FlexibleContexts #-}
+
+module HAL.ServantClientLogging where
+
+import Data.Binary.Builder qualified as DBB
+import Debug.Trace (trace)
+import Protolude hiding (trace)
+import Servant.Client (ClientEnv(..))
+import Servant.Client.Core.Request (RequestF(..))
+
+
+addLoggingToClientEnv :: ClientEnv -> ClientEnv
+addLoggingToClientEnv env@(ClientEnv { makeClientRequest = mcr }) = env { makeClientRequest }
+  where
+    makeClientRequest baseUrl req =
+      trace ("req: " <> showRequestPath req <> " " <> show (requestQueryString req)) $ mcr baseUrl req
+    showRequestPath req =
+      show $ DBB.toLazyByteString $ requestPath req